From 72a4191aa99ac03c95870e596d1f5f6d414220e4 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 16 Aug 2013 21:14:31 -0600 Subject: [PATCH] raco pkg update: allow packages sources as replacements When an argument to `raco pkg update` is a package source, use it to place the currently installed package. Also, make the set of available command-line arguments more consistent, especially for `raco pkg install` and `raco pkg update`. Finally, fix the `--update-deps` flag, including checking the dependencies of each updated packages based on then update, instead of the pre-updated package. --- .../pkg/scribblings/getting-started.scrbl | 12 +- .../racket-doc/pkg/scribblings/lib.scrbl | 11 +- .../racket-doc/pkg/scribblings/pkg.scrbl | 67 +- .../tests/pkg/test-pkgs/pkg-test3-v3/main.rkt | 2 +- .../racket-test/tests/pkg/tests-create.rkt | 1 + .../racket-test/tests/pkg/tests-update.rkt | 118 ++- racket/collects/pkg/lib.rkt | 277 +++++-- racket/collects/pkg/main.rkt | 700 +++++++++--------- racket/collects/pkg/util.rkt | 5 +- racket/collects/planet/private/command.rkt | 13 +- 10 files changed, 760 insertions(+), 446 deletions(-) diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/getting-started.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/getting-started.scrbl index 02c80fb27a..1d9557b25e 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/getting-started.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/getting-started.scrbl @@ -86,7 +86,7 @@ package: The ``Checksum'' column reports the specific ``version'' of each package that is installed. A package can have a @tech{version} in a more traditional sense, but the @tech{checksum} is the ``version'' as -far as the package system is concerned. When you request an upgrade, +far as the package system is concerned. When you request an update, then a package installation is updated if the current implementation of the package has a different @tech{checksum} than the installed package, whether or not the package author adjusted the package's @@ -194,7 +194,7 @@ actual package implementation, so each package installed from a @tech{package catalog} is actually installed from a @filepath{.zip} file, Github repository, etc. Registering with a @tech{package catalog} is just a way of making your package easier to find and -upgrade. +update. @; ---------------------------------------- @@ -226,6 +226,14 @@ those dependencies. The end result is that @command-ref{update} might report a version-mismatch error that forces you to request more package updates than you originally requested. +Normally, you provide @tech{package names} to +@command-ref{update}. More generally, you can provide a @tech{package +source} to @command-ref{update}. In that case, a package with the same +name must be installed already, and the installed package is replaced +with the specified one. Replacing a package with a new @tech{package +source} is a generalization of fetching a replacement package that has +a new @tech{checksum} at a previously specified source. + @; ---------------------------------------- @section[#:tag "how-to-create"]{Creating Packages} diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl index 10408ccff1..3cb5d59e0a 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl @@ -195,14 +195,17 @@ port, unless @racket[quiet?] is true. The package lock must be held; see @racket[with-pkg-lock].} -@defproc[(pkg-update [names (listof string?)] +@defproc[(pkg-update [names (listof (or/c string? pkg-desc?))] [#:dep-behavior dep-behavior (or/c #f 'fail 'force 'search-ask 'search-auto) #f] [#:all? all? boolean? #f] [#:deps? deps? boolean? #f] + [#:force? force? boolean? #f] + [#:ignore-checksums? ignore-checksums? boolean? #f] [#:quiet? boolean? quiet? #f] - [#:strip strip (or/c #f 'source 'binary) #f]) + [#:strip strip (or/c #f 'source 'binary) #f] + [#:link-dirs? link-dirs? boolean? #f]) (or/c 'skip #f (listof (or/c path-string? @@ -211,6 +214,10 @@ The package lock must be held; see @racket[with-pkg-lock].} Implements @racket[pkg-update-command]. The result is the same as for @racket[pkg-install]. +A string in @racket[names] refers to an installed package that should +be checked for updates. A @racket[pkg-desc] in @racket[names] indicates +a package source that should replace the current installation. + The package lock must be held; see @racket[with-pkg-lock].} diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl index 6bdf2e345f..b2696b4716 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl @@ -291,10 +291,6 @@ sub-commands. @item{@DFlag{auto} --- Shorthand for @exec{@DFlag{deps} search-auto}.} - @item{@DFlag{force} --- Ignores conflicts (unsafe).} - - @item{@DFlag{ignore-checksums} --- Ignores errors verifying package @tech{checksums} (unsafe).} - @item{@DFlag{link} --- Implies @exec{--type dir} (and overrides any specified type), 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 @@ -317,10 +313,6 @@ sub-commands. @item{@DFlag{source} --- Strips built elements of a package before installing, and implies @DFlag{copy}.} - @item{@DFlag{skip-installed} --- Ignore any @nonterm{pkg-source} - whose name corresponds to an already-installed package, except for promoting auto-installed - packages to explicitly installed.} - @item{@DFlag{scope} @nonterm{scope} --- Selects the @tech{package scope} for installation, where @nonterm{scope} is one of @itemlist[ @item{@exec{installation} --- Install packages for all users of a Racket installation, rather than user-specific.} @@ -337,6 +329,14 @@ sub-commands. @item{@DFlag{catalog} @nonterm{catalog} --- Use @nonterm{catalog} instead of of the currently configured @tech{package catalogs}.} + @item{@DFlag{skip-installed} --- Ignore any @nonterm{pkg-source} + whose name corresponds to an already-installed package, except for promoting auto-installed + packages to explicitly installed.} + + @item{@DFlag{force} --- Ignores conflicts (unsafe).} + + @item{@DFlag{ignore-checksums} --- Ignores errors verifying package @tech{checksums} (unsafe).} + @item{@DFlag{no-setup} --- Does not run @exec{raco setup} after installation. This behavior is also the case if the environment variable @envvar{PLT_PKG_NOSETUP} is set to any non-empty value.} @@ -345,31 +345,46 @@ sub-commands. -@subcommand{@command/toc{update} @nonterm{option} ... @nonterm{pkg} ... ---- Checks the specified packages for -@tech{package updates}. If an update is found, but it cannot be -installed (e.g. it conflicts with another installed package), then -this command fails without installing any of the @nonterm{pkg}s -(or their dependencies). +@subcommand{@command/toc{update} @nonterm{option} ... @nonterm{pkg-source} ... +--- Checks the specified package names for @tech{package updates} or +replaces existing package installations with the given sources. If an +update or replacement cannot be installed (e.g. it conflicts with +another installed package), then this command fails without installing +any of the @nonterm{pkg-source}s (or their dependencies). If a @tech{package scope} is not specified, the scope is inferred from -the given @nonterm{pkg}s. +the given @nonterm{pkg-source}s. The @exec{update} sub-command accepts the following @nonterm{option}s: @itemlist[ @item{@DFlag{all} or @Flag{a} --- Update all packages, if no packages are given in the argument list.} - @item{@DFlag{update-deps} --- Checks the named packages plus their dependencies (transitively) for updates.} + + @item{@DFlag{update-deps} --- Checks dependencies (transitively) for updates.} + + @item{@DFlag{lookup} --- Checks Causes a @tech{package name} as a @nonterm{pkg-source} to be used + as a replacement, instead of the name of a installed package that may have updates. + (If the named package was installed through a package name, then there's effectively + no difference.)} + + @item{@DFlag{type} @nonterm{type} or @Flag{t} @nonterm{type} --- Same as for @command-ref{install}.} + @item{@DFlag{name} @nonterm{pkg} or @Flag{n} @nonterm{pkg} --- Same as for @command-ref{install}.} @item{@DFlag{deps} @nonterm{behavior} --- Same as for @command-ref{install}.} @item{@DFlag{auto} --- Shorthand for @exec{@DFlag{deps} search-auto} plus @DFlag{update-deps}.} + @item{@DFlag{link} --- Same as for @command-ref{install}.} + @item{@DFlag{static-link} --- Same as for @command-ref{install}.} + @item{@DFlag{binary} --- Same as for @command-ref{install}.} + @item{@DFlag{copy} --- Same as for @command-ref{install}.} + @item{@DFlag{source} --- Same as for @command-ref{install}.} @item{@DFlag{scope} @nonterm{scope} --- Selects a @tech{package scope}, the same as for @command-ref{install}.} @item{@Flag{i} or @DFlag{installation} --- Shorthand for @exec{--scope installation}.} @item{@Flag{u} or @DFlag{user} --- Shorthand for @exec{--scope user}.} @item{@DFlag{scope-dir} @nonterm{dir} --- Selects @nonterm{dir} as the @tech{package scope}, the same as for @command-ref{install}.} + @item{@DFlag{catalog} @nonterm{catalog} --- Same as for @command-ref{install}.} + @item{@DFlag{force} --- Same as for @command-ref{install}.} + @item{@DFlag{ignore-checksums} --- Same as for @command-ref{install}.} @item{@DFlag{no-setup} --- Same as for @command-ref{install}.} - @item{@DFlag{binary} --- Same as for @command-ref{install}.} - @item{@DFlag{source} --- Same as for @command-ref{install}.} @item{@DFlag{jobs} @nonterm{n} or @Flag{j} @nonterm{n} --- Same as for @command-ref{install}.} ] } @@ -390,7 +405,8 @@ the given @nonterm{pkg}s. (leaving auto-installed packages as such). Combined with @DFlag{auto}, removes packages for which there are no dependencies.} @item{@DFlag{force} --- Ignore dependencies when removing packages.} - @item{@DFlag{auto} --- Remove auto-installed packages (i.e., installed by the @exec{search-auto} or @exec{search-ask} + @item{@DFlag{auto} --- In addition to removing each @nonterm{pkg}, + remove auto-installed packages (i.e., installed by the @exec{search-auto} or @exec{search-ask} dependency behavior, or demoted via @DFlag{demote}) that are no longer required by any explicitly installed package.} @item{@DFlag{scope} @nonterm{scope} --- Selects a @tech{package scope}, the same as for @command-ref{install}.} @@ -440,8 +456,6 @@ the given @nonterm{pkg}s. @item{@DFlag{deps} @nonterm{behavior} --- Same as for @command-ref{install}, except that @exec{search-auto} is the default.} - @item{@DFlag{force} --- Same as for @command-ref{install}.} - @item{@DFlag{ignore-checksums} --- Same as for @command-ref{install}.} @item{@DFlag{binary} --- Same as for @command-ref{install}.} @item{@DFlag{source} --- Same as for @command-ref{install}.} @item{@DFlag{scope} @nonterm{scope} --- Same as for @command-ref{install}.} @@ -449,6 +463,8 @@ the given @nonterm{pkg}s. @item{@Flag{u} or @DFlag{user} --- Shorthand for @exec{--scope user}.} @item{@DFlag{scope-dir} @nonterm{dir} --- Select @nonterm{dir} as the @tech{package scope}.} @item{@DFlag{catalog} @nonterm{catalog} --- Same as for @command-ref{install}.} + @item{@DFlag{force} --- Same as for @command-ref{install}.} + @item{@DFlag{ignore-checksums} --- Same as for @command-ref{install}.} @item{@DFlag{no-setup} --- Same as for @command-ref{install}.} @item{@DFlag{jobs} @nonterm{n} or @Flag{j} @nonterm{n} --- Same as for @command-ref{install}.} ] @@ -497,9 +513,10 @@ View and modify configuration of the package manager itself, with the following as the default value at @exec{user} scope.} @item{@Flag{i} or @DFlag{installation} --- Shorthand for @exec{--scope installation}.} @item{@Flag{u} or @DFlag{user} --- Shorthand for @exec{--scope user}.} + @item{@DFlag{scope-dir} @nonterm{dir} --- Same as for @command-ref{install}.} ] - The valid keys are: + The valid @nonterm{key}s are: @itemlist[ @item{@exec{catalogs} --- A list of URLs for @tech{package catalogs}.} @item{@exec{default-scope} --- Either @exec{installation} or @exec{user}. @@ -530,7 +547,8 @@ View and modify configuration of the package manager itself, with the following @item{@DFlag{modules} --- Show the modules that are implemented by a package.} @item{@DFlag{catalog} @nonterm{catalog} --- Query @nonterm{catalog} instead of the currently configured @tech{package catalogs}.} - @item{@DFlag{version} @nonterm{version} --- Query catalogs for a result specific to @nonterm{version}, + @item{@DFlag{version} @nonterm{version} or @Flag{v} @nonterm{version} --- Query catalogs + for a result specific to @nonterm{version}, instead of the installation's Racket version.} ] } @@ -559,7 +577,8 @@ View and modify configuration of the package manager itself, with the following over new information.} @item{@DFlag{override} --- Changes merging so that new information takes precedence over information already in @nonterm{dest-catalog}.} - @item{@DFlag{version} @nonterm{version} --- Copy catalog results specific to @nonterm{version} + @item{@DFlag{version} @nonterm{version} or @Flag{v} @nonterm{version} --- Copy catalog + results specific to @nonterm{version} (for catalogs that make a distinction), instead of the installation's Racket version.} ] } diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-test3-v3/main.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-test3-v3/main.rkt index 5dbec17d00..961aa0f755 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-test3-v3/main.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/test-pkgs/pkg-test3-v3/main.rkt @@ -1,4 +1,4 @@ #lang racket/base -(printf "pkg-test3/main loaded\n") +(printf "pkg-test3/main version 3 loaded\n") (exit 0) diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-create.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-create.rkt index 6cfcdfd6d4..5181bf0dd1 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-create.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-create.rkt @@ -44,6 +44,7 @@ (shelly-create "racket-conflict" "tgz") (shelly-create "pkg-test3" "zip") (shelly-create "pkg-test3-v2" "zip") + (shelly-create "pkg-test3-v3" "zip") $ "raco pkg create --format txt test-pkgs/pkg-test1" =exit> 1 diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-update.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-update.rkt index f4f78561bf..c202d364f1 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-update.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-update.rkt @@ -25,6 +25,31 @@ (shelly-install "local packages can't be updated (directory)" "test-pkgs/pkg-test1/" $ "raco pkg update pkg-test1" =exit> 1) + (shelly-wind + $ "mkdir -p test-pkgs/update-test" + $ "cp -f test-pkgs/pkg-test1-v2.zip test-pkgs/update-test/pkg-test1.zip" + (shelly-install* "packages can be replaced with local packages (file)" + "test-pkgs/pkg-test1.zip" + "pkg-test1" + $ "racket -e '(require pkg-test1/update)'" =exit> 42 + $ "raco pkg update test-pkgs/update-test/pkg-test1.zip" + $ "racket -e '(require pkg-test1/update)'" =exit> 43) + (finally + $ "rm -f test-pkgs/update-test/pkg-test1.zip")) + (shelly-install "packages can be replaced with local packages (file + name)" + "test-pkgs/pkg-test1.zip" + $ "racket -e '(require pkg-test1/update)'" =exit> 42 + $ "raco pkg update --name pkg-test1 test-pkgs/pkg-test1-v2.zip" + $ "racket -e '(require pkg-test1/update)'" =exit> 43) + (shelly-install "packages can be replaced with local packages (directory)" + "test-pkgs/pkg-test1.zip" + $ "racket -e '(require pkg-test1/update)'" =exit> 42 + $ "raco pkg update --name pkg-test1 test-pkgs/pkg-test1-v2" + $ "racket -e '(require pkg-test1/update)'" =exit> 43) + (shelly-install "replacement checksum can be checked" + "test-pkgs/pkg-test1.zip" + $ "raco pkg update test-pkgs/pkg-test1.zip" =stdout> "No updates available\n") + (shelly-wind $ "mkdir -p test-pkgs/update-test" $ "cp -f test-pkgs/pkg-test1.zip test-pkgs/update-test/pkg-test1.zip" @@ -32,7 +57,7 @@ (shelly-install* "remote packages can be updated" "http://localhost:9999/update-test/pkg-test1.zip" "pkg-test1" - $ "raco pkg update pkg-test1" =exit> 0 =stdout> "Downloading checksum\nNo updates available\n" + $ "raco pkg update pkg-test1" =exit> 0 =stdout> "Downloading checksum for pkg-test1\nNo updates available\n" $ "racket -e '(require pkg-test1/update)'" =exit> 42 $ "cp -f test-pkgs/pkg-test1-v2.zip test-pkgs/update-test/pkg-test1.zip" $ "cp -f test-pkgs/pkg-test1-v2.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM" @@ -49,7 +74,7 @@ (shelly-install* "remote packages can be updated, single-collection to multi-collection" "test-pkgs/pkg-test1.zip http://localhost:9999/update-test/pkg-test3.zip" "pkg-test1 pkg-test3" - $ "raco pkg update pkg-test3" =exit> 0 =stdout> "Downloading checksum\nNo updates available\n" + $ "raco pkg update pkg-test3" =exit> 0 =stdout> "Downloading checksum for pkg-test3\nNo updates available\n" $ "cp -f test-pkgs/pkg-test3-v2.zip test-pkgs/update-test/pkg-test3.zip" $ "cp -f test-pkgs/pkg-test3-v2.zip.CHECKSUM test-pkgs/update-test/pkg-test3.zip.CHECKSUM" $ "raco pkg update pkg-test3" =exit> 0 @@ -65,7 +90,7 @@ (shelly-install* "remote packages can be updated, multi-colelction to single-collection" "test-pkgs/pkg-test1.zip http://localhost:9999/update-test/pkg-test3.zip" "pkg-test1 pkg-test3" - $ "raco pkg update pkg-test3" =exit> 0 =stdout> "Downloading checksum\nNo updates available\n" + $ "raco pkg update pkg-test3" =exit> 0 =stdout> "Downloading checksum for pkg-test3\nNo updates available\n" $ "cp -f test-pkgs/pkg-test3.zip test-pkgs/update-test/pkg-test3.zip" $ "cp -f test-pkgs/pkg-test3.zip.CHECKSUM test-pkgs/update-test/pkg-test3.zip.CHECKSUM" $ "raco pkg update pkg-test3" =exit> 0 @@ -78,11 +103,14 @@ $ "mkdir -p test-pkgs/update-test" $ "cp -f test-pkgs/pkg-test1.zip test-pkgs/update-test/pkg-test1.zip" $ "cp -f test-pkgs/pkg-test1.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM" + $ "cp -f test-pkgs/pkg-test2.zip test-pkgs/update-test/pkg-test2.zip" + $ "cp -f test-pkgs/pkg-test2.zip.CHECKSUM test-pkgs/update-test/pkg-test2.zip.CHECKSUM" (shelly-install* "update deps" "http://localhost:9999/update-test/pkg-test1.zip" "pkg-test1" - $ "raco pkg install test-pkgs/pkg-test2.zip" - $ "raco pkg update --update-deps pkg-test2" =exit> 0 =stdout> "Downloading checksum\nNo updates available\n" + $ "raco pkg install http://localhost:9999/update-test/pkg-test2.zip" + $ "raco pkg update --update-deps pkg-test2" =exit> 0 + =stdout> "Downloading checksum for pkg-test2\nDownloading checksum for pkg-test1\nNo updates available\n" $ "racket -e '(require pkg-test1/update)'" =exit> 42 $ "cp -f test-pkgs/pkg-test1-v2.zip test-pkgs/update-test/pkg-test1.zip" $ "cp -f test-pkgs/pkg-test1-v2.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM" @@ -97,11 +125,87 @@ $ "mkdir -p test-pkgs/update-test" $ "cp -f test-pkgs/pkg-test1.zip test-pkgs/update-test/pkg-test1.zip" $ "cp -f test-pkgs/pkg-test1.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM" - (shelly-install* "update all is default" + $ "cp -f test-pkgs/pkg-test3.zip test-pkgs/update-test/pkg-test3.zip" + $ "cp -f test-pkgs/pkg-test3.zip.CHECKSUM test-pkgs/update-test/pkg-test3.zip.CHECKSUM" + (shelly-install* "update original and deps" + "http://localhost:9999/update-test/pkg-test1.zip" + "pkg-test1" + $ "raco pkg install http://localhost:9999/update-test/pkg-test3.zip" + $ "raco pkg update --update-deps pkg-test3" =exit> 0 + =stdout> "Downloading checksum for pkg-test3\nDownloading checksum for pkg-test1\nNo updates available\n" + $ "racket -e '(require pkg-test1/update)'" =exit> 42 + $ "cp -f test-pkgs/pkg-test1-v2.zip test-pkgs/update-test/pkg-test1.zip" + $ "cp -f test-pkgs/pkg-test1-v2.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM" + $ "cp -f test-pkgs/pkg-test3-v2.zip test-pkgs/update-test/pkg-test3.zip" + $ "cp -f test-pkgs/pkg-test3-v2.zip.CHECKSUM test-pkgs/update-test/pkg-test3.zip.CHECKSUM" + $ "raco pkg update --update-deps pkg-test3" =exit> 0 + $ "racket -e '(require pkg-test1/update)'" =exit> 43 + $ "racket -e '(require pkg-test3)'" =stdout> #rx"version 2 loaded" + $ "raco pkg remove pkg-test3") + (finally + $ "rm -f test-pkgs/update-test/pkg-test1.zip" + $ "rm -f test-pkgs/update-test/pkg-test1.zip.CHECKSUM")) + + (shelly-wind + $ "mkdir -p test-pkgs/update-test" + $ "cp -f test-pkgs/pkg-test1.zip test-pkgs/update-test/pkg-test1.zip" + $ "cp -f test-pkgs/pkg-test1.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM" + $ "cp -f test-pkgs/pkg-test3.zip test-pkgs/update-test/pkg-test3.zip" + $ "cp -f test-pkgs/pkg-test3.zip.CHECKSUM test-pkgs/update-test/pkg-test3.zip.CHECKSUM" + (shelly-install* "update original, where update has no deps" + "http://localhost:9999/update-test/pkg-test1.zip" + "pkg-test1" + $ "raco pkg install http://localhost:9999/update-test/pkg-test3.zip" + $ "raco pkg update --update-deps pkg-test3" =exit> 0 + =stdout> "Downloading checksum for pkg-test3\nDownloading checksum for pkg-test1\nNo updates available\n" + $ "racket -e '(require pkg-test1/update)'" =exit> 42 + $ "cp -f test-pkgs/pkg-test1-v2.zip test-pkgs/update-test/pkg-test1.zip" + $ "cp -f test-pkgs/pkg-test1-v2.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM" + $ "cp -f test-pkgs/pkg-test3-v3.zip test-pkgs/update-test/pkg-test3.zip" + $ "cp -f test-pkgs/pkg-test3-v3.zip.CHECKSUM test-pkgs/update-test/pkg-test3.zip.CHECKSUM" + $ "raco pkg update --update-deps pkg-test3" =exit> 0 + $ "racket -e '(require pkg-test1/update)'" =exit> 42 + $ "racket -e '(require pkg-test3)'" =stdout> #rx"version 3 loaded" + $ "raco pkg remove pkg-test3") + (finally + $ "rm -f test-pkgs/update-test/pkg-test1.zip" + $ "rm -f test-pkgs/update-test/pkg-test1.zip.CHECKSUM")) + + (shelly-wind + $ "mkdir -p test-pkgs/update-test" + $ "cp -f test-pkgs/pkg-test1.zip test-pkgs/update-test/pkg-test1.zip" + $ "cp -f test-pkgs/pkg-test1.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM" + $ "cp -f test-pkgs/pkg-test3-v3.zip test-pkgs/update-test/pkg-test3.zip" + $ "cp -f test-pkgs/pkg-test3-v3.zip.CHECKSUM test-pkgs/update-test/pkg-test3.zip.CHECKSUM" + (shelly-install* "update and get updates for newly introduced deps" + "http://localhost:9999/update-test/pkg-test1.zip" + "pkg-test1" + $ "raco pkg install http://localhost:9999/update-test/pkg-test3.zip" + $ "racket -e '(require pkg-test3)'" =stdout> #rx"version 3 loaded" + $ "raco pkg update --update-deps pkg-test3" =exit> 0 + =stdout> "Downloading checksum for pkg-test3\nNo updates available\n" + $ "racket -e '(require pkg-test1/update)'" =exit> 42 + $ "cp -f test-pkgs/pkg-test1-v2.zip test-pkgs/update-test/pkg-test1.zip" + $ "cp -f test-pkgs/pkg-test1-v2.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM" + $ "cp -f test-pkgs/pkg-test3.zip test-pkgs/update-test/pkg-test3.zip" + $ "cp -f test-pkgs/pkg-test3.zip.CHECKSUM test-pkgs/update-test/pkg-test3.zip.CHECKSUM" + $ "raco pkg update --update-deps pkg-test3" =exit> 0 + $ "racket -e '(require pkg-test1/update)'" =exit> 43 + $ "racket -e '(require pkg-test3)'" =stdout> #rx"main loaded" + $ "raco pkg remove pkg-test3") + (finally + $ "rm -f test-pkgs/update-test/pkg-test1.zip" + $ "rm -f test-pkgs/update-test/pkg-test1.zip.CHECKSUM")) + + (shelly-wind + $ "mkdir -p test-pkgs/update-test" + $ "cp -f test-pkgs/pkg-test1.zip test-pkgs/update-test/pkg-test1.zip" + $ "cp -f test-pkgs/pkg-test1.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM" + (shelly-install* "update all" "http://localhost:9999/update-test/pkg-test1.zip" "pkg-test1" $ "raco pkg install test-pkgs/pkg-test2.zip" - $ "raco pkg update -a" =exit> 0 =stdout> "Downloading checksum\nNo updates available\n" + $ "raco pkg update -a" =exit> 0 =stdout> "Downloading checksum for pkg-test1\nNo updates available\n" $ "racket -e '(require pkg-test1/update)'" =exit> 42 $ "cp -f test-pkgs/pkg-test1-v2.zip test-pkgs/update-test/pkg-test1.zip" $ "cp -f test-pkgs/pkg-test1-v2.zip.CHECKSUM test-pkgs/update-test/pkg-test1.zip.CHECKSUM" diff --git a/racket/collects/pkg/lib.rkt b/racket/collects/pkg/lib.rkt index ae03bee2a2..0313de82a2 100644 --- a/racket/collects/pkg/lib.rkt +++ b/racket/collects/pkg/lib.rkt @@ -412,13 +412,26 @@ (hash 'source (db:pkg-source pkg) 'checksum (db:pkg-source pkg)))) -(define (remote-package-checksum pkg download-printf) +(define (remote-package-checksum pkg download-printf pkg-name) (match pkg [`(catalog ,pkg-name) (hash-ref (package-catalog-lookup pkg-name #f download-printf) 'checksum)] [`(url ,pkg-url-str) (package-url->checksum pkg-url-str - #:download-printf download-printf)])) + #:download-printf download-printf + #:pkg-name pkg-name)])) + +(define (checksum-for-pkg-source pkg-source type pkg-name download-printf) + (cond + [(or (eq? type 'file-url) (eq? type 'dir-url) (eq? type 'github)) + (remote-package-checksum `(url ,pkg-source) download-printf pkg-name)] + [(eq? type 'file) + (define checksum-pth (format "~a.CHECKSUM" pkg-source)) + (or (and (file-exists? checksum-pth) + (file->string checksum-pth)) + (and (file-exists? pkg-source) + (call-with-input-file* pkg-source sha1)))] + [else #f])) (define (write-file-hash! file new-db) (unless (eq? (pkg-lock-held) 'exclusive) @@ -825,7 +838,7 @@ (define orig-pkg `(url ,pkg)) (define checksum (or given-checksum - (remote-package-checksum orig-pkg download-printf))) + (remote-package-checksum orig-pkg download-printf pkg-name))) (define info (update-install-info-orig-pkg (match type @@ -1158,6 +1171,8 @@ #:old-descs [old-descs empty] #:pre-succeed [pre-succeed void] #:dep-behavior [dep-behavior #f] + #:update-deps? [update-deps? #f] + #:update-cache [update-cache #f] #:updating? [updating? #f] #:ignore-checksums? [ignore-checksums? #f] #:skip-installed? [skip-installed? #f] @@ -1184,14 +1199,16 @@ (delete-directory/files pkg-dir))) (define (format-deps update-deps) (format-list (for/list ([ud (in-list update-deps)]) - (format "~a (have ~a, need ~a)" - (car ud) - (caddr ud) - (cadddr ud))))) + (if (pkg-desc? ud) + (pkg-desc-name ud) + (format "~a (have ~a, need ~a)" + (car ud) + (caddr ud) + (cadddr ud)))))) (define (show-dependencies deps update? auto? conversation) (unless quiet? - (printf/flush "The following ~a packages are listed as dependencies of ~a~a:~a\n" - (if update? "out-of-date" "uninstalled") + (printf/flush "The following~a packages are listed as dependencies of ~a~a:~a\n" + (if update? " out-of-date" " uninstalled") pkg-name (if (or auto? (eq? conversation 'always-yes)) (format "\nand they will be ~a~a" @@ -1331,6 +1348,30 @@ [(no) (clean!) (pkg-error "missing dependencies\n missing packages:~a" (format-list unsatisfied-deps))])]))] + [(and + update-deps? + (let () + (define deps (get-all-deps metadata-ns pkg-dir)) + (define update-pkgs + (append-map (λ (dep) + (define name (dependency->name dep)) + (define this-platform? (dependency-this-platform? dep)) + (or (and this-platform? + (not (hash-ref simultaneous-installs name #f)) + ((packages-to-update download-printf current-scope-db + #:must-update? #f #:deps? #t + #:update-cache update-cache + #:namespace metadata-ns) + name)) + null)) + deps)) + (and (not (empty? update-pkgs)) + update-pkgs))) + => (lambda (update-pkgs) + (show-dependencies update-pkgs #t #f 'always-yes) + (raise (vector #t infos update-pkgs + (λ () (for-each (compose (remove-package quiet?) pkg-desc-name) update-pkgs)) + install-conversation update-conversation)))] [(and (not (eq? dep-behavior 'force)) (let () @@ -1393,8 +1434,12 @@ ;; Try updates: (define update-pkgs (map car update-deps)) (define (make-pre-succeed) - (define db (read-pkg-db)) - (let ([to-update (filter-map (update-package download-printf db) update-pkgs)]) + (define db current-scope-db) + (let ([to-update (append-map (packages-to-update download-printf db + #:deps? update-deps? + #:update-cache update-cache + #:namespace metadata-ns) + update-pkgs)]) (λ () (for-each (compose (remove-package quiet?) pkg-desc-name) to-update)))) (match (or dep-behavior (if name? @@ -1592,6 +1637,8 @@ #:skip-installed? [skip-installed? #f] #:pre-succeed [pre-succeed void] #:dep-behavior [dep-behavior #f] + #:update-deps? [update-deps? #f] + #:update-cache [update-cache #f] #:updating? [updating? #f] #:quiet? [quiet? #f] #:install-conversation [install-conversation #f] @@ -1621,13 +1668,17 @@ #:force? force #:ignore-checksums? ignore-checksums? #:dep-behavior dep-behavior + #:update-deps? update-deps? + #:update-cache update-cache #:pre-succeed (lambda () (pre-succeed) (more-pre-succeed)) #:updating? updating? #:install-conversation inst-conv #:update-conversation updt-conv #:strip strip-mode (for/list ([dep (in-list deps)]) - (pkg-desc dep #f #f #t)))])]) + (if (pkg-desc? dep) + dep + (pkg-desc dep #f #f #t))))])]) (install-packages #:old-infos old-infos #:old-descs old-descs @@ -1635,6 +1686,8 @@ #:ignore-checksums? ignore-checksums? #:skip-installed? skip-installed? #:dep-behavior dep-behavior + #:update-deps? update-deps? + #:update-cache update-cache #:pre-succeed pre-succeed #:updating? updating? #:quiet? quiet? @@ -1644,42 +1697,126 @@ #:link-dirs? link-dirs? new-descs))) -(define ((update-is-possible? db) pkg-name) - (match-define (pkg-info orig-pkg checksum _) - (package-info pkg-name #:db db)) - (define ty (first orig-pkg)) - (not (member ty '(link static-link dir file)))) +;; Determine packages to update, starting with `pkg-name'. If `pkg-name' +;; needs to be updated, return it in a list. Otherwise, if `deps?', +;; then return a list of dependencies that need to be updated. +;; (If a package needs to be updated, wait until the update +;; has been inspected for further dependencies.) +;; If `must-installed?', then complain if the package is not +;; installed inthe current scope. +;; If `must-update?', then complain if the package is not +;; updatable. +;; The `update-cache' argument is used to cache which packages +;; are already being updated and downloaded checksums. +(define ((packages-to-update download-printf db + #:must-installed? [must-installed? #t] + #:must-update? [must-update? #t] + #:deps? [deps? #f] + #:namespace metadata-ns + #:update-cache update-cache) + pkg-name) + (cond + [(pkg-desc? pkg-name) + ;; Infer the package-source type and name: + (define-values (inferred-name type) (package-source->name+type + (pkg-desc-source pkg-name) + (pkg-desc-type pkg-name))) + (define name (or (pkg-desc-name pkg-name) + inferred-name)) + ;; Check that the package is installed, and get current checksum: + (define info (package-info name #:db db)) + (if (or (not (pkg-info-checksum info)) + (not (equal? (pkg-info-checksum info) + (checksum-for-pkg-source (pkg-desc-source pkg-name) + type + name download-printf)))) + ;; Update: + (begin + (hash-set! update-cache (pkg-desc-source pkg-name) #t) + (list (pkg-desc (pkg-desc-source pkg-name) + (pkg-desc-type pkg-name) + name + (pkg-desc-auto? pkg-name)))) + ;; No update needed, but maybe check dependencies: + (if deps? + ((packages-to-update download-printf db + #:must-update? #f + #:deps? #t + #:update-cache update-cache + #:namespace metadata-ns) + pkg-name) + null))] + [(eq? #t (hash-ref update-cache pkg-name #f)) + ;; package is already being updated + null] + ;; A string indicates that package source that should be + ;; looked up in the installed packages to get the old source + ;; for getting the checksum: + [(package-info pkg-name #:db db must-update?) + => + (lambda (m) + (match-define (pkg-info orig-pkg checksum auto?) m) + (match orig-pkg + [`(,(or 'link 'static-link) ,_) + (if must-update? + (pkg-error (~a "cannot update linked packages\n" + " package name: ~a\n" + " package source: ~a") + pkg-name + orig-pkg) + null)] + [`(dir ,_) + (if must-update? + (pkg-error (~a "cannot update packages installed locally;\n" + " package was installed via a local directory\n" + " package name: ~a") + pkg-name) + null)] + [`(file ,_) + (if must-update? + (pkg-error (~a "cannot update packages installed locally;\n" + " package was installed via a local file\n" + " package name: ~a") + pkg-name) + null)] + [`(,_ ,orig-pkg-source) + (define new-checksum + (or (hash-ref update-cache pkg-name #f) + (remote-package-checksum orig-pkg download-printf pkg-name))) + ;; Record downloaded checksum: + (hash-set! update-cache pkg-name new-checksum) + (or (and new-checksum + (not (equal? checksum new-checksum)) + (begin + ;; Update it: + (hash-set! update-cache pkg-name #t) + ;; Flush cache of downloaded checksums, in case + ;; there was a race between our checkig and updates on + ;; the catalog server: + (clear-checksums-in-cache! update-cache) + ;; FIXME: the type shouldn't be #f here; it should be + ;; preseved from install time: + (list (pkg-desc orig-pkg-source #f pkg-name auto?)))) + (if deps? + ;; Check dependencies + (append-map + (packages-to-update download-printf db + #:must-update? #f + #:deps? #t + #:update-cache update-cache + #:namespace metadata-ns) + ((package-dependencies metadata-ns db) pkg-name)) + null))]))] + [else null])) -(define ((update-package download-printf db) pkg-name) - (match-define (pkg-info orig-pkg checksum auto?) - (package-info pkg-name #:db db)) - (match orig-pkg - [`(,(or 'link 'static-link) ,_) - (pkg-error (~a "cannot update linked packages\n" - " package name: ~a\n" - " package source: ~a") - pkg-name - orig-pkg)] - [`(dir ,_) - (pkg-error (~a "cannot update packages installed locally;\n" - " package was installed via a local directory\n" - " package name: ~a") - pkg-name)] - [`(file ,_) - (pkg-error (~a "cannot update packages installed locally;\n" - " package was installed via a local file\n" - " package name: ~a") - pkg-name)] - [`(,_ ,orig-pkg-source) - (define new-checksum - (remote-package-checksum orig-pkg download-printf)) - (and new-checksum - (not (equal? checksum new-checksum)) - ;; FIXME: the type shouldn't be #f here; it should be - ;; preseved from install time: - (pkg-desc orig-pkg-source #f pkg-name auto?))])) +(define (clear-checksums-in-cache! update-cache) + (define l (for/list ([(k v) (in-hash update-cache)] + #:when (string? v)) + k)) + (for ([k (in-list l)]) (hash-remove! update-cache k))) + -(define ((package-dependencies metadata-ns db) pkg-name) +(define ((package-dependencies metadata-ns db) pkg-name) (map dependency->name (filter dependency-this-platform? (get-all-deps metadata-ns (pkg-directory* pkg-name #:db db))))) @@ -1687,23 +1824,27 @@ (define (pkg-update in-pkgs #:all? [all? #f] #:dep-behavior [dep-behavior #f] - #:deps? [deps? #f] + #:force? [force? #f] + #:ignore-checksums? [ignore-checksums? #f] + #:deps? [update-deps? #f] #:quiet? [quiet? #f] - #:strip [strip-mode #f]) + #:strip [strip-mode #f] + #:link-dirs? [link-dirs? #f]) (define download-printf (if quiet? void printf)) (define metadata-ns (make-metadata-namespace)) (define db (read-pkg-db)) - (define pkgs - (cond - [(and all? (empty? in-pkgs)) - (filter (update-is-possible? db) (hash-keys db))] - [deps? - (append-map - (package-dependencies metadata-ns db) - in-pkgs)] - [else - in-pkgs])) - (define to-update (filter-map (update-package download-printf db) pkgs)) + (define all-mode? (and all? (empty? in-pkgs))) + (define pkgs (cond + [all-mode? (hash-keys db)] + [else in-pkgs])) + (define update-cache (make-hash)) + (define to-update (append-map (packages-to-update download-printf db + #:must-update? (not all-mode?) + #:deps? (or update-deps? + all-mode?) ; avoid races + #:update-cache update-cache + #:namespace metadata-ns) + pkgs)) (cond [(empty? to-update) (unless quiet? @@ -1719,8 +1860,13 @@ #:updating? #t #:pre-succeed (λ () (for-each (compose (remove-package quiet?) pkg-desc-name) to-update)) #:dep-behavior dep-behavior + #:update-deps? update-deps? + #:update-cache update-cache #:quiet? quiet? #:strip strip-mode + #:force? force? + #:ignore-checksums? ignore-checksums? + #:link-dirs? link-dirs? to-update)])) (define (pkg-show indent @@ -1868,7 +2014,7 @@ [(list) (pkg-error "config key not provided")] [_ - (pkg-error "multiple config keys provided")])])) + (pkg-error "multiple config keys provided (not in value-setting mode)")])])) (define (create-as-is create:format pkg-name dir orig-dir #:quiet? [quiet? #f] @@ -1963,7 +2109,9 @@ (create-as-is create:format name dest-dir dir #:hide-src? #t #:quiet? quiet? - #:dest archive-dest-dir)) + #:dest (if archive-dest-dir + (path->complete-path archive-dest-dir) + (current-directory)))) (lambda () (delete-directory/files tmp-dir)))) @@ -2499,12 +2647,15 @@ #:dest (or/c (and/c path-string? complete-path?) #f)) void?)] [pkg-update - (->* ((listof string?)) + (->* ((listof (or/c string? pkg-desc?))) (#:dep-behavior dep-behavior/c #:all? boolean? #:deps? boolean? #:quiet? boolean? - #:strip (or/c #f 'source 'binary)) + #:force? boolean? + #:ignore-checksums? boolean? + #:strip (or/c #f 'source 'binary) + #:link-dirs? boolean?) (or/c #f 'skip (listof (or/c path-string? (non-empty-listof path-string?)))))] [pkg-remove (->* ((listof string?)) diff --git a/racket/collects/pkg/main.rkt b/racket/collects/pkg/main.rkt index f35bdba884..95598e20a2 100644 --- a/racket/collects/pkg/main.rkt +++ b/racket/collects/pkg/main.rkt @@ -3,13 +3,15 @@ racket/list racket/format racket/path + racket/splicing raco/command-name setup/dirs net/url "name.rkt" "lib.rkt" "commands.rkt" - (prefix-in setup: setup/setup)) + (prefix-in setup: setup/setup) + (for-syntax racket/base)) (define (setup no-setup? setup-collects jobs) (unless (or (eq? setup-collects 'skip) @@ -35,7 +37,7 @@ ;; Selects scope from `given-scope' through `user' arguments, or infers ;; a scope from `pkgs' if non-#f, and then calls `thunk'. -(define (call-with-package-scope who given-scope scope-dir installation user pkgs thunk) +(define (call-with-package-scope who given-scope scope-dir installation user pkgs pkgs-type thunk) (define scope (case given-scope [(installation user) given-scope] @@ -53,7 +55,8 @@ (with-pkg-lock/read-only (define-values (pkg scope) (for/fold ([prev-pkg #f] [prev-scope #f]) ([pkg (in-list pkgs)]) - (define scope (find-pkg-installation-scope pkg)) + (define pkg-name (package-source->name pkg pkgs-type)) + (define scope (find-pkg-installation-scope pkg-name)) (cond [(not prev-pkg) (values pkg scope)] [(equal? scope prev-scope) (values prev-pkg prev-scope)] @@ -83,336 +86,361 @@ [(regexp-match? #rx"^[a-zA-Z]*://" s) (string->url s)] [else (path->url (path->complete-path s))])) -(commands - "This tool is used for managing installed packages." - "pkg-~a-command" - [install - "Install packages" - #:once-each - [(#:sym type [file dir file-url dir-url github name] #f) type ("-t") - ("Type of ;" - "valid s are: file, dir, file-url, dir-url, github, or name;" - "if not specified, the type is inferred syntactically")] - [(#:str name #f) name ("-n") ("Name of package, instead of inferred" - "(makes sense only when a single is given)")] - #:once-any - [(#:sym mode [fail force search-ask search-auto] #f) deps () - ("Specify the behavior for dependencies, with as one of" - " fail: cancels the installation if dependencies are unmet" - " (default for most packages)" - " force: installs the package despite missing dependencies" - " search-ask: looks for the dependencies on your package naming services" - " (default if package is a package name) and asks if you would" - " like it installed" - " search-auto: like 'search-ask' but does not ask for permission to install")] - [#:bool auto () "Shorthand for `--deps search-auto'"] - #:once-each - [#:bool force () "Ignores conflicts"] - [#:bool ignore-checksums () "Ignores checksums"] - #:once-any - [#:bool link () ("Link a directory package source in place (default for a directory)")] - [#:bool static-link () ("Link in place, promising collections do not change")] - [#:bool copy () ("Treat directory sources the same as other sources")] - [#:bool source () ("Strip package's built elements before installing; implies --copy")] - [#:bool binary () ("Strip packages' source elements before installing; implies --copy")] - #:once-each - [#:bool skip-installed () ("Skip a if already installed")] - #:once-any - [(#:sym scope [installation user] #f) scope () - ("Select package , one of" - " installation: Install for all users of the Racket installation" - " user: Install as user-specific for an installation version/name")] - [#:bool installation ("-i") "Shorthand for `--scope installation'"] - [#:bool user ("-u") "Shorthand for `--scope user'"] - [(#:str dir #f) scope-dir () "Install for package scope "] - #:once-each - [(#:str catalog #f) catalog () "Use instead of configured catalogs"] - [#:bool no-setup () ("Don't run `raco setup' after changing packages (usually" - "not a good idea)")] - [(#:num n #f) jobs ("-j") "Setup with parallel jobs"] - #:args pkg-source - (call-with-package-scope - 'install - scope scope-dir installation user #f - (lambda () - (unless (or (not name) (package-source->name name)) - ((current-pkg-error) (format "~e is an invalid package name" name))) - (define setup-collects - (with-pkg-lock - (parameterize ([current-pkg-catalogs (and catalog - (list (catalog->url catalog)))]) - (define link-dirs? (not (or copy source binary))) - (pkg-install #:dep-behavior (if auto 'search-auto deps) - #:force? force - #:ignore-checksums? ignore-checksums - #:skip-installed? skip-installed - #:strip (or (and source 'source) (and binary 'binary)) - #:link-dirs? link-dirs? - (for/list ([p (in-list pkg-source)]) - (define a-type (or (and link 'link) - (and static-link 'static-link) - (and (eq? type 'dir) link-dirs? 'link) - type)) - (pkg-desc p a-type name #f)))))) - (setup no-setup setup-collects jobs)))] - [update - "Update packages" - #:once-each - [#:bool all ("-a") ("Update all packages;" - "only if no packages are given on the command line")] - [#:bool update-deps () "Check named packages' dependencies for updates"] - #:once-any - [(#:sym mode [fail force search-ask search-auto] #f) deps () - ("Specify the behavior for dependencies, with as one of" - " fail: cancels the installation if dependencies are unmet" - " (default for most packages)" - " force: installs the package despite missing dependencies" - " search-ask: looks for the dependencies on your package naming services" - " (default if package is an package name) and asks if you would" - " like it installed" - " search-auto: like 'search-ask' but does not ask for permission to install")] - [#:bool auto () "Shorthand for `--deps search-auto' plus `--update-deps'"] - #:once-any - [(#:sym scope [installation user] #f) scope () - ("Select package scope, one of" - " installation: Update only for all users of the Racket installation" - " user: Update only user-specific for an installation version/name")] - [#:bool installation ("-i") "Shorthand for `--scope installation'"] - [#:bool user ("-u") "Shorthand for `--scope user'"] - [(#:str dir #f) scope-dir () "Update for package scope "] - #:once-any - [#:bool source () ("Strip built elements of the package before installing")] - [#:bool binary () ("Strip source elements of the package before installing")] - #:once-each - [#:bool no-setup () ("Don't run `raco setup' after changing packages (usually" - "not a good idea)")] - [(#:num n #f) jobs ("-j") "Setup with parallel jobs"] - #:args pkg - (call-with-package-scope - 'update - scope scope-dir installation user pkg - (lambda () - (define setup-collects - (with-pkg-lock - (pkg-update pkg - #:all? all - #:dep-behavior (if auto 'search-auto deps) - #:deps? (or update-deps auto) - #:strip (or (and source 'source) (and binary 'binary))))) - (setup no-setup setup-collects jobs)))] - [remove - "Remove packages" - #:once-each - [#:bool demote () "Demote to automatically installed, instead of removing"] - [#:bool force () "Force removal of packages"] - [#:bool auto () "Remove automatically installed packages with no dependencies"] - #:once-any - [(#:sym scope [installation user] #f) scope () - ("Select package , one of" - " installation: Remove packages for all users of the Racket installation" - " user: Remove user-specific for an installation version/name")] - [#:bool installation ("-i") "Shorthand for `--scope installation'"] - [#:bool user ("-u") "Shorthand for `--scope user'"] - [(#:str dir #f) scope-dir () "Remove for package scope "] - #:once-each - [#:bool no-setup () ("Don't run `raco setup' after changing packages (usually" - "not a good idea)")] - [(#:num n #f) jobs ("-j") "Setup with parallel jobs"] - #:args pkg - (call-with-package-scope - 'remove - scope scope-dir installation user pkg - (lambda () - (define setup-collects - (with-pkg-lock - (pkg-remove pkg - #:demote? demote - #:auto? auto - #:force? force))) - (setup no-setup setup-collects jobs)))] - [show - "Show information about installed packages" - #:once-each - [#:bool all ("-a") "Show auto-installed packages, too"] - [#:bool dir ("-d") "Show the directory where the package is installed"] - #:once-any - [(#:sym scope [installation user] #f) scope () - ("Show only for package , one of" - " installation: Show only for all users of the Racket installation" - " user: Show only user-specific for an installation version/name")] - [(#:str vers #f) version ("-v") "Show user-specific for installation "] - [#:bool installation ("-i") "Shorthand for `--scope installation'"] - [#:bool user ("-u") "Shorthand for `--scope user'"] - [(#:str dir #f) scope-dir () "Show only for package scope "] - #:args () - (define only-mode (case scope - [(installation user) scope] - [else - (cond - [scope-dir (path->complete-path scope-dir)] - [installation 'installation] - [user 'user] - [else (if version 'user #f)])])) - (for ([mode (if only-mode - (list only-mode) - (append (let ([main (find-pkgs-dir)]) - (reverse - (for/list ([d (get-pkgs-search-dirs)]) - (if (equal? d main) - 'installation - (simple-form-path d))))) - '(user)))]) - (when (or (equal? mode only-mode) (not only-mode)) - (unless only-mode - (printf "~a\n" (case mode - [(installation) "Installation-wide:"] - [(user) (format "User-specific for installation ~s:" - (or version (get-installation-name)))] - [else (format "~a:" mode)]))) - (parameterize ([current-pkg-scope mode] - [current-pkg-error (pkg-error 'show)] - [current-pkg-scope-version (or version (get-installation-name))]) - (with-pkg-lock/read-only - (pkg-show (if only-mode "" " ") - #:auto? all - #:directory? dir)))))] - - [migrate - "Install packages installed for other version/name" - #:once-each - [(#:sym mode [fail force search-ask search-auto] #f) deps () - ("Specify the behavior for dependencies, with as one of" - " fail: cancels the installation if dependencies are unmet" - " force: installs the package despite missing dependencies" - " search-ask: looks for the dependencies on your package naming services" - " and asks if you would like it installed" - " search-auto: (the default) like 'search-ask' but does not ask for" - " permission to install")] - [#:bool force () "Ignores conflicts"] - [#:bool ignore-checksums () "Ignores checksums"] - #:once-any - [#:bool source () ("Strip built elements of the package before installing")] - [#:bool binary () ("Strip source elements of the package before installing")] - #:once-any - [(#:sym scope [installation user] #f) scope () - ("Select package , one of" - " installation: Install for all users of the Racket installation" - " user: Install as user-specific for an installation version/name")] - [#:bool installation ("-i") "Shorthand for `--scope installation'"] - [#:bool user ("-u") "Shorthand for `--scope user'"] - [(#:str dir #f) scope-dir () "Install for package scope "] - #:once-each - [(#:str catalog #f) catalog () "Use instead of configured catalogs"] - [#:bool no-setup () ("Don't run `raco setup' after changing packages (usually" - "not a good idea)")] - [(#:num n #f) jobs ("-j") "Setup with parallel jobs"] - #:args (from-version) - (call-with-package-scope - 'migrate - scope scope-dir installation user #f - (lambda () - (define setup-collects - (with-pkg-lock - (parameterize ([current-pkg-catalogs (and catalog - (list (catalog->url catalog)))]) - (pkg-migrate from-version - #:dep-behavior deps - #:force? force - #:ignore-checksums? ignore-checksums - #:strip (or (and source 'source) (and binary 'binary)))))) - (setup no-setup setup-collects jobs)))] - [create - "Bundle package from a directory or installed package" - #:once-any - [#:bool from-dir () "Treat as a directory (the default)"] - [#:bool from-install () "Treat as a package name"] - #:once-any - [(#:sym fmt [zip tgz plt] #f) format () - ("Select the format of the package to be created;" - "valid s are: zip (the default), tgz, plt")] - [#:bool manifest () "Creates a manifest file for a directory, rather than an archive"] - #:once-any - [#:bool as-is () "Bundle the directory/package as-is (the default)"] - [#:bool source () "Bundle sources only"] - [#:bool binary () "Bundle bytecode and rendered documentation without sources"] - [#:bool built () "Bundle sources, bytecode and rendered documentation"] - #:once-each - [(#:str dest-dir #f) dest () "Create output files in "] - #:args (directory-or-package) - (parameterize ([current-pkg-error (pkg-error 'create)]) - (pkg-create (if manifest 'MANIFEST (or format 'zip)) - directory-or-package - #:dest (and dest - (path->complete-path dest)) - #:source (cond - [from-install 'name] - [else 'dir]) - #:mode (cond - [source 'source] - [binary 'binary] - [built 'built] - [else 'as-is])))] - [config - "View and modify the package manager's configuration" - #:once-each - [#:bool set () "Completely replace the value"] - #:once-any - [(#:sym scope [installation user] #f) scope () - ("Select configuration , one of" - " installation: Operate on the installation-wide package configuration" - " user: Operate on the user-specific for an installation name")] - [#:bool installation ("-i") "Shorthand for `--scope installation'"] - [#:bool user ("-u") "Shorthand for `--scope user'"] - #:args key/val - (call-with-package-scope - 'config - scope #f installation user #f - (lambda () - (if set - (with-pkg-lock - (pkg-config #t key/val)) - (with-pkg-lock/read-only - (pkg-config #f key/val)))))] - [catalog-show - "Show package information as reported by a catalog" - #:once-any - [(#:str catalog #f) catalog () "Use instead of configured catalogs"] - #:once-each - [#:bool all () "Show all packages"] - [#:bool only-names () "Show only package names"] - [#:bool modules () "Show implemented modules"] - [(#:str vers #f) version ("-v") "Show result for Racket "] - #:args pkg-name - (when (and all (pair? pkg-name)) - ((pkg-error 'catalog-show) "both `--all' and package names provided")) - (parameterize ([current-pkg-catalogs (and catalog - (list (catalog->url catalog)))] - [current-pkg-error (pkg-error 'catalog-show)] - [current-pkg-scope-version (or version - (current-pkg-scope-version))]) - (pkg-catalog-show pkg-name - #:all? all - #:only-names? only-names - #:modules? modules))] - [catalog-copy - "Copy/merge package name catalogs" - #:once-each - [#:bool from-config () "Include currently configured catalogs last"] - #:once-any - [#:bool force () "Force replacement fo existing file/directory"] - [#:bool merge () "Merge to existing database"] - #:once-each - [#:bool override () "While merging, override existing with new"] - [(#:str vers #f) version ("-v") "Copy information suitable for Racket "] - #:args catalog - (parameterize ([current-pkg-error (pkg-error 'catalog-copy)]) - (when (null? catalog) - ((current-pkg-error) "need a destination catalog")) - (parameterize ([current-pkg-scope-version (or version - (current-pkg-scope-version))]) - (pkg-catalog-copy (drop-right catalog 1) - (last catalog) - #:from-config? from-config - #:force? force - #:merge? merge - #:override? override)))]) +(splicing-let () + (define-syntax (make-commands stx) + (syntax-case stx () + [(_ #:scope-flags (scope-flags ...) + #:job-flags (job-flags ...) + #:catalog-flags (catalog-flags ...) + #:install-type-flags (install-type-flags ...) + #:install-dep-flags (install-dep-flags ...) + #:install-dep-desc (install-dep-desc ...) + #:install-force-flags (install-force-flags ...) + #:install-copy-flags (install-copy-flags ...) + #:install-copy-defns (install-copy-defns ...)) + (with-syntax ([([scope-flags ...] + [job-flags ...] + [catalog-flags ...] + [install-type-flags ...] + [(install-dep-flags ... (dep-desc ...))] + [install-force-flags ...] + [install-copy-flags ...] + [install-copy-defns ...]) + (syntax-local-introduce #'([scope-flags ...] + [job-flags ...] + [catalog-flags ...] + [install-type-flags ...] + [install-dep-flags ...] + [install-force-flags ...] + [install-copy-flags ...] + [install-copy-defns ...]))]) + #`(commands + "This tool is used for managing installed packages." + "pkg-~a-command" + ;; ---------------------------------------- + [install + "Install packages" + #:once-any + install-type-flags ... + #:once-any + [install-dep-flags ... + (dep-desc ... + install-dep-desc ...)] + [#:bool auto () "Shorthand for `--deps search-auto'"] + #:once-any + install-copy-flags ... + #:once-any + scope-flags ... + #:once-each + catalog-flags ... + [#:bool skip-installed () ("Skip a if already installed")] + install-force-flags ... + job-flags ... + #:args pkg-source + install-copy-defns ... + (call-with-package-scope + 'install + scope scope-dir installation user #f a-type + (lambda () + (unless (or (not name) (package-source->name name)) + ((current-pkg-error) (format "~e is an invalid package name" name))) + (define setup-collects + (with-pkg-lock + (parameterize ([current-pkg-catalogs (and catalog + (list (catalog->url catalog)))]) + (pkg-install #:dep-behavior (if auto 'search-auto deps) + #:force? force + #:ignore-checksums? ignore-checksums + #:skip-installed? skip-installed + #:strip (or (and source 'source) (and binary 'binary)) + #:link-dirs? link-dirs? + (for/list ([p (in-list pkg-source)]) + (pkg-desc p a-type name #f)))))) + (setup no-setup setup-collects jobs)))] + ;; ---------------------------------------- + [update + "Update packages" + #:once-each + [#:bool all ("-a") ("Update all packages if no is given")] + [#:bool update-deps () "Also update all dependencies"] + [#:bool lookup () "For each name , look up in catalog"] + #:once-any + install-type-flags ... + #:once-any + [install-dep-flags ... + (dep-desc ... + install-dep-desc ...)] + [#:bool auto () "Shorthand for `--deps search-auto' plus `--update-deps'"] + #:once-any + install-copy-flags ... + #:once-any + scope-flags ... + #:once-each + catalog-flags ... + install-force-flags ... + job-flags ... + #:args pkg-source + install-copy-defns ... + (call-with-package-scope + 'update + scope scope-dir installation user pkg-source #f + (lambda () + (define setup-collects + (with-pkg-lock + (parameterize ([current-pkg-catalogs (and catalog + (list (catalog->url catalog)))]) + (pkg-update (for/list ([pkg-source (in-list pkg-source)]) + (cond + [lookup + (pkg-desc pkg-source a-type name #f)] + [else + (define-values (pkg-name pkg-type) + (package-source->name+type pkg-source a-type)) + (if (eq? pkg-type 'name) + pkg-name + (pkg-desc pkg-source a-type name #f))])) + #:all? all + #:dep-behavior (if auto 'search-auto deps) + #:force? force + #:ignore-checksums? ignore-checksums + #:deps? (or update-deps auto) + #:strip (or (and source 'source) (and binary 'binary)) + #:link-dirs? link-dirs?)))) + (setup no-setup setup-collects jobs)))] + ;; ---------------------------------------- + [remove + "Remove packages" + #:once-each + [#:bool demote () "Demote to auto-installed, instead of removing"] + [#:bool force () "Remove even if package has dependents"] + [#:bool auto () "Also remove auto-installed packages that have no dependents"] + #:once-any + scope-flags ... + #:once-each + job-flags ... + #:args pkg + (call-with-package-scope + 'remove + scope scope-dir installation user pkg 'name + (lambda () + (define setup-collects + (with-pkg-lock + (pkg-remove pkg + #:demote? demote + #:auto? auto + #:force? force))) + (setup no-setup setup-collects jobs)))] + ;; ---------------------------------------- + [show + "Show information about installed packages" + #:once-each + [#:bool all ("-a") "Show auto-installed packages, too"] + [#:bool dir ("-d") "Show the directory where the package is installed"] + #:once-any + scope-flags ... + [(#:str vers #f) version ("-v") "Show user-specific for installation "] + #:args () + (define only-mode (case scope + [(installation user) scope] + [else + (cond + [scope-dir (path->complete-path scope-dir)] + [installation 'installation] + [user 'user] + [else (if version 'user #f)])])) + (for ([mode (if only-mode + (list only-mode) + (append (let ([main (find-pkgs-dir)]) + (reverse + (for/list ([d (get-pkgs-search-dirs)]) + (if (equal? d main) + 'installation + (simple-form-path d))))) + '(user)))]) + (when (or (equal? mode only-mode) (not only-mode)) + (unless only-mode + (printf "~a\n" (case mode + [(installation) "Installation-wide:"] + [(user) (format "User-specific for installation ~s:" + (or version (get-installation-name)))] + [else (format "~a:" mode)]))) + (parameterize ([current-pkg-scope mode] + [current-pkg-error (pkg-error 'show)] + [current-pkg-scope-version (or version (get-installation-name))]) + (with-pkg-lock/read-only + (pkg-show (if only-mode "" " ") + #:auto? all + #:directory? dir)))))] + ;; ---------------------------------------- + [migrate + "Install packages installed for other version/name" + #:once-each + [install-dep-flags ... + (dep-desc ... + "where the default is `search-auto'")] + #:once-any + [#:bool source () ("Strip built elements of the package before installing")] + [#:bool binary () ("Strip source elements of the package before installing")] + #:once-any + scope-flags ... + #:once-each + catalog-flags ... + install-force-flags ... + job-flags ... + #:args (from-version) + (call-with-package-scope + 'migrate + scope scope-dir installation user #f #f + (lambda () + (define setup-collects + (with-pkg-lock + (parameterize ([current-pkg-catalogs (and catalog + (list (catalog->url catalog)))]) + (pkg-migrate from-version + #:dep-behavior deps + #:force? force + #:ignore-checksums? ignore-checksums + #:strip (or (and source 'source) (and binary 'binary)))))) + (setup no-setup setup-collects jobs)))] + ;; ---------------------------------------- + [create + "Bundle package from a directory or installed package" + #:once-any + [#:bool from-dir () "Treat as a directory (the default)"] + [#:bool from-install () "Treat as a package name"] + #:once-any + [(#:sym fmt [zip tgz plt] #f) format () + ("Select the format of the package to be created;" + "valid s are: zip (the default), tgz, plt")] + [#:bool manifest () "Creates a manifest file for a directory, rather than an archive"] + #:once-any + [#:bool as-is () "Bundle the directory/package as-is (the default)"] + [#:bool source () "Bundle sources only"] + [#:bool binary () "Bundle bytecode and rendered documentation without sources"] + [#:bool built () "Bundle sources, bytecode and rendered documentation"] + #:once-each + [(#:str dest-dir #f) dest () "Create output files in "] + #:args (directory-or-package) + (parameterize ([current-pkg-error (pkg-error 'create)]) + (pkg-create (if manifest 'MANIFEST (or format 'zip)) + directory-or-package + #:dest (and dest + (path->complete-path dest)) + #:source (cond + [from-install 'name] + [else 'dir]) + #:mode (cond + [source 'source] + [binary 'binary] + [built 'built] + [else 'as-is])))] + ;; ---------------------------------------- + [config + "View and modify the package manager's configuration" + #:once-each + [#:bool set () "Set to ..."] + #:once-any + scope-flags ... + #:args (key . val) + (call-with-package-scope + 'config + scope scope-dir installation user #f #f + (lambda () + (if set + (with-pkg-lock + (pkg-config #t (cons key val))) + (with-pkg-lock/read-only + (pkg-config #f (cons key val))))))] + ;; ---------------------------------------- + [catalog-show + "Show package information as reported by a catalog" + #:once-each + [#:bool all () "Show all packages"] + [#:bool only-names () "Show only package names"] + [#:bool modules () "Show implemented modules"] + catalog-flags ... + [(#:str vers #f) version ("-v") "Show result for Racket "] + #:args pkg-name + (when (and all (pair? pkg-name)) + ((pkg-error 'catalog-show) "both `--all' and package names provided")) + (parameterize ([current-pkg-catalogs (and catalog + (list (catalog->url catalog)))] + [current-pkg-error (pkg-error 'catalog-show)] + [current-pkg-scope-version (or version + (current-pkg-scope-version))]) + (pkg-catalog-show pkg-name + #:all? all + #:only-names? only-names + #:modules? modules))] + ;; ---------------------------------------- + [catalog-copy + "Copy/merge package name catalogs" + #:once-each + [#:bool from-config () "Include currently configured catalogs last"] + #:once-any + [#:bool force () "Force replacement fo existing file/directory"] + [#:bool merge () "Merge to existing database"] + #:once-each + [#:bool override () "While merging, override existing with new"] + [(#:str vers #f) version ("-v") "Copy information suitable for Racket "] + #:args catalog + (parameterize ([current-pkg-error (pkg-error 'catalog-copy)]) + (when (null? catalog) + ((current-pkg-error) "need a destination catalog")) + (parameterize ([current-pkg-scope-version (or version + (current-pkg-scope-version))]) + (pkg-catalog-copy (drop-right catalog 1) + (last catalog) + #:from-config? from-config + #:force? force + #:merge? merge + #:override? override)))]))])) + (make-commands + #:scope-flags + ([(#:sym scope [installation user] #f) scope () + ("Select package , one of" + " installation: for all users of the Racket installation" + " user: as user-specific for an installation version/name")] + [#:bool installation ("-i") "Shorthand for `--scope installation'"] + [#:bool user ("-u") "Shorthand for `--scope user'"] + [(#:str dir #f) scope-dir () "Select package scope "]) + #:job-flags + ([#:bool no-setup () ("Don't run `raco setup' after changing packages (usually" + "not a good idea)")] + [(#:num n #f) jobs ("-j") "Setup with parallel jobs"]) + #:catalog-flags + ([(#:str catalog #f) catalog () "Use instead of configured catalogs"]) + #:install-type-flags + ([(#:sym type [file dir file-url dir-url github name] #f) type ("-t") + ("Type of ;" + "valid s are: file, dir, file-url, dir-url, github, or name;" + "if not specified, the type is inferred syntactically")] + [(#:str name #f) name ("-n") ("Name of package, instead of inferred" + "(makes sense only when a single is given)")]) + #:install-dep-flags + ([(#:sym mode [fail force search-ask search-auto] #f) deps () + ("Specify the behavior for uninstalled dependencies, with" + " as one of" + " fail: cancels if dependencies are not installed" + " force: continues despite missing dependencies" + " search-ask: looks for dependencies in the package catalogs" + " and asks for permission to auto-install" + " search-auto: like `search-ask', but does not ask for permission")]) + #:install-dep-desc + ("where the default is `search-ask' if is a package name" + "or `fail' otherwise") + #:install-force-flags + ([#:bool force () "Ignores conflicts"] + [#:bool ignore-checksums () "Ignores checksums"]) + #:install-copy-flags + ([#:bool link () ("Link a directory package source in place (default for a directory)")] + [#:bool static-link () ("Link in place, promising collections do not change")] + [#:bool copy () ("Treat directory sources the same as other sources")] + [#:bool source () ("Strip package's built elements before installing; implies --copy")] + [#:bool binary () ("Strip packages' source elements before installing; implies --copy")]) + #:install-copy-defns + [(define link-dirs? (not (or copy source binary))) + (define a-type (or (and link 'link) + (and static-link 'static-link) + (and (eq? type 'dir) link-dirs? 'link) + type))])) diff --git a/racket/collects/pkg/util.rkt b/racket/collects/pkg/util.rkt index 1b43b9a7a2..ac2a6ea074 100644 --- a/racket/collects/pkg/util.rkt +++ b/racket/collects/pkg/util.rkt @@ -52,7 +52,8 @@ (define github-client_secret (make-parameter #f)) (define (package-url->checksum pkg-url-str [query empty] - #:download-printf [download-printf void]) + #:download-printf [download-printf void] + #:pkg-name [pkg-name "package"]) (define pkg-url (string->url pkg-url-str)) (match (url-scheme pkg-url) @@ -94,7 +95,7 @@ (hash-ref (hash-ref b 'commit) 'sha)))] [_ (define u (string-append pkg-url-str ".CHECKSUM")) - (download-printf "Downloading checksum\n") + (download-printf "Downloading checksum for ~a\n" pkg-name) (log-pkg-debug "Downloading checksum as ~a" u) (call/input-url+200 (string->url u) port->string)])) diff --git a/racket/collects/planet/private/command.rkt b/racket/collects/planet/private/command.rkt index 25934602bf..8ec19b97f4 100644 --- a/racket/collects/planet/private/command.rkt +++ b/racket/collects/planet/private/command.rkt @@ -62,7 +62,7 @@ body ... #:handlers (λ (_ . formals) final-expr) - (ensure-list (pimap symbol->string 'formals)) + (pimap symbol->string 'formals) (λ (help-string) (for-each (λ (l) (display l) (newline)) (wrap-to-count long-description 80)) (newline) @@ -102,18 +102,13 @@ [extra (build-string (- n l) (λ (n) #\space))]) (string-append str extra))) -(define (ensure-list x) - (if (or (null? x) (pair? x)) - x - (list x))) - -;; pimap : (A -> B) improper-listof A -> improper-listof B +;; pimap : (A -> B) improper-listof A -> listof B (define (pimap f pil) (cond [(null? pil) '()] - [(pair? pil) (cons (pimap f (car pil)) + [(pair? pil) (cons (f (car pil)) (pimap f (cdr pil)))] - [else (f pil)])) + [else (list (f pil))])) ;; wrap-to-count : string nat -> (listof string) ;; breaks str into substrings such that no substring