package system: clients extract version-specific info from a catalog result

When a client sends a query to a package catalog, it includes a
version number in the query, and a package catalog can customize its
response to the version. That approach allows evoluation of the way
that versions are mapped to results, but it does not allow a
directory-implemented catalog to offer version-specific information.
Allowing both the server and the client to filter on the version is
even more flexible, and in particular allows a directory-implemented
catalog to include version-specific mappings.

pkgs/racket-pkgs/racket-doc/pkg/scribblings/catalog-protocol.scrbl

@@ -31,7 +31,7 @@ information about packages:
  @item{@litchar{pkg} and @nonterm{package} path elements, where
        @nonterm{package} is a @tech{package name}, plus a
        @exec{version=}@nonterm{version} query (where @nonterm{version}
-       is a Racket version number) in the case of a remote URL:
+       is a Racket version number) in the case of a remote URL.
 
        This URL/path form is use to obtain information about
        @nonterm{package}. An HTTP request for a remote URL should
@@ -73,9 +73,21 @@ information about packages:
               @racket[collapse-module-path].}
 
         @item{@racket['versions] (optional) --- a hash table mapping
-              version strings to hash tables, where each version-specific
+              version strings and @racket['default] to hash tables,
-              hash table provides mappings to override the ones in the main
+              where each version-specific hash table provides mappings
-              hash table.}
+              to override the ones in the main hash table, and
+              @racket['default] applies to any version not otherwise
+              mapped.
+
+              Clients of a remote catalog may request information for
+              a specific version, but they should also check for a
+              @racket['versions] entry in a catalog response, in case
+              a catalog with version-specific mappings is implemented
+              as a directory or by a file-serving HTTP server. A
+              @racket['default] mapping, meanwhile, allows the main
+              hash table to provide information that is suitable for
+              clients at version 5.3.6 and earlier (which do not check
+              for @racket['versions]).}
 
        ]}
  

pkgs/racket-pkgs/racket-test/tests/pkg/tests-catalogs.rkt

@@ -74,10 +74,14 @@
         (lambda (o)
           (write (hash 'name "whale"
                        'checksum cksum
-                       'source "http://localhost:9999/whale.plt")
+                       'source "http://localhost:9999/whale.plt"
+                       'versions (hash "5.3.6"
+                                       (hash 'checksum
+                                             123)))
                  o))))
      (add-whale! "345")
      $ (~a "raco pkg catalog-show --catalog file://" (path->string dir2) " whale") =stdout> #rx"Checksum: 345"
+     $ (~a "raco pkg catalog-show --version 5.3.6 --catalog file://" (path->string dir2) " whale") =stdout> #rx"Checksum: 123"
      $ "raco pkg catalog-show whale" =exit> 1
      
      $ (~a "raco pkg catalog-copy --merge " (path->string dir2) " " (path->string dest))

racket/collects/pkg/lib.rkt

@@ -330,6 +330,7 @@
      [else #f])]
    [else (server i)]))
 
+;; Add current package version to a URL:
 (define (add-version-query addr/no-query)
   (struct-copy url addr/no-query
                [query (append
@@ -337,36 +338,55 @@
                        (list
                         (cons 'version (current-pkg-scope-version))))]))
 
+;; Take a package-info hash table and lift any version-specific
+;; information in 'versions.
+(define (select-info-version ht)
+  (and ht
+       (let ([v (hash-ref ht 'versions #f)])
+         (cond
+          [(hash? v)
+           (or (for/or ([vers (in-list (list (current-pkg-scope-version)
+                                             'default))])
+                 (define ht2 (hash-ref v (current-pkg-scope-version) #f))
+                 (and ht2
+                      ;; Override fields of `ht' with values from `ht2':
+                      (for/fold ([ht ht]) ([(k v) (in-hash ht2)])
+                        (hash-set ht k v))))
+               ;; Keep ht as-is:
+               ht)]
+          [else ht]))))
+
 (define (package-catalog-lookup pkg details? download-printf)
   (or
    (for/or ([i (in-list (pkg-catalogs))])
      (if download-printf
          (download-printf "Resolving ~s via ~a\n" pkg (url->string i))
          (log-pkg-debug "consulting catalog ~a" (url->string i)))
-     (catalog-dispatch
+     (select-info-version
-      i
+      (catalog-dispatch
-      ;; Server:
+       i
-      (lambda (i)
+       ;; Server:
-        (define addr (add-version-query
+       (lambda (i)
-                      (combine-url/relative i (format "pkg/~a" pkg))))
+         (define addr (add-version-query
-        (log-pkg-debug "resolving via ~a" (url->string addr))
+                       (combine-url/relative i (format "pkg/~a" pkg))))
-        (read-from-server
+         (log-pkg-debug "resolving via ~a" (url->string addr))
-         'package-catalog-lookup
+         (read-from-server
-         addr
+          'package-catalog-lookup
-         (lambda (v) (and (hash? v)
+          addr
-                          (for/and ([k (in-hash-keys v)])
+          (lambda (v) (and (hash? v)
-                            (symbol? k))))
+                           (for/and ([k (in-hash-keys v)])
-         (lambda (s) #f)))
+                             (symbol? k))))
-      ;; Local database:
+          (lambda (s) #f)))
-      (lambda ()
+       ;; Local database:
-        (define pkgs (db:get-pkgs #:name pkg))
+       (lambda ()
-        (and (pair? pkgs)
+         (define pkgs (db:get-pkgs #:name pkg))
-             (db-pkg-info (car pkgs) details?)))
+         (and (pair? pkgs)
-      ;; Local directory:
+              (db-pkg-info (car pkgs) details?)))
-      (lambda (path)
+       ;; Local directory:
+       (lambda (path)
          (define pkg-path (build-path path "pkg" pkg))
          (and (file-exists? pkg-path)
-              (call-with-input-file* pkg-path read)))))
+              (call-with-input-file* pkg-path read))))))
    (pkg-error (~a "cannot find package on catalogs\n"
                   "  package: ~a")
               pkg)))