From 344bffc959eec564f399e43bceadfaca41325785 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 4 Dec 2014 09:45:54 -0700 Subject: [PATCH] package manager: "file://" URLs and "?type=..." queries Allow a "file://" URL to specify a type that causes the path to be installed as a link or static link. A type query like that is mainly intended for use in a catalog, where a catalog of local directories could create links as needed for other packages (that might be pulled from other catalogs). --- .../racket-doc/pkg/scribblings/pkg.scrbl | 35 +++++-- .../racket-test/tests/pkg/test.rkt | 1 + .../tests/pkg/tests-catalog-links.rkt | 91 +++++++++++++++++++ .../racket-test/tests/pkg/tests-name.rkt | 4 + racket/collects/pkg/name.rkt | 20 +++- racket/collects/pkg/private/install.rkt | 48 +++++----- racket/collects/pkg/private/stage.rkt | 25 +++-- 7 files changed, 182 insertions(+), 42 deletions(-) create mode 100644 pkgs/racket-pkgs/racket-test/tests/pkg/tests-catalog-links.rkt diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl index a1145fcee5..e3752a022b 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl @@ -127,7 +127,8 @@ The valid archive formats are (currently) @filepath{.zip}, @filepath{.tar}, @filepath{.tgz}, @filepath{.tar.gz}, and @filepath{.plt}. -Any query or fragments parts of a @litchar{file://} URL are ignored. +Other than a @litchar{type} query, which affects inference as described below, +any query or fragments parts of a @litchar{file://} URL are ignored. For example, @filepath{~/tic-tac-toe.zip} is an archive package source, and its @tech{checksum} would be inside @@ -143,7 +144,11 @@ format does not accommodate either an extra directory layer or a A package source is inferred to refer to an archive file only when it has a suffix matching a valid archive format and when it starts with @litchar{file://} or does not start -with alphabetic characters followed by @litchar{://}. The inferred +with alphabetic characters followed by @litchar{://}. In the +case that the package source starts with @litchar{file://}, +it must be a URL without a @litchar{type} query or +with a @litchar{type} query value of @litchar{file}. +The inferred package name is the filename without its suffix. @history[#:changed "6.0.1.12" @@ -151,13 +156,15 @@ package name is the filename without its suffix. content within a top-level directory.} #:changed "6.1.1.5" @elem{Changed @litchar{file://} parsing to accept a general - URL and ignore any query or fragment.}]} + URL, recognize a @litchar{type} query, and ignore any + other query or fragment.}]} @; ---------------------------------------- @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. -Any query or fragments parts of a @litchar{file://} URL are ignored. +Other than a @litchar{type} query, which affects inference as described below, +any query or fragments parts of a @litchar{file://} URL are ignored. For example, @filepath{~/tic-tac-toe/} is a directory package source. @@ -166,12 +173,23 @@ A package source is inferred to refer to a directory only when it does not have a file-archive suffix, does not match the grammar of a package name, and either starts with starts with @litchar{file://} or does not start -with alphabetic characters followed by @litchar{://}. The inferred -package name is the directory name. +with alphabetic characters followed by @litchar{://}. In the +case that the package source starts with @litchar{file://}, +it must be a URL without a @litchar{type} query or +with a @litchar{type} query value of @litchar{dir}, @litchar{link}, or +@litchar{static-link}. +The inferred package name is the directory name. + +When the package source is a @litchar{file://} URL with a +@litchar{type} query value of @litchar{link} or @litchar{static-link}, +then the package is installed as directory link, the same as if +@DFlag{--link} or @DFlag{--static-link} is supplied to +@command-ref{install} or @command-ref{update}. @history[#:changed "6.1.1.5" @elem{Changed @litchar{file://} parsing to accept a general - URL and ignore any query or fragment.}]} + URL, recognize a @litchar{type} query, and ignore any + other query or fragment.}]} @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 @@ -450,7 +468,8 @@ sub-commands. @item{@DFlag{link} --- Implies @exec{--type dir} and links the existing directory as an installed package, instead of copying the directory's content to install. Directory @tech{package sources} are treated as links - by default, unless @DFlag{copy} is specified. + by default, unless @DFlag{copy} is specified or the directory name was reported by + a catalog instead of specified directly. The package is identified as a @tech{single-collection package} or a @tech{multi-collection package} at the diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/test.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/test.rkt index deeaca02db..6ab0444df4 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/test.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/test.rkt @@ -40,6 +40,7 @@ "overwrite" "config" "clone" + "catalog-links" "network" "planet" diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-catalog-links.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-catalog-links.rkt new file mode 100644 index 0000000000..99edd182df --- /dev/null +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-catalog-links.rkt @@ -0,0 +1,91 @@ +#lang racket/base +(require rackunit + racket/file + racket/format + "util.rkt" + "shelly.rkt") + +(this-test-is-run-by-the-main-test) + +(define (set-file path content) + (make-parent-directory* path) + (call-with-output-file* + path + #:exists 'truncate/replace + (lambda (o) (displayln content o)))) + +(define (make-cat-entry #:name name + #:source source + #:deps [deps null] + #:checksum [checksum "0"]) + `#hash((name . ,name) + (checksum . ,checksum) + (source . ,source) + (author . "test@racket-lang.org") + (description . ,(string-upcase name)) + (tags . ()) + (dependencies . ,deps) + (modules . ()))) + +(pkg-tests + (define dir (make-temporary-file "~a-tree" 'directory)) + + (with-fake-root + (shelly-wind + (set-file (build-path dir "test-pkg-1" "main.rkt") + "#lang racket/base 'one") + (define (make-one-cat-entry checksum) + (make-cat-entry #:name "test-pkg-1" + #:source "../test-pkg-1" ; <<<< not a link + #:checksum checksum)) + (set-file (build-path dir "catalog" "pkg" "test-pkg-1") + (~s (make-one-cat-entry "0"))) + + (set-file (build-path dir "test-pkg-2" "main.rkt") + "#lang racket/base (require test-pkg-1) 'two") + (set-file (build-path dir "test-pkg-2" "info.rkt") + "#lang info (define deps '(\"test-pkg-1\"))") + (set-file (build-path dir "catalog" "pkg" "test-pkg-2") + (~s (make-cat-entry + #:name "test-pkg-2" + #:deps '("test-pkg-1") + #:source "../test-pkg-2?type=link"))) ; <<<< a link + + (set-file (build-path dir "test-pkg-3" "main.rkt") + "#lang racket/base (require test-pkg-2) 'three") + (set-file (build-path dir "test-pkg-3" "info.rkt") + "#lang info (define deps '(\"test-pkg-2\"))") + (define (make-three-cat-entry checksum) + (make-cat-entry #:name "test-pkg-3" + #:deps '("test-pkg-2") + #:source "../test-pkg-3" ; <<<< not a link + #:checksum checksum)) + (set-file (build-path dir "catalog" "pkg" "test-pkg-3") + (~s (make-three-cat-entry "0"))) + + $ (~a "raco pkg install --auto --catalog file://" (build-path dir "catalog") " test-pkg-3") + $ "racket -l test-pkg-1" =stdout> "'one\n" + $ "racket -l test-pkg-2" =stdout> "'one\n'two\n" + $ "racket -l test-pkg-3" =stdout> "'one\n'two\n'three\n" + + ;; Change 2, change is immediately visible: + (set-file (build-path dir "test-pkg-2" "main.rkt") + "#lang racket/base (require test-pkg-1) 'TWO") + $ "racket -l test-pkg-3" =stdout> "'one\n'TWO\n'three\n" + + ;; Change 1 and 3, changes are not immediately visible, since not linked: + (set-file (build-path dir "test-pkg-1" "main.rkt") + "#lang racket/base 'ONE") + (set-file (build-path dir "test-pkg-3" "main.rkt") + "#lang racket/base (require test-pkg-2) 'THREE") + (set-file (build-path dir "catalog" "pkg" "test-pkg-1") + (~s (make-one-cat-entry "1"))) + (set-file (build-path dir "catalog" "pkg" "test-pkg-3") + (~s (make-three-cat-entry "1"))) + $ "racket -l test-pkg-3" =stdout> "'one\n'TWO\n'three\n" + + $ (~a "raco pkg update --auto --catalog file://" (build-path dir "catalog") " test-pkg-3") + $ "racket -l test-pkg-3" =stdout> "'ONE\n'TWO\n'THREE\n" + + (finally + (delete-directory/files dir))))) diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-name.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-name.rkt index 36f46e5c44..fbbe2930cb 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-name.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-name.rkt @@ -154,6 +154,10 @@ (check-equal-values? (parse "file:///root/fish.zip?ignored=yes#alsoIgnored" #f) (values "fish" 'file #t)) (check-equal-values? (parse "file:///root/fish?ignored=yes#alsoIgnored" #f) (values "fish" 'dir #t)) + (check-equal-values? (parse "file:///root/fish?type=link" #f) (values "fish" 'link #t)) + (check-equal-values? (parse "file:///root/fish?type=static-link" #f) (values "fish" 'static-link #t)) + (check-equal-values? (parse "file:///root/fish?type=sink" #f #rx"unrecognized") (values #f 'dir #f)) + (check-equal-values? (parse "random://racket-lang.org/fish.plt" #f #rx"scheme") (values #f #f #f)) (check-equal-values? (parse "" #f) (values #f #f #f)) diff --git a/racket/collects/pkg/name.rkt b/racket/collects/pkg/name.rkt index e4b5389a67..a97348382d 100644 --- a/racket/collects/pkg/name.rkt +++ b/racket/collects/pkg/name.rkt @@ -92,7 +92,7 @@ (complain-proc s msg)) (define complain-name (if must-infer-name? complain void)) - (define (parse-path s) + (define (parse-path s [type type]) (cond [(if type (eq? type 'file) @@ -258,8 +258,22 @@ [(and (not type) (regexp-match #rx"^file://" s)) => (lambda (m) - ;; Note that we're ignoring a query & fragment, if any: - (parse-path (url->path (string->url s))))] + (define u (string->url s)) + (define query-type + (for/or ([q (in-list (url-query u))]) + (and (eq? (car q) 'type) + (cond + [(equal? (cdr q) "link") 'link] + [(equal? (cdr q) "static-link") 'static-link] + [(equal? (cdr q) "file") 'file] + [(equal? (cdr q) "dir") 'dir] + [else + (complain "URL contains an unrecognized `type' query") + 'error])))) + (if (eq? query-type 'error) + (values #f 'dir) + ;; Note that we're ignoring other query & fragment parts, if any: + (parse-path (url->path u) (or query-type type))))] [(and (not type) (regexp-match? #rx"^[a-zA-Z]*://" s)) (complain "unrecognized URL scheme") diff --git a/racket/collects/pkg/private/install.rkt b/racket/collects/pkg/private/install.rkt index bf60950c1a..acfed80a84 100644 --- a/racket/collects/pkg/private/install.rkt +++ b/racket/collects/pkg/private/install.rkt @@ -990,6 +990,28 @@ => (lambda (m) (match-define (pkg-info orig-pkg checksum auto?) m) + + (define (update-dependencies) + (if (or deps? implies?) + ;; Check dependencies + (append-map + (packages-to-update download-printf db + #:must-update? #f + #:deps? deps? + #:implies? implies? + #:update-cache update-cache + #:namespace metadata-ns + #:catalog-lookup-cache catalog-lookup-cache + #:all-platforms? all-platforms? + #:ignore-checksums? ignore-checksums? + #:use-cache? use-cache? + #:from-command-line? from-command-line? + #:link-dirs? link-dirs?) + ((package-dependencies metadata-ns db all-platforms? + #:only-implies? (not deps?)) + pkg-name)) + null)) + (match orig-pkg [`(,(or 'link 'static-link) ,orig-pkg-dir) (if must-update? @@ -1000,7 +1022,7 @@ pkg-name (simple-form-path (path->complete-path orig-pkg-dir (pkg-installed-dir)))) - null)] + (update-dependencies))] [`(dir ,_) (if must-update? (pkg-error (~a "cannot update packages installed locally;\n" @@ -1008,7 +1030,7 @@ " package was installed via a local directory\n" " package name: ~a") pkg-name) - null)] + (update-dependencies))] [`(file ,_) (if must-update? (pkg-error (~a "cannot update packages installed locally;\n" @@ -1016,7 +1038,7 @@ " package was installed via a local file\n" " package name: ~a") pkg-name) - null)] + (update-dependencies))] [_ (define-values (orig-pkg-source orig-pkg-type orig-pkg-dir) (if (eq? 'clone (car orig-pkg)) @@ -1044,25 +1066,7 @@ (clear-checksums-in-cache! update-cache) (list (pkg-desc orig-pkg-source orig-pkg-type pkg-name #f auto? orig-pkg-dir)))) - (if (or deps? implies?) - ;; Check dependencies - (append-map - (packages-to-update download-printf db - #:must-update? #f - #:deps? deps? - #:implies? implies? - #:update-cache update-cache - #:namespace metadata-ns - #:catalog-lookup-cache catalog-lookup-cache - #:all-platforms? all-platforms? - #:ignore-checksums? ignore-checksums? - #:use-cache? use-cache? - #:from-command-line? from-command-line? - #:link-dirs? link-dirs?) - ((package-dependencies metadata-ns db all-platforms? - #:only-implies? (not deps?)) - pkg-name)) - null))]))] + (update-dependencies))]))] [else null])) (define (pkg-update in-pkgs diff --git a/racket/collects/pkg/private/stage.rkt b/racket/collects/pkg/private/stage.rkt index a5aa474fbf..c2533a414f 100644 --- a/racket/collects/pkg/private/stage.rkt +++ b/racket/collects/pkg/private/stage.rkt @@ -587,15 +587,22 @@ (when check-sums? (check-checksum given-checksum checksum "unexpected" pkg #f) (check-checksum checksum (install-info-checksum info) "incorrect" pkg #f)) - (define repo-url (let-values ([(name type) (package-source->name+type source #f)]) - (and (or (eq? type 'git) - (eq? type 'github)) - source))) - (update-install-info-orig-pkg - (update-install-info-checksum - info - checksum) - (desc->orig-pkg 'name pkg #f #:repo-url repo-url))] + (define-values (new-name new-type) (package-source->name+type source #f)) + (define repo-url (and (or (eq? new-type 'git) + (eq? new-type 'github)) + source)) + (case new-type + [(link static-link clone) + ;; The `source` must have been something like a `file://` + ;; URL that embeds a special installation type. In that case, + ;; we don't try to keep track of the catalog reference. + info] + [else + (update-install-info-orig-pkg + (update-install-info-checksum + info + checksum) + (desc->orig-pkg 'name pkg #f #:repo-url repo-url))])] [else (pkg-error "cannot infer package source type\n source: ~a" pkg)]))