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).
This commit is contained in:
Matthew Flatt 2014-12-04 09:45:54 -07:00
parent e7264d2d98
commit 344bffc959
7 changed files with 182 additions and 42 deletions

View File

@ -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

View File

@ -40,6 +40,7 @@
"overwrite"
"config"
"clone"
"catalog-links"
"network"
"planet"

View File

@ -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)))))

View File

@ -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))

View File

@ -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")

View File

@ -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

View File

@ -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)]))