From 2360a9f69adebd375960df7535c2d84144b4740c Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 2 Jun 2014 14:49:51 +0100 Subject: [PATCH] pkg/lib: more fixes to handling of relative package sources in catalogs Relative paths in a catalog should be treated as relative URLs, not relative paths. --- .../pkg/scribblings/catalog-protocol.scrbl | 2 +- .../racket-test/tests/pkg/tests-catalogs.rkt | 19 +++---- racket/collects/pkg/lib.rkt | 52 +++++++------------ 3 files changed, 31 insertions(+), 42 deletions(-) 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 746cbc08bc..05c2e67d9f 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/catalog-protocol.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/catalog-protocol.scrbl @@ -46,7 +46,7 @@ information about packages: @item{@racket['source] (required) --- a @tech{package source} string, typically a remote URL. If this source is a - relative path, then it is treated as relative to the + relative URL, then it is treated as relative to the catalog. @history[#:changed "6.0.1.7" @elem{Added relative-path support 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 11ac8e84e3..b3e2619ecc 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-catalogs.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-catalogs.rkt @@ -107,16 +107,17 @@ $ (~a "raco pkg catalog-archive " archive-d " http://localhost:9990") $ (~a "test -f " archive-d "/pkgs/pkg-test1.zip") - (define rx:pkg-test1 (regexp - (~a (regexp-quote (~a "Source: " archive-d "/pkgs/pkg-test1.zip")) - ".*" - (regexp-quote (~a "Checksum: " (file->string - (build-path archive-d - "pkgs" - "pkg-test1.zip.CHECKSUM"))))))) + (define (rx:pkg-test1 as-url?) + (regexp + (~a (regexp-quote (~a "Source: " (if as-url? "file://" "") archive-d "/pkgs/pkg-test1.zip")) + ".*" + (regexp-quote (~a "Checksum: " (file->string + (build-path archive-d + "pkgs" + "pkg-test1.zip.CHECKSUM"))))))) $ (~a "raco pkg catalog-show --catalog file://" archive-d "/catalog pkg-test1") - =stdout> rx:pkg-test1 + =stdout> (rx:pkg-test1 #f) (delete-directory/files archive-d) @@ -127,7 +128,7 @@ " " archive-d) =stdout> #rx"== Archiving pkg-test1 ==" $ (~a "raco pkg catalog-show --catalog file://" archive-d "/catalog pkg-test1") - =stdout> rx:pkg-test1 + =stdout> (rx:pkg-test1 #t) $ (~a "grep archive " archive-d "/catalog/pkg/pkg-test1") ; relative path => no "archive" =exit> 1 $ (~a "test -f " archive-d "/pkgs/pkg-test2.zip") diff --git a/racket/collects/pkg/lib.rkt b/racket/collects/pkg/lib.rkt index 09bd675ea3..d635149041 100644 --- a/racket/collects/pkg/lib.rkt +++ b/racket/collects/pkg/lib.rkt @@ -448,34 +448,27 @@ (define new-ht (cond [s - ;; If `i' is a "file:" URL, then it makes sense to parse - ;; `s' as a path and make it absolute relative to `i'. - ;; If `i' is a URL, then `s' might be treated as a relative - ;; URL, and we rely on the pun that a relative URL looks - ;; like a relative path. + ;; If `s' is a relative URL, then we rely on the pun + ;; that it will parse as a relative path. (define-values (name type) (package-source->name+type s #f)) (cond [(and (or (eq? type 'dir) (eq? type 'file)) - (not (complete-path? (package-source->path s type)))) - (define full-path + (not (regexp-match? #rx"^file://" s)) + (relative-path? s)) + (define i-for-combine (cond [(equal? "file" (url-scheme i)) - (define path (url->path i)) - (define dir (if (db-path? path) - (let-values ([(base name dir?) (split-path path)]) - base) - path)) - (path->string (simplify-path (path->complete-path (package-source->path s type) - (path->complete-path dir))))] - [else - (define rel-url (string-join (for/list ([e (explode-path (package-source->path s type))]) - (cond - [(eq? e 'same) "."] - [(eq? e 'up) ".."] - [else (path-element->string e)])) - "/")) - (url->string (combine-url/relative i rel-url))])) - (hash-set ht 'source full-path)] + (define i-path (url->path i)) + (if (db-path? i-path) + i + ;; Make sure we interpret `i' as a directory when + ;; adding a relative path: + (path->url (path->directory-path (url->path i))))] + [else i])) + (define full-url + (url->string + (combine-url/relative i-for-combine s))) + (hash-set ht 'source full-url)] [else ht])] [else ht])) (let ([v (hash-ref new-ht 'versions #f)]) @@ -499,15 +492,10 @@ [(or (eq? type 'dir) (eq? type 'file)) (hash-set ht 'source - (string-join (map (lambda (s) - (case s - [(up) ".."] - [(same) "."] - [else (path-element->string s)])) - (explode-path (find-relative-path - dir - (package-source->path s type)))) - "/"))] + (relative-path->relative-url-string + (find-relative-path + dir + (package-source->path s type))))] [else ht])] [else ht])) (let ([v (hash-ref new-ht 'versions #f)])