diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/catalog-protocol.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/catalog-protocol.scrbl index b3f6765953..c5abd15126 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/catalog-protocol.scrbl +++ b/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 - hash table provides mappings to override the ones in the main - hash table.} + version strings and @racket['default] to hash tables, + where each version-specific hash table provides mappings + 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]).} ]} diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-catalogs.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-catalogs.rkt index 6318e24382..0ea934d6b0 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-catalogs.rkt +++ b/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)) diff --git a/racket/collects/pkg/lib.rkt b/racket/collects/pkg/lib.rkt index 79a35119f3..b8e5f65049 100644 --- a/racket/collects/pkg/lib.rkt +++ b/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 - i - ;; Server: - (lambda (i) - (define addr (add-version-query - (combine-url/relative i (format "pkg/~a" pkg)))) - (log-pkg-debug "resolving via ~a" (url->string addr)) - (read-from-server - 'package-catalog-lookup - addr - (lambda (v) (and (hash? v) - (for/and ([k (in-hash-keys v)]) - (symbol? k)))) - (lambda (s) #f))) - ;; Local database: - (lambda () - (define pkgs (db:get-pkgs #:name pkg)) - (and (pair? pkgs) - (db-pkg-info (car pkgs) details?))) - ;; Local directory: - (lambda (path) + (select-info-version + (catalog-dispatch + i + ;; Server: + (lambda (i) + (define addr (add-version-query + (combine-url/relative i (format "pkg/~a" pkg)))) + (log-pkg-debug "resolving via ~a" (url->string addr)) + (read-from-server + 'package-catalog-lookup + addr + (lambda (v) (and (hash? v) + (for/and ([k (in-hash-keys v)]) + (symbol? k)))) + (lambda (s) #f))) + ;; Local database: + (lambda () + (define pkgs (db:get-pkgs #:name pkg)) + (and (pair? pkgs) + (db-pkg-info (car pkgs) details?))) + ;; 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)))