From e0a82393b778246551372e05b9d150107af5fbba Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 2 Jun 2014 06:55:51 +0100 Subject: [PATCH] raco pkg: fix treatmennt of "file://" package sources A "file://" prefix on a package source needs to be consistently removed. The new `package-source->path` function does that, so it should be used to convert a package source to a filesystem path. --- .../racket-doc/pkg/scribblings/name.scrbl | 16 +++++ .../racket-doc/pkg/scribblings/pkg.scrbl | 16 +++-- .../racket-test/tests/pkg/tests-install.rkt | 8 +++ racket/collects/pkg/lib.rkt | 70 ++++++++++++------- racket/collects/pkg/name.rkt | 15 +++- 5 files changed, 92 insertions(+), 33 deletions(-) diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/name.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/name.scrbl index d365c4f8a8..33c8562882 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/name.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/name.scrbl @@ -55,3 +55,19 @@ is called if a valid name cannot be inferred from @racket[source]. If @racket[link-dirs?] is true, then a directory path is reported as type @racket['link] instead of @racket['dir].} + +@defproc[(package-source->path [source string?] + [type (or/c #f 'file 'dir 'link 'static-link) #f]) + path?]{ + +Converts a file or directory package source to a filesystem path. + +The @racket[package-source->path] function is different from +@racket[string->path] in the case that @racket[source] starts with +@litchar{file://}. Also, if @racket[type] is @racket['dir], +@racket['link], or @racket['static-link], then +@racket[path->directory-path] is used to ensure that the result path +refers to a directory. + +@history[#:added "10.0.1.11"]} + diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl index 1c6f5112f9..c6c302405d 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl @@ -117,7 +117,8 @@ The @tech{package source} types are: @itemlist[ -@item{a local file path naming an archive -- The name of the package +@item{a local file path naming an archive (as a plain path or @litchar{file://} URL) +--- The name of the package is the basename of the archive file. The @tech{checksum} for archive @filepath{f.@nonterm{ext}} is given by the file @filepath{f.@nonterm{ext}.CHECKSUM}. The valid archive formats @@ -138,11 +139,12 @@ and when it starts with @litchar{file://} or does not start with alphabetic characters followed by @litchar{://}. The inferred package name is the filename without its suffix.} -@item{a local directory -- The name of the package is the name of the +@item{a local directory (as a plain path or @litchar{file://} URL) +--- The name of the package is the name of the directory. The @tech{checksum} is not present. For example, -@filepath{~/tic-tac-toe/} is directory package source. +@filepath{~/tic-tac-toe/} is a directory package source. A package source is inferred to refer to a directory only when it does not have a file-archive suffix, does @@ -151,7 +153,7 @@ with @litchar{file://} or does not start with alphabetic characters followed by @litchar{://}. The inferred package name is the directory name.} -@item{a remote URL naming an archive -- This type follows the same +@item{a remote URL naming an archive --- This type follows the same rules as a local file path, but the archive and @tech{checksum} files are accessed via HTTP(S). @@ -167,7 +169,7 @@ that could be inferred as a file archive. The inferred package name is from the URL's file name in the same way as for a file package source.} -@item{a remote URL naming a directory -- The remote directory must +@item{a remote URL naming a directory --- The remote directory must contain a file named @filepath{MANIFEST} that lists all the contingent files. These are downloaded into a local directory and then the rules for local directory paths are followed. However, if the remote @@ -184,7 +186,7 @@ file, and it is treated as a directory URL when it does not end with a path element that has an archive file suffix. The inferred package name is the directory name.} -@item{a remote URL naming a GitHub repository -- The format for such +@item{a remote URL naming a GitHub repository --- The format for such URLs is: @inset{@exec{git://github.com/}@nonterm{user}@exec{/}@nonterm{repo}@; @@ -217,7 +219,7 @@ specified as a GitHub reference is automatically prefixed with is the last element of @nonterm{path} if it is non-empty, otherwise the inferred name is @nonterm{repo}.} -@item{a @tech{package name} -- A @tech{package catalog} is +@item{a @tech{package name} --- A @tech{package catalog} is consulted to determine the source and @tech{checksum} for the package. For diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-install.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-install.rkt index cdf412e120..2cb262165f 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-install.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-install.rkt @@ -8,6 +8,7 @@ racket/runtime-path racket/path racket/list + net/url pkg/util "shelly.rkt" "util.rkt") @@ -22,11 +23,18 @@ "raco pkg install tests" (shelly-install "local package (tgz)" "test-pkgs/pkg-test1.tgz") (shelly-install "local package (zip)" "test-pkgs/pkg-test1.zip") + (shelly-install "local package (file://zip)" (url->string (path->url (path->complete-path "test-pkgs/pkg-test1.zip")))) (shelly-install "local package (plt)" "test-pkgs/pkg-test1.plt") (shelly-install* "local package (zip, compiled)" "test-pkgs/pkg-test1b.zip" "pkg-test1b") (shelly-install* "local package (zip, single-collection)" "test-pkgs/pkg-test1.zip test-pkgs/pkg-test3.zip" "pkg-test1 pkg-test3") + (shelly-install "local package (dir)" (string-append + "--copy " + (url->string (path->url (path->complete-path "test-pkgs/pkg-test1"))))) + (shelly-install "local package (file://dir)" (string-append + "--copy " + (url->string (path->url (path->complete-path "test-pkgs/pkg-test1"))))) (with-fake-root (shelly-case diff --git a/racket/collects/pkg/lib.rkt b/racket/collects/pkg/lib.rkt index ef2f201030..09bd675ea3 100644 --- a/racket/collects/pkg/lib.rkt +++ b/racket/collects/pkg/lib.rkt @@ -448,10 +448,15 @@ (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. (define-values (name type) (package-source->name+type s #f)) (cond [(and (or (eq? type 'dir) (eq? type 'file)) - (not (complete-path? s))) + (not (complete-path? (package-source->path s type)))) (define full-path (cond [(equal? "file" (url-scheme i)) @@ -460,9 +465,16 @@ (let-values ([(base name dir?) (split-path path)]) base) path)) - (path->string (simplify-path (path->complete-path s (path->complete-path dir))))] + (path->string (simplify-path (path->complete-path (package-source->path s type) + (path->complete-path dir))))] [else - (url->string (combine-url/relative i s))])) + (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)] [else ht])] [else ht])) @@ -492,7 +504,9 @@ [(up) ".."] [(same) "."] [else (path-element->string s)])) - (explode-path (find-relative-path dir s))) + (explode-path (find-relative-path + dir + (package-source->path s type)))) "/"))] [else ht])] [else ht])) @@ -1243,23 +1257,26 @@ info checksum)] [(eq? type 'file) - (unless (file-exists? pkg) - (pkg-error "no such file\n path: ~a" pkg)) - (define checksum-pth (format "~a.CHECKSUM" pkg)) + (define pkg-path (if (path? pkg) + pkg + (package-source->path pkg type))) + (unless (file-exists? pkg-path) + (pkg-error "no such file\n path: ~a" pkg-path)) + (define checksum-pth (format "~a.CHECKSUM" pkg-path)) (define expected-checksum (and (file-exists? checksum-pth) check-sums? (file->string checksum-pth))) - (check-checksum given-checksum expected-checksum "unexpected" pkg #f) + (check-checksum given-checksum expected-checksum "unexpected" pkg-path #f) (define actual-checksum - (with-input-from-file pkg + (with-input-from-file pkg-path (λ () (sha1 (current-input-port))))) - (check-checksum expected-checksum actual-checksum "mismatched" pkg + (check-checksum expected-checksum actual-checksum "mismatched" pkg-path (and use-cache? cached-url)) (define checksum actual-checksum) - (define pkg-format (filename-extension pkg)) + (define pkg-format (filename-extension pkg-path)) (define pkg-dir (make-temporary-file (string-append "~a-" pkg-name) 'directory)) @@ -1271,17 +1288,17 @@ (match pkg-format [#"tgz" - (untar pkg pkg-dir)] + (untar pkg-path pkg-dir)] [#"tar" - (untar pkg pkg-dir)] + (untar pkg-path pkg-dir)] [#"gz" ; assuming .tar.gz - (untar pkg pkg-dir)] + (untar pkg-path pkg-dir)] [#"zip" - (unzip pkg (make-filesystem-entry-reader #:dest pkg-dir) + (unzip pkg-path (make-filesystem-entry-reader #:dest pkg-dir) #:preserve-timestamps? #t)] [#"plt" (make-directory* pkg-dir) - (unpack pkg pkg-dir + (unpack pkg-path pkg-dir (lambda (x) (log-pkg-debug "~a" x)) (lambda () pkg-dir) #f @@ -1314,7 +1331,7 @@ #:strip strip-mode #:in-place? (not strip-mode) #:in-place-clean? #t) - `(file ,(simple-form-path* pkg))) + `(file ,(simple-form-path* pkg-path))) checksum) (unless strip-mode (set! staged? #t)))) @@ -1324,18 +1341,21 @@ [(or (eq? type 'dir) (eq? type 'link) (eq? type 'static-link)) - (unless (directory-exists? pkg) - (pkg-error "no such directory\n path: ~a" pkg)) - (let ([pkg (directory-path-no-slash pkg)]) + (define pkg-path (if (path? pkg) + pkg + (package-source->path pkg type))) + (unless (directory-exists? pkg-path) + (pkg-error "no such directory\n path: ~a" pkg-path)) + (let ([pkg-path (directory-path-no-slash pkg-path)]) (cond [(or (eq? type 'link) (eq? type 'static-link)) (install-info pkg-name `(,type ,(path->string (find-relative-path (pkg-installed-dir) - (simple-form-path pkg) + (simple-form-path pkg-path) #:more-than-root? #t))) - pkg + pkg-path #f given-checksum ; if a checksum is provided, just use it (directory->module-paths pkg pkg-name metadata-ns))] @@ -1344,7 +1364,7 @@ (if in-place? (if strip-mode (pkg-error "cannot strip directory in place") - pkg) + pkg-path) (let ([pkg-dir (make-temporary-file "pkg~a" 'directory)]) (delete-directory pkg-dir) (if strip-mode @@ -1353,13 +1373,13 @@ (generate-stripped-directory strip-mode pkg pkg-dir)) (begin (make-parent-directory* pkg-dir) - (copy-directory/files pkg pkg-dir #:keep-modify-seconds? #t))) + (copy-directory/files pkg-path pkg-dir #:keep-modify-seconds? #t))) pkg-dir))) (when (or (not in-place?) in-place-clean?) (drop-redundant-files pkg-dir)) (install-info pkg-name - `(dir ,(simple-form-path* pkg)) + `(dir ,(simple-form-path* pkg-path)) pkg-dir (or (not in-place?) in-place-clean?) given-checksum ; if a checksum is provided, just use it diff --git a/racket/collects/pkg/name.rkt b/racket/collects/pkg/name.rkt index e178e25a9e..522de3ad07 100644 --- a/racket/collects/pkg/name.rkt +++ b/racket/collects/pkg/name.rkt @@ -15,7 +15,10 @@ (values (or/c #f string?) (or/c #f package-source-format?)))] [package-source->name (->* (string?) ((or/c #f package-source-format?)) - (or/c #f string?))])) + (or/c #f string?))] + [package-source->path (->* (string?) + ((or/c #f 'file 'dir 'link 'static-link)) + path?)])) (define rx:package-name #rx"^[-_a-zA-Z0-9]+$") (define rx:archive #rx"[.](plt|zip|tar|tgz|tar[.]gz)$") @@ -200,3 +203,13 @@ (define (package-source->name s [given-type #f]) (define-values (name type) (package-source->name+type s given-type)) name) + +(define (package-source->path s [type #f]) + ((if (memq type '(dir link static-link)) + path->directory-path + values) + (cond + [(regexp-match? #rx"^file://" s) + (url->path (string->url s))] + [else + (string->path s)])))