From 6379aaddef7fa26d14ab2523efa8aa5492f6ac2b Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 20 Nov 2014 21:04:55 -0700 Subject: [PATCH] raco pkg {install,update}: add `--clone ` mode Using `--clone ` with a Git-based package source causes the package installation to be linked to a clone of the repository as a subdirectory of . The package can be developed locally in the usual way with Git tools, but `raco pkg update` can itself pull updates to the package/repository. See the new chapter 6 in "Package Management in Racket" for more information. --- .../gui-pkg-manager-lib/pkg/gui.rkt | 2 +- .../pkg/gui/private/by-installed.rkt | 51 ++-- .../pkg/gui/private/by-list.rkt | 1 + pkgs/plt-services/meta/drdr/README-PORTS | 3 + .../pkg/scribblings/getting-started.scrbl | 22 +- .../pkg/scribblings/git-workflow.scrbl | 148 ++++++++++ .../racket-doc/pkg/scribblings/lib.scrbl | 25 +- .../racket-doc/pkg/scribblings/name.scrbl | 9 +- .../racket-doc/pkg/scribblings/path.scrbl | 3 +- .../racket-doc/pkg/scribblings/pkg.scrbl | 58 +++- .../tests/pkg/test-catalogs-api.rkt | 6 +- .../racket-test/tests/pkg/tests-catalogs.rkt | 6 +- .../racket-test/tests/pkg/tests-checksums.rkt | 10 +- .../racket-test/tests/pkg/tests-clone.rkt | 163 +++++++++++ .../racket-test/tests/pkg/tests-deps.rkt | 2 +- .../racket-test/tests/pkg/tests-implies.rkt | 4 +- .../racket-test/tests/pkg/tests-install.rkt | 12 +- .../racket-test/tests/pkg/tests-migrate.rkt | 4 +- .../racket-test/tests/pkg/tests-name.rkt | 8 +- .../racket-test/tests/pkg/tests-raco.rkt | 2 +- .../tests/pkg/tests-update-auto.rkt | 12 +- .../tests/pkg/tests-update-deps.rkt | 10 +- .../racket-test/tests/pkg/tests-update.rkt | 24 +- .../racket-test/tests/pkg/tests-versions.rkt | 12 +- .../racket-test/tests/pkg/util.rkt | 8 +- racket/collects/pkg/lib.rkt | 22 +- racket/collects/pkg/main.rkt | 120 ++++++--- racket/collects/pkg/name.rkt | 21 +- racket/collects/pkg/path.rkt | 3 +- racket/collects/pkg/private/archive.rkt | 2 +- .../collects/pkg/private/catalog-archive.rkt | 2 +- racket/collects/pkg/private/desc.rkt | 5 +- racket/collects/pkg/private/download.rkt | 4 +- racket/collects/pkg/private/git.rkt | 35 +++ racket/collects/pkg/private/install.rkt | 252 +++++++++++++----- racket/collects/pkg/private/migrate.rkt | 25 +- racket/collects/pkg/private/orig-pkg.rkt | 33 +++ racket/collects/pkg/private/pkg-db.rkt | 2 +- racket/collects/pkg/private/remove.rkt | 2 +- racket/collects/pkg/private/repo-path.rkt | 58 ++++ racket/collects/pkg/private/stage.rkt | 183 +++++++++---- 41 files changed, 1080 insertions(+), 294 deletions(-) create mode 100644 pkgs/racket-pkgs/racket-doc/pkg/scribblings/git-workflow.scrbl create mode 100644 pkgs/racket-pkgs/racket-test/tests/pkg/tests-clone.rkt create mode 100644 racket/collects/pkg/private/git.rkt create mode 100644 racket/collects/pkg/private/orig-pkg.rkt create mode 100644 racket/collects/pkg/private/repo-path.rkt diff --git a/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui.rkt b/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui.rkt index c5e861519c..a58f9f56e2 100644 --- a/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui.rkt +++ b/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui.rkt @@ -192,6 +192,6 @@ frame) (module+ main - (void (make-pkg-installer)) #; + (void (make-pkg-installer)) (void (make-pkg-gui))) diff --git a/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/private/by-installed.rkt b/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/private/by-installed.rkt index 2ace6418a5..bfc6e5a712 100644 --- a/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/private/by-installed.rkt +++ b/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/private/by-installed.rkt @@ -3,6 +3,7 @@ racket/gui/base racket/format setup/dirs + net/url pkg/lib pkg string-constants @@ -13,11 +14,30 @@ (struct ipkg (name scope auto? checksum source)) -(define ((ipkg->source dir) ipkg) +(define ((ipkg->desc dir) ipkg) + (define name (ipkg-name ipkg)) (define s (cadr (ipkg-source ipkg))) - (if (not (eq? 'catalog (car (ipkg-source ipkg)))) - (path->string (path->complete-path s dir)) - s)) + (define kind (car (ipkg-source ipkg))) + (case kind + [(catalog) (pkg-desc s 'name name #f #f)] + [(link static-link) + (pkg-desc (path->string (path->complete-path s dir)) kind name #f #f)] + [(url) (pkg-desc s #f name #f #f)] + [(clone) + (define url-str (caddr (ipkg-source ipkg))) + (pkg-desc url-str + 'clone + name + #f + #f + #:path (let loop ([p (path->complete-path s dir)] + [n (length (url-query (string->url url-str)))]) + (cond + [(zero? n) p] + [else (define-values (base name dir?) (split-path p)) + (if (path? base) + (loop base (sub1 n)) + (error "mangled path recorded for a clone"))])))])) (define (source->string s) (format "~a: ~a" @@ -26,7 +46,8 @@ [(url) "URL"] [(link) "Link"] [(static-link) "Static link"] - [(file) "File"]) + [(file) "File"] + [(clone) "Clone"]) (cadr s))) (define (status-string a default-scope) @@ -152,14 +173,9 @@ [(path? scope) scope] [(eq? scope 'installation) (find-pkgs-dir)] [else (find-user-pkgs-dir)])) - ;; Also preserve link kind: - (define kind (car (ipkg-source (car ipkgs)))) - (apply - pkg-install-command - #:scope scope - #:link (eq? 'link kind) - #:static-link (eq? 'static-link kind) - (map (ipkg->source dir) ipkgs)))))])) + (parameterize ([current-pkg-scope scope]) + (with-pkg-lock (pkg-install (map (ipkg->desc dir) ipkgs)))) + (void))))])) (define demote-button (new button% @@ -215,12 +231,7 @@ (not (ipkg-auto? i))))) (send promote-button enable (and same-scope? (for/and ([i (in-list ipkgs)]) - (ipkg-auto? i)) - ;; all 'catalog, 'link, or 'static-link - (let ([kind (car (ipkg-source (car ipkgs)))]) - (and (memq kind '(catalog link static-link)) - (for/and ([i (in-list (cdr ipkgs))]) - (eq? kind (car (ipkg-source i)))))))) + (ipkg-auto? i)))) (send update-button enable (and same-scope? (for/and ([i (in-list ipkgs)]) (not (memq (car (ipkg-source i)) @@ -267,7 +278,7 @@ (if (eq? (car sa) (car sb)) (stringvector l)) diff --git a/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/private/by-list.rkt b/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/private/by-list.rkt index ab0623eca4..63abe8ba32 100644 --- a/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/private/by-list.rkt +++ b/pkgs/gui-pkg-manager-pkgs/gui-pkg-manager-lib/pkg/gui/private/by-list.rkt @@ -28,6 +28,7 @@ [(catalog) ""] [(link) "="] [(static-link) "="] + [(clone) "="] [(url) "@"]))) (define by-list-panel% diff --git a/pkgs/plt-services/meta/drdr/README-PORTS b/pkgs/plt-services/meta/drdr/README-PORTS index 1cc80b6ad1..4b213a335a 100644 --- a/pkgs/plt-services/meta/drdr/README-PORTS +++ b/pkgs/plt-services/meta/drdr/README-PORTS @@ -9,6 +9,9 @@ others don't accidentally conflict. 8889 - tests/racket/benchmarks/shootout/typed/echo (optimized) 9000 - DrDr Web server 9001 - tests/net +9990 - tests/pkg +9997 - tests/pkg +9998 - tests/pkg 9999 - tests/web-server 19200 - 2htdp/tests ... 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 baee369078..477148d7ea 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/getting-started.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/getting-started.scrbl @@ -268,8 +268,8 @@ and grows up to become a Git repository that is registered with a @subsection[#:tag "automatic-creation"]{Automatic Creation} -As a convenience, @command-ref{new} can automatically create single -collection packages. +As a convenience, @command-ref{new} can automate the creation of +a @tech{single-collection package}. To create @nonterm{pkg-name}: @commandline{raco pkg new @nonterm{pkg-name}} @@ -307,7 +307,7 @@ it to a @tech{multi-collection package} by restructuring the package directory, so you don't have to worry much about the choice when you get started. -@subsection[#:tag "working-new-pkgs"]{Working with New Packages} +@subsection[#:tag "working-new-pkgs"]{Linking and Developing New Packages} Whether creating a @tech{single-collection package} or a @tech{multi-collection package}, the next step is to link your @@ -392,7 +392,7 @@ Whenever you @commandline{git push} your changes will automatically be discovered by those who use -@exec{raco pkg update} after installing from your +@command-ref{update} after installing from your GitHub-based @tech{package source}. As of Racket version 6.1.1.1, other Git repository services can work @@ -400,6 +400,10 @@ just as well as GitHub---including Gitorious or BitBucket---as long as the server supports either the ``smart'' HTTP(S) protocol or the native Git protocol (but use a @exec{git://} path for the latter). +The Racket package manager provides more support for Git-based +development than just deployment. See @secref["git-workflow"] for more +information. + @; - - - - - - - - - - - - - - - - - - - - - - - - @subsection[#:tag "manual-deploy"]{Manual Deployment} @@ -421,9 +425,9 @@ Your @tech{package source} is then something like Whenever you want to provide a new release of a package, recreate and reupload the package archive (and @tech{checksum}). Your changes will automatically be discovered by those who used your package source when they use -@exec{raco pkg update}. +@command-ref{update}. -@margin-note{By default, @exec{raco pkg create} generates a +@margin-note{By default, @command-ref{create} generates a @filepath{.zip} archive. For more options, refer to the @command-ref{create} documentation. If you want to generate an archive through some other means, simply archive what you made in the first @@ -453,7 +457,7 @@ If you use this server, and if you use a public Git repository for deployment, then you will never need to open a web browser to update your package for end users. You just need to push to your Git repository, then within 24 hours, the PLT @tech{package catalog} will -notice, and @exec{raco pkg update} will work on your user's machines. +notice, and @command-ref{update} will work on your user's machines. @; - - - - - - - - - - - - - - - - - - - - - - - - @@ -484,8 +488,8 @@ present interfaces to external, versioned things, such as @item{A @tech{version} declaration for a package is used only by other package implementors to effectively declare dependencies on provided -features. Such declarations allow @exec{raco pkg install} and -@exec{raco pkg update} to help check dependencies. Declaring and +features. Such declarations allow @command-ref{install} and +@command-ref{update} to help check dependencies. Declaring and changing a version is optional, and the @tech{package catalog} ignores version declarations; in particular, a package is a candidate for updating when its @tech{checksum} changes, independent of whether diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/git-workflow.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/git-workflow.scrbl new file mode 100644 index 0000000000..1806f49b57 --- /dev/null +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/git-workflow.scrbl @@ -0,0 +1,148 @@ +#lang scribble/manual +@(require "common.rkt" + scribble/bnf) + +@title[#:tag "git-workflow"]{Developing Packages with Git} + +When a Git repository is specified as a package source, then a copy of +the repository content is installed as the package +implementation. That installation mode is designed for package +consumers, who normally use a package without modifying it. The +installed copy of the package is unsuitable for development by the +package author, however, since the installation is not a full clone of +the Git repository. The Racket package manager provides different +installation modes to support package authors who work with Git +repository clones. + + +@section{Linking a Git Checkout as a Directory} + +Since a Git repository checkout is a directory, it can be linked as a +package as described in @secref["working-new-pkgs"]. In that case, any +modifications made locally take effect immediately for the package +installation, including any updates from a @exec{git pull}. The +developer must explicitly pull any remote updates to the repository, +however, including when the updates are needed to satisfy the +requirements of dependent packages. + +In the following section, we describe an alternative that makes +@command-ref{update} aware of the checkout directory's status as a +repository clone. Furthermore, a directory-linked package can be +promoted to a clone-linked package with @command-ref{update}. + + +@section{Linking a Git Checkout as a Clone} + +When a package is installed with + +@commandline{@command{install} --clone @nonterm{dir} @nonterm{git-pkg-source}} + +then instead of installing the package as a mere copy of the +repository source, the package is installed by creating a Git clone of +@nonterm{git-pkg-source} as @nonterm{dir}. The clone's checkout is +linked in the same way as a directory, but unlike a plain directory +link, the Racket package manager keeps track of the repository +connection. + +When the repository at @nonterm{git-pkg-source} is changed so that the +source has a new checksum, then @command-ref{update} for the package pulls +commits from the repository to the local clone. In other words, +@command-ref{update} works as an alternative to @exec{git pull --ff-only} +to pull updates for the package. Furthermore, @command-ref{update} can +pull updates to local package repositories when checking dependencies. +For example, @exec{@command{update} --all} pulls updates for all +linked package repositories. + +Suppose that a developer works with a large number of packages and +develops only a few of them. The intended workflow is as follows: + +@itemlist[ + + @item{Install all the relevant packages with @command-ref{install}.} + + @item{For each package to be developed out of a particular Git + repository named by @nonterm{git-pkg-source}, update the installation with + + @commandline{@command{update} --clone @nonterm{dir} @nonterm{git-pkg-source}} + + which discards the original installation of the package and replaces + it with a local clone as @nonterm{dir}.} + + @item{Manage changes to each of the developed packages in the usual + way with @exec{git} tools, but @command-ref{update} is also available + for updates, including mass updates.} + +] + +A @tech{package source} provided with @DFlag{clone} can include a +branch and/or path into the repository. The branch specification +affects the branch used for the initial checkout, while a non-empty +path causes a subdirectory of the checkout to be linked for the +package. + +The package developer will work with both @exec{git} tools and +@exec{raco pkg} tools, and the tools interact in specific ways: + +@itemlist[ + + @item{With the link-establishing + + @commandline{@command{install} --clone @nonterm{dir} @nonterm{git-pkg-source}} + + or the same for @command-ref{update}, if a local repository exists + already as @nonterm{dir}, then it is left in place and any new + commits are fetched from @nonterm{git-pkg-source}. The package + manager does not attempt to check whether a pre-existing + repository is consistent with @nonterm{git-pkg-source}; it + simply starts fetching new commits to the repository, and a + later @exec{git pull --ff-only} will detect any mismatch. + + Multiple @nonterm{git-pkg-source}s can be provided to + @command-ref{install}, which makes sense when multiple packages are + sourced from the same repository and can therefore share + @nonterm{dir}. Whether through a single @exec{raco pkg} use or + multiple uses with the same @exec{--clone @nonterm{dir}}, + packages from the same repository should be linked from the + same local clone, assuming that they are in the same repository + because they should be modified together. The package system, + however, makes no requirement of clone sharing among the + packages.} + + @item{When pulling changes to repositories that have local copies, + @command-ref{update} pulls changes with the equivalent of @exec{git + pull --ff-only}.} + + @item{When @command-ref{update} is given a specific commit as the target + of the update, it uses the equivalent of @exec{git merge --ff-only + @nonterm{checksum}}. This approach is intended to preserve any + changes to the package made locally, but it implies that the + package cannot be ``downgraded'' to a older commit simply by + specifying the commit for @command-ref{update}; any newer commits + that are already in the local repository will be preserved.} + + @item{The installed-package database records the most recent commit + pulled from the source repository after each installation or + update. The current commit in the repository checkout is + consulted only for the purposes of merging onto pulled + commits. Thus, after pushing repository changes with @exec{git + push}, a @command-ref{update} makes sense to synchronize the + package-installation database with the remote repository state + (which is then the same as the local repository state).} + + @item{When checking a @command-ref{install} or @command-ref{update} + request for collisions, commits are first fetched with + @exec{git fetch}, and an additional local clone is created in a + temporary directory. If the overall installation or update is + deemed to be successful with respect to remote commits (not + necessarily the current commit in each local repository) in + that copy, then an update to the linked repository checkout + proceeds. Finally, after all checkouts succeed, other package + installations and updates are completed and recorded. If a + checkout fails (e.g., due to a conflict or uncommitted change), + then the repository checkout is left in a failed state, but all + package actions are otherwise canceled.} + + @item{Removing a package with @command-ref{remove} leaves the + repository checkout intact while removing the package link.} + +] diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl index b0765a888e..1325976088 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl @@ -125,18 +125,27 @@ scope}.} @deftogether[( @defproc[(pkg-desc? [v any/c]) boolean?] @defproc[(pkg-desc [source string?] - [type (or/c #f 'file 'dir 'link 'static-link - 'file-url 'dir-url 'git 'github 'name)] + [type (or/c #f 'name 'file 'dir 'link 'static-link + 'file-url 'dir-url 'git 'github 'clone)] [name (or/c string? #f)] [checksum (or/c string? #f)] - [auto? boolean?]) + [auto? boolean?] + [#:path path (or/c #f path-string?) #f]) pkg-desc?] )]{ A @racket[pkg-desc] value describes a package source plus details of its intended interpretation, where the @racket[auto?] field indicates that the package is should be treated as installed automatically for a -dependency.} +dependency. + +The optional @racket[path] argument is intended for use when +@racket[type] is @racket['clone], in which case it specifies< a +directory containing the repository clone (where the repository itself +is a directory within @racket[path]). + +@history[#:changed "6.1.1.1" @elem{Added @racket['git] as a @racket[type].} + #:changed "6.1.1.5" @elem{Added @racket['clone] as a @racket[type].}]} @defproc[(pkg-stage [desc pkg-desc?] @@ -271,8 +280,12 @@ 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. +be checked for updates. A @racket[pkg-desc] in @racket[names] +indicates a package source that should replace the current +installation, except that a @racket[package-desc] can have the type +@racket['clone] and a source with the syntax of a package name, in +which case it refers to an existing package installation that should +be converted to a Git repository clone. If @racket[from-command-line?] is true, error messages may suggest specific command-line flags for @command-ref{update}. diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/name.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/name.scrbl index 4fa675e71d..03b8e9c32d 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/name.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/name.scrbl @@ -14,15 +14,18 @@ extracting a package name.} @defproc[(package-source-format? [v any/c]) boolean?]{ Returns @racket[#t] if @racket[v] is @racket['name] , @racket['file], -@racket['dir], @racket['git], @racket['github], @racket['file-url], +@racket['dir], @racket['git], @racket['github], @racket['clone], @racket['file-url], @racket['dir-url], @racket['link], or @racket['static-link], and returns @racket[#f] otherwise. The @racket['link] and @racket['static-link] formats are the same as @racket['dir] in terms of parsing, but they are treated differently -for tasks such as package installation. +for tasks such as package installation. The @racket['clone] format +is similarly the same as @racket['github] or @racket['git] in terms of +parsing. -@history[#:changed "6.1.1.1" @elem{Added @racket['git].}]} +@history[#:changed "6.1.1.1" @elem{Added @racket['git].} + #:changed "6.1.1.5" @elem{Added @racket['clone].}]} @defproc[(package-source->name [source string?] diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/path.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/path.scrbl index 321704d364..847f159d6e 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/path.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/path.scrbl @@ -18,7 +18,8 @@ databases.} @defstruct*[pkg-info ([orig-pkg (or/c (list/c 'catalog string?) (list/c 'url string?) (list/c 'link string?) - (list/c 'static-link string?))] + (list/c 'static-link string?) + (list/c 'clone string? string?))] [checksum (or/c #f string?)] [auto? boolean?]) #:prefab]{ diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl index faf1dbaba5..b18cdd0a9f 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl @@ -378,7 +378,7 @@ directory @tech{package scopes}. The @exec{raco pkg} command provides package-management tools via sub-commands. -@command/toc{install} @nonterm{option} ... @nonterm{pkg-source} ... +@subcommand{@command/toc{install} @nonterm{option} ... @nonterm{pkg-source} ... --- Installs the given @tech{package sources} (eliminating exact-duplicate @nonterm{pkg-source}s). If a given @nonterm{pkg-source} is ``auto-installed'' (to satisfy some other package's dependency), then it is promoted to explicitly installed. @@ -432,7 +432,7 @@ sub-commands. @item{@DFlag{skip-implies} --- Disables special treatment of dependencies that are listed in @racketidfont{implies} (see @secref["metadata"]) for an installed or updated package.} - @item{@DFlag{link} --- Implies @exec{--type dir} (and overrides any specified type), + @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. @@ -447,12 +447,19 @@ sub-commands. of the given directory will not change for each given directory that implements a @tech{multi-collection package}.} - @item{@DFlag{pkgs} --- Disables default installation of the current directory when no @nonterm{pkg-source}s - are supplied.} - @item{@DFlag{copy} --- Disables default handling of directory @tech{package sources} as links, and instead treats them like other sources: package content is copied to install.} + @item{@DFlag{clone} @nonterm{dir} --- A Git or GitHub @tech{package + source} is cloned as @nonterm{dir} and locally linked as the + package implementation. Multiple @nonterm{pkg-source} + arguments make sense only if they all specify the same Git + repository (with different paths in the repository). The + @DFlag{clone} flag implies @DFlag{type} in the sense that each + @nonterm{pkg-source} must be either a Git or GitHub + @tech{package source}. See @secref["git-workflow"] for more + information.} + @item{@DFlag{binary} --- Strips source elements of a package before installing, and implies @DFlag{copy}.} @item{@DFlag{source} --- Strips built elements of a package before installing, and implies @DFlag{copy}.} @@ -477,6 +484,9 @@ sub-commands. whose name corresponds to an already-installed package, except for promoting auto-installed packages to explicitly installed.} + @item{@DFlag{pkgs} --- Disables default installation of the current directory when no @nonterm{pkg-source}s + are supplied.} + @item{@DFlag{all-platforms} --- Considers package dependencies independent of the current platform (instead of filtering dependencies to platforms other than the current one).} @@ -501,6 +511,7 @@ sub-commands. @item{@DFlag{fail-fast} --- Breaks @exec{raco setup} as soon as any error is encountered.} ] +@history[#:changed "6.1.1.5" @elem{Added the @DFlag{clone} flag.}]} @subcommand{@command/toc{update} @nonterm{option} ... @nonterm{pkg-source} ... @@ -513,13 +524,17 @@ 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-source}s. +If no @racket{pkg-source}, @DFlag{all} or @Flag{a} flag, or +@DFlag{clone} flag is specified, and if the current directory is +within a package, then the enclosing package is updated. + 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{lookup} --- Checks Causes a @tech{package name} as a @nonterm{pkg-source} to be used + @item{@DFlag{lookup} --- 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.)} @@ -534,6 +549,12 @@ the given @nonterm{pkg-source}s. @item{@DFlag{skip-implies} --- Same as for @command-ref{install}.} @item{@DFlag{link} --- Same as for @command-ref{install}.} @item{@DFlag{static-link} --- Same as for @command-ref{install}.} + @item{@DFlag{clone} @nonterm{dir} --- Same as for + @command-ref{install}, except that a @nonterm{pkg-source} can be + the name of an installed package. In that case, the package must + be currently installed from a Git or GitHub source, and that + source is used for the clone (which replaces the existing package + installation).} @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}.} @@ -550,6 +571,11 @@ the given @nonterm{pkg-source}s. @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}.} ] + +@history[#:changed "6.1.1.5" @elem{Added the @DFlag{clone} flag, and added + update of enclosing package when no + arguments are provided.}] + } @subcommand{@command/toc{remove} @nonterm{option} ... @nonterm{pkg} ... @@ -581,12 +607,15 @@ the given @nonterm{pkg}s. ] } -@subcommand{@command/toc{new} @nonterm{package} --- -Populates a directory with the stubs for a new racket package, where -@nonterm{package} is the name of the new package. -If @nonterm{package} already exists as a folder in the current directory, no new + +@subcommand{@command/toc{new} @nonterm{pkg} --- +Populates a directory with the stubs for a new package, where +@nonterm{pkg} is the name of the new package. +If @nonterm{pkg} already exists as a directory in the current directory, no new package is created. -} + +@history[#:added "6.1.1.5"]} + @subcommand{@command/toc{show} @nonterm{option} ... --- Print information about currently installed packages. By default, packages are shown for all @tech{package scopes}, but only for packages @@ -612,8 +641,7 @@ package is created. @item{@DFlag{scope-dir} @nonterm{dir} --- Shows only packages installed in @nonterm{dir}.} @item{@DFlag{version} @nonterm{vers} or @Flag{v} @nonterm{vers} --- Show only user-specific packages for the installation name/version @nonterm{vers}.} - ] -} + ]} @subcommand{@command/toc{migrate} @nonterm{option} ... @nonterm{from-version} --- Installs packages that were previously installed in @exec{user} @@ -980,6 +1008,10 @@ The following @filepath{info.rkt} fields are used by the package manager: @; ---------------------------------------- +@include-section["git-workflow.scrbl"] + +@; ---------------------------------------- + @include-section["apis.scrbl"] @include-section["catalog-protocol.scrbl"] diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/test-catalogs-api.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/test-catalogs-api.rkt index 866f7702ee..521063f96b 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/test-catalogs-api.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/test-catalogs-api.rkt @@ -18,10 +18,10 @@ (check-equal? (hash-ref (hash-ref details "pkg-test1") 'source) - "http://localhost:9999/pkg-test1.zip") + "http://localhost:9997/pkg-test1.zip") (check-equal? (hash-ref (hash-ref details "pkg-test2") 'source) - "http://localhost:9999/pkg-test2.zip") + "http://localhost:9997/pkg-test2.zip") (define test1-details (get-pkg-details-from-catalogs "pkg-test1")) (check-equal? test1-details @@ -30,7 +30,7 @@ (define-values (cksum mods deps) (get-pkg-content (pkg-desc "pkg-test1" #f #f #f #f))) (define-values (cksum1 mods1 deps1) - (get-pkg-content (pkg-desc "http://localhost:9999/pkg-test1.zip" #f #f #f #f))) + (get-pkg-content (pkg-desc "http://localhost:9997/pkg-test1.zip" #f #f #f #f))) (check-equal? cksum cksum1) (check-equal? (sort mods stringstring db)) $ "raco pkg catalog-show pkg-test1" - =stdout> #rx"Source: http://localhost:9999/pkg-test1.zip" + =stdout> #rx"Source: http://localhost:9997/pkg-test1.zip" (parameterize ([db:current-pkg-catalog-file db]) (db:set-pkgs! "local" (append (db:get-pkgs) (list - (db:pkg "fish" "local" "nemo@sub" "http://localhost:9999/fish.zip" "123" + (db:pkg "fish" "local" "nemo@sub" "http://localhost:9997/fish.zip" "123" "Not a whale")))) (db:set-pkg-modules! "fish" "local" "123" '((lib "fish/main.rkt") (lib "fish/food.rkt"))) (db:set-pkg-dependencies! "fish" "local" "123" @@ -78,7 +78,7 @@ (lambda (o) (write (hash 'name "whale" 'checksum cksum - 'source "http://localhost:9999/whale.plt" + 'source "http://localhost:9997/whale.plt" 'versions (hash "5.3.6" (hash 'checksum 123))) diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-checksums.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-checksums.rkt index bee0dca8a7..448c7d04b2 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-checksums.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-checksums.rkt @@ -43,7 +43,7 @@ (hasheq 'checksum (file->string "test-pkgs/pkg-test1-bad-checksum.zip.CHECKSUM") 'source - "http://localhost:9999/pkg-test1-bad-checksum.zip")) + "http://localhost:9997/pkg-test1-bad-checksum.zip")) $ "raco pkg config --set catalogs http://localhost:9990 http://localhost:9991" $ "racket -e '(require pkg-test1)'" =exit> 1 $ "raco pkg install pkg-test1" =exit> 1 @@ -53,20 +53,20 @@ (shelly-case "checksums are checked (remote)" $ "racket -e '(require pkg-test1)'" =exit> 1 - $ "raco pkg install http://localhost:9999/pkg-test1-bad-checksum.zip" =exit> 1 + $ "raco pkg install http://localhost:9997/pkg-test1-bad-checksum.zip" =exit> 1 $ "racket -e '(require pkg-test1)'" =exit> 1)) (with-fake-root (shelly-case "checksums are required by default remotely (remote)" $ "racket -e '(require pkg-test1)'" =exit> 1 - $ "raco pkg install http://localhost:9999/pkg-test1-no-checksum.zip" =exit> 1 + $ "raco pkg install http://localhost:9997/pkg-test1-no-checksum.zip" =exit> 1 $ "racket -e '(require pkg-test1)'" =exit> 1)) (shelly-install* "but, bad checksums can be ignored (local)" "--ignore-checksums test-pkgs/pkg-test1-bad-checksum.zip" "pkg-test1-bad-checksum") (shelly-install* "but, bad checksums can be ignored (remote)" - "--ignore-checksums http://localhost:9999/pkg-test1-bad-checksum.zip" + "--ignore-checksums http://localhost:9997/pkg-test1-bad-checksum.zip" "pkg-test1-bad-checksum") (shelly-install* "but, checksums can be missing if ignored (remote)" - "--ignore-checksums http://localhost:9999/pkg-test1-no-checksum.zip" + "--ignore-checksums http://localhost:9997/pkg-test1-no-checksum.zip" "pkg-test1-no-checksum")))) diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-clone.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-clone.rkt new file mode 100644 index 0000000000..924ef42caf --- /dev/null +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-clone.rkt @@ -0,0 +1,163 @@ +#lang racket/base +(require rackunit + racket/file + racket/format + web-server/servlet-env + "util.rkt" + "shelly.rkt") + +(this-test-is-run-by-the-main-test) + +(define (set-file path content) + (call-with-output-file* + path + #:exists 'truncate/replace + (lambda (o) (displayln content o)))) + +(pkg-tests + (define git-exe (find-executable-path + (if (eq? 'windows (system-type)) "git.exe" "git"))) + + (when git-exe + (define tmp-dir (path->directory-path (make-temporary-file "pkg~a" 'directory))) + (define http-custodian (make-custodian)) + + (parameterize ([current-custodian http-custodian]) + (thread + (lambda () + (serve/servlet + void + #:command-line? #t + #:extra-files-paths + (list tmp-dir) + #:servlet-regexp #rx"$." ; no servlets + #:port 9998)))) + + (shelly-wind + (sync (system-idle-evt)) ; let web server get going + + (define clone-dir (build-path tmp-dir "clones")) + (make-directory clone-dir) + + (define a-dir (build-path tmp-dir "a")) + + ;; ---------------------------------------- + ;; Single-package repository + + (make-directory a-dir) + $ (~a "cd " a-dir "; git init") + (set-file (build-path a-dir "main.rkt") "#lang racket/base 1") + (define (commit-changes-cmd [a-dir a-dir]) + (~a "cd " a-dir "; git add .; git commit -m change; git update-server-info")) + $ (commit-changes-cmd) + + (shelly-case + "basic --clone installation" + $ (~a "raco pkg install --clone " (build-path clone-dir "a") " --name a http://localhost:9998/a/.git") + $ "racket -l a" =stdout> "1\n") + + (shelly-case + "update of --clone installation" + (set-file (build-path a-dir "main.rkt") "#lang racket/base 2") + $ (commit-changes-cmd) + $ (~a "raco pkg update a") + $ "racket -l a" =stdout> "2\n") + + (shelly-case + "update of --clone installation doesn't overwrite local changes" + (set-file (build-path a-dir "main.rkt") "#lang racket/base 3") + $ (commit-changes-cmd) + (set-file (build-path clone-dir "a" "alt.rkt") "#lang racket/base 'one") + $ (~a "cd " (build-path clone-dir "a") "; git add .; git commit -m local") + $ "racket -l a" =stdout> "2\n" + $ "racket -l a/alt" =stdout> "'one\n" + $ (~a "raco pkg update a") =exit> 1 =stderr> #rx"fast-forward" + $ (~a "cd " (build-path clone-dir "a") "; git pull --rebase") + $ (~a "raco pkg update a") + $ "racket -l a" =stdout> "3\n" + $ "racket -l a/alt" =stdout> "'one\n") + + (shelly-case + "update of --clone installation doesn't proceed past conflicts" + (set-file (build-path a-dir "main.rkt") "#lang racket/base 4") + $ (commit-changes-cmd) + (set-file (build-path clone-dir "a" "main.rkt") "#lang racket/base 3.5") + $ (~a "raco pkg update a") =exit> 1 + $ "racket -l a" =stdout> "3.5\n") + + (shelly-case + "removal of --clone installation leaves local clone intact" + $ "raco pkg remove a" + $ "racket -l a" =exit> 1 + $ (~a "ls " (build-path clone-dir "a"))) + + (delete-directory/files (build-path clone-dir "a")) + (delete-directory/files a-dir) + + ;; ---------------------------------------- + ;; Multi-package repository + + (make-directory a-dir) + $ (~a "cd " a-dir "; git init") + (make-directory* (build-path a-dir "one")) + (set-file (build-path a-dir "one" "main.rkt") "#lang racket/base 1") + (make-directory* (build-path a-dir "two")) + (set-file (build-path a-dir "two" "main.rkt") "#lang racket/base 2") + $ (commit-changes-cmd) + + (shelly-case + "--clone installation with path into repository" + $ (~a "raco pkg install --clone " (build-path clone-dir "a") " --name one http://localhost:9998/a/.git?path=one") + $ "racket -l one" =stdout> "1\n" + $ (~a "ls " (build-path clone-dir "a"))) + + (shelly-case + "update of --clone installation" + (set-file (build-path a-dir "one" "main.rkt") "#lang racket/base 1.0") + $ (commit-changes-cmd) + $ (~a "raco pkg update one") + $ "racket -l one" =stdout> "1.0\n") + + (shelly-case + "--clone second installation with path into same repository" + (set-file (build-path a-dir "one" "main.rkt") "#lang racket/base 'one") + $ (commit-changes-cmd) + $ (~a "raco pkg install --clone " (build-path clone-dir "a") " http://localhost:9998/a/.git?path=two") + $ "racket -l one" =stdout> "'one\n" + $ "racket -l two" =stdout> "2\n") + + (shelly-case + "no changes => still an update, since previous update was implicit via shared repo" + $ "raco pkg update one" =stdout> #rx"Re-installing one\n") + + (shelly-case + "no further changes => no update" + $ "raco pkg update one two" =stdout> #rx"No updates available\n") + + $ "raco pkg remove one two" + + (shelly-case + "conflicting repositories with the same name" + (define another-a-dir (build-path tmp-dir "another" "a")) + (make-directory* another-a-dir) + $ (~a "cd " another-a-dir "; git init") + (make-directory* (build-path another-a-dir "two")) + (set-file (build-path another-a-dir "two" "main.rkt") "#lang racket/base 'two") + $ (commit-changes-cmd another-a-dir) + + ;; A wacky merge of repsitories will happen here, but the checkout should not + ;; get mangled. The package manager should bail out at the point that it would + ;; try to rebase the single "a" clone on different commits. + $ (~a "raco pkg install --clone " (build-path clone-dir "a") + " http://localhost:9998/a/.git?path=one" + " http://localhost:9998/another/a/.git?path=two") + =exit> 1 + =stderr> #rx"different target commits" + ;; Check that the old repo checkout is not mangled: + $ (~a "racket " (build-path clone-dir "a" "two" "main.rkt")) =stdout> "2\n") + + ;; ---------------------------------------- + + (finally + (custodian-shutdown-all http-custodian) + (delete-directory/files tmp-dir))))) diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-deps.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-deps.rkt index 4fbbb88e81..1493759a4e 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-deps.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-deps.rkt @@ -108,7 +108,7 @@ $ "racket -e '(require pkg-test2)'" =exit> 1 $ "raco pkg install --deps search-auto test-pkgs/pkg-test2.zip" =exit> 0 - =stdout> "Resolving \"pkg-test1\" via http://localhost:9990\nDownloading http://localhost:9999/pkg-test1.zip\nThe following uninstalled packages were listed as dependencies\nand they were automatically installed:\n dependencies of pkg-test2:\n pkg-test1\n" + =stdout> "Resolving \"pkg-test1\" via http://localhost:9990\nDownloading http://localhost:9997/pkg-test1.zip\nThe following uninstalled packages were listed as dependencies\nand they were automatically installed:\n dependencies of pkg-test2:\n pkg-test1\n" =stderr> "" $ "racket -e '(require pkg-test2)'" =exit> 0 $ "racket -e '(require pkg-test2/contains-dep)'" =exit> 0 diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-implies.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-implies.rkt index 65b8328748..4c3cd0292c 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-implies.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-implies.rkt @@ -20,13 +20,13 @@ (hasheq 'checksum (file->string (format "test-pkgs/pkg-implied-~a.zip.CHECKSUM" s)) 'source - (format "http://localhost:9999/pkg-implied-~a.zip" s)))) + (format "http://localhost:9997/pkg-implied-~a.zip" s)))) (implied-version! "one") (hash-set! *index-ht-1* "pkg-implies" (hasheq 'checksum (file->string "test-pkgs/pkg-implies.zip.CHECKSUM") 'source - "http://localhost:9999/pkg-implies.zip")) + "http://localhost:9997/pkg-implies.zip")) (with-fake-root (shelly-begin diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-install.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-install.rkt index e388eae1a9..6840bef428 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-install.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-install.rkt @@ -59,9 +59,9 @@ $ "raco pkg install test-pkgs/pkg-test1.zip.CHECKSUM" =exit> 1) (shelly-install "remote/URL/http package (file, tgz)" - "http://localhost:9999/pkg-test1.tgz") + "http://localhost:9997/pkg-test1.tgz") (shelly-install "remote/URL/http package (directory)" - "http://localhost:9999/pkg-test1/") + "http://localhost:9997/pkg-test1/") (with-fake-root (shelly-begin @@ -96,19 +96,19 @@ (shelly-case "remote/URL/http directory, non-existant file" - $ "raco pkg install http://localhost:9999/pkg-test1.rar" =exit> 1) + $ "raco pkg install http://localhost:9997/pkg-test1.rar" =exit> 1) (shelly-case "remote/URL/http directory, no manifest fail" - $ "raco pkg install http://localhost:9999/pkg-test1/pkg-test1/" + $ "raco pkg install http://localhost:9997/pkg-test1/pkg-test1/" =exit> 1 =stderr> #rx"could not find MANIFEST") (shelly-case "remote/URL/http directory, bad manifest" ;; XXX why does this error now? - $ "raco pkg install http://localhost:9999/pkg-test1-manifest-error/" =exit> 1) + $ "raco pkg install http://localhost:9997/pkg-test1-manifest-error/" =exit> 1) (shelly-case "remote/URL/file, bad checksum" - $ "raco pkg install --checksum zzz http://localhost:9999/pkg-test1.tgz" + $ "raco pkg install --checksum zzz http://localhost:9997/pkg-test1.tgz" =exit> 1 =stderr> #rx"mismatched checksum") diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-migrate.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-migrate.rkt index a4eacc5f99..3c14f356d4 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-migrate.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-migrate.rkt @@ -15,12 +15,12 @@ (hasheq 'checksum (file->string "test-pkgs/pkg-b-second.plt.CHECKSUM") 'source - "http://localhost:9999/pkg-b-second.plt")) + "http://localhost:9997/pkg-b-second.plt")) (hash-set! *index-ht-1* "pkg-a" (hasheq 'checksum (file->string "test-pkgs/pkg-a-first.plt.CHECKSUM") 'source - "http://localhost:9999/pkg-a-first.plt")) + "http://localhost:9997/pkg-a-first.plt")) $ "raco pkg install -u --deps search-auto pkg-b" =exit> 0 $ "raco pkg show -u -a" =stdout> #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-a\\* +[a-f0-9]+ \\(catalog pkg-a\\)\npkg-b +[a-f0-9]+ +\\(catalog pkg-b\\)\n" $ (~a "racket" 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 dd6afa22b8..c82de07ec4 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-name.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-name.rkt @@ -96,6 +96,8 @@ (check-equal-values? (parse "github://github.com/racket/fish.more/release" 'github) (values #f 'github #t)) (check-equal-values? (parse "github://github.com/racket/./release" #f #rx"indicator") (values #f 'github #f)) (check-equal-values? (parse "github://github.com/../fish/release" #f #rx"indicator") (values #f 'github #f)) + (check-equal-values? (parse "github://github.com/racket/fish/master" 'clone) (values "fish" 'clone #t)) + (check-equal-values? (parse "github://github.com/fish/master" 'clone #rx"three") (values #f 'clone #f)) (check-equal-values? (parse "git://github.com/racket/fish" #f) (values "fish" 'github #t)) (check-equal-values? (parse "git://github.com/racket/fish/" #f) (values "fish" 'github #t)) @@ -111,6 +113,8 @@ (check-equal-values? (parse "git://github.com/racket/fish.more" 'github) (values #f 'github #t)) (check-equal-values? (parse "git://github.com/racket/." #f #rx"indicator") (values #f 'github #f)) (check-equal-values? (parse "git://github.com/../fish" #f #rx"indicator") (values #f 'github #f)) + (check-equal-values? (parse "git://github.com/racket/fish" 'clone) (values "fish" 'clone #t)) + (check-equal-values? (parse "racket/fish" 'github) (values "fish" 'github #t)) (check-equal-values? (parse "git://not-github.com/racket/fish" #f #f) (values "fish" 'git #t)) (check-equal-values? (parse "git://not-github.com/fish" #f #f) (values "fish" 'git #t)) @@ -123,6 +127,8 @@ (check-equal-values? (parse "git://not-github.com/fish/?path=catfish/bill" #f) (values "bill" 'git #t)) (check-equal-values? (parse "git://not-github.com/../fish.git/" #f) (values "fish" 'git #t)) (check-equal-values? (parse "git://not-github.com/.././" #f #rx"indicator") (values #f 'git #f)) + (check-equal-values? (parse "git://not-github.com/racket/fish" 'clone #f) (values "fish" 'clone #t)) + (check-equal-values? (parse "git://not-github.com/.././" 'clone #rx"indicator") (values #f 'clone #f)) (check-equal-values? (parse "http://racket-lang.org/racket/fish" 'git #f) (values "fish" 'git #t)) (check-equal-values? (parse "https://racket-lang.org/racket/fish" 'git #f) (values "fish" 'git #t)) @@ -155,7 +161,7 @@ (check-equal-values? (parse "" 'file-url) (values #f 'file-url #f)) (check-equal-values? (parse "" 'dir-url) (values #f 'dir-url #f)) (check-equal-values? (parse "" 'git) (values #f 'git #f)) - (check-equal-values? (parse "" 'github #rx"empty") (values #f 'github #f)) + (check-equal-values? (parse "" 'github #rx"two path elements") (values #f 'github #f)) (void)) diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-raco.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-raco.rkt index f733d1308e..cac26ba656 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-raco.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-raco.rkt @@ -48,7 +48,7 @@ $ "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* "remote packages can be updated" - "http://localhost:9999/update-test/pkg-test1.zip" + "http://localhost:9997/update-test/pkg-test1.zip" "pkg-test1 pkg-test3" $ "raco pkg install --copy test-pkgs/pkg-test3" $ "racket -l pkg-test3/number" =exit> 1 diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-update-auto.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-update-auto.rkt index 86cc10b446..598113f72b 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-update-auto.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-update-auto.rkt @@ -11,7 +11,7 @@ (hasheq 'checksum (file->string "test-pkgs/pkg-b-first.plt.CHECKSUM") 'source - "http://localhost:9999/pkg-b-first.plt")) + "http://localhost:9997/pkg-b-first.plt")) $ "raco pkg config --set catalogs http://localhost:9990" $ "raco pkg install pkg-b" $ "racket -e '(require pkg-b)'" =exit> 42 @@ -19,12 +19,12 @@ (hasheq 'checksum (file->string "test-pkgs/pkg-b-second.plt.CHECKSUM") 'source - "http://localhost:9999/pkg-b-second.plt")) + "http://localhost:9997/pkg-b-second.plt")) (hash-set! *index-ht-1* "pkg-a" (hasheq 'checksum (file->string "test-pkgs/pkg-a-first.plt.CHECKSUM") 'source - "http://localhost:9999/pkg-a-first.plt")))) + "http://localhost:9997/pkg-a-first.plt")))) (pkg-tests (shelly-case @@ -41,12 +41,12 @@ (hasheq 'checksum (file->string "test-pkgs/pkg-b-second.plt.CHECKSUM") 'source - "http://localhost:9999/pkg-b-second.plt")) + "http://localhost:9997/pkg-b-second.plt")) (hash-set! *index-ht-1* "pkg-a" (hasheq 'checksum (file->string "test-pkgs/pkg-a-first.plt.CHECKSUM") 'source - "http://localhost:9999/pkg-a-first.plt")) + "http://localhost:9997/pkg-a-first.plt")) $ "raco pkg install --deps search-auto pkg-b" =exit> 0 #rx"Package\\[\\*=auto\\] +Checksum +Source\npkg-a\\* +[a-f0-9]+ \\(catalog pkg-a\\)\npkg-b +[a-f0-9]+ +\\(catalog pkg-b\\)\n" $ "racket -e '(require pkg-b)'" =exit> 43 @@ -61,7 +61,7 @@ (hasheq 'checksum (file->string "test-pkgs/pkg-a-second.plt.CHECKSUM") 'source - "http://localhost:9999/pkg-a-second.plt")) + "http://localhost:9997/pkg-a-second.plt")) $ "raco pkg update -a" =exit> 0 $ "racket -e '(require pkg-a)'" =exit> 43 $ "raco pkg remove pkg-b" diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-update-deps.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-update-deps.rkt index 7eb2290b66..5e8757de00 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-update-deps.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-update-deps.rkt @@ -11,7 +11,7 @@ (hasheq 'checksum (file->string "test-pkgs/pkg-b-first.plt.CHECKSUM") 'source - "http://localhost:9999/pkg-b-first.plt")) + "http://localhost:9997/pkg-b-first.plt")) $ "raco pkg config --set catalogs http://localhost:9990" $ "raco pkg install pkg-b" $ "racket -e '(require pkg-b)'" =exit> 42 @@ -19,12 +19,12 @@ (hasheq 'checksum (file->string "test-pkgs/pkg-b-second.plt.CHECKSUM") 'source - "http://localhost:9999/pkg-b-second.plt")) + "http://localhost:9997/pkg-b-second.plt")) (hash-set! *index-ht-1* "pkg-a" (hasheq 'checksum (file->string "test-pkgs/pkg-a-first.plt.CHECKSUM") 'source - "http://localhost:9999/pkg-a-first.plt")))) + "http://localhost:9997/pkg-a-first.plt")))) (pkg-tests (shelly-case @@ -86,7 +86,7 @@ (hasheq 'checksum (file->string "test-pkgs/pkg-a-second.plt.CHECKSUM") 'source - "http://localhost:9999/pkg-a-second.plt")) + "http://localhost:9997/pkg-a-second.plt")) $ "racket -e '(require pkg-a)'" =exit> 0 $ "raco pkg update pkg-a" =exit> 0 $ "racket -e '(require pkg-a)'" =exit> 43 @@ -104,7 +104,7 @@ (hasheq 'checksum (file->string "test-pkgs/pkg-a-third.plt.CHECKSUM") 'source - "http://localhost:9999/pkg-a-third.plt")) + "http://localhost:9997/pkg-a-third.plt")) $ "racket -e '(require pkg-a)'" =exit> 0 $ "raco pkg update pkg-a" =exit> 1 $ "racket -e '(require pkg-a)'" =exit> 0 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 32cc4c0b3f..d206036a17 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-update.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-update.rkt @@ -78,7 +78,7 @@ $ "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* "remote packages can be updated" - "http://localhost:9999/update-test/pkg-test1.zip" + "http://localhost:9997/update-test/pkg-test1.zip" "pkg-test1" $ "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 @@ -95,7 +95,7 @@ $ "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* "remote packages can be updated, single-collection to multi-collection" - "test-pkgs/pkg-test1.zip http://localhost:9999/update-test/pkg-test3.zip" + "test-pkgs/pkg-test1.zip http://localhost:9997/update-test/pkg-test3.zip" "pkg-test1 pkg-test3" $ "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" @@ -111,7 +111,7 @@ $ "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" (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" + "test-pkgs/pkg-test1.zip http://localhost:9997/update-test/pkg-test3.zip" "pkg-test1 pkg-test3" $ "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" @@ -129,9 +129,9 @@ $ "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" + "http://localhost:9997/update-test/pkg-test1.zip" "pkg-test1" - $ "raco pkg install http://localhost:9999/update-test/pkg-test2.zip" + $ "raco pkg install http://localhost:9997/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 @@ -151,9 +151,9 @@ $ "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" + "http://localhost:9997/update-test/pkg-test1.zip" "pkg-test1" - $ "raco pkg install http://localhost:9999/update-test/pkg-test3.zip" + $ "raco pkg install http://localhost:9997/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 @@ -176,9 +176,9 @@ $ "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" + "http://localhost:9997/update-test/pkg-test1.zip" "pkg-test1" - $ "raco pkg install http://localhost:9999/update-test/pkg-test3.zip" + $ "raco pkg install http://localhost:9997/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 @@ -201,9 +201,9 @@ $ "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" + "http://localhost:9997/update-test/pkg-test1.zip" "pkg-test1" - $ "raco pkg install http://localhost:9999/update-test/pkg-test3.zip" + $ "raco pkg install http://localhost:9997/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" @@ -225,7 +225,7 @@ $ "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" + "http://localhost:9997/update-test/pkg-test1.zip" "pkg-test1" $ "raco pkg install test-pkgs/pkg-test2.zip" $ "raco pkg update -a" =exit> 0 =stdout> "Downloading checksum for pkg-test1\nNo updates available\n" diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-versions.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-versions.rkt index f3e38b16c6..b901618b83 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-versions.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-versions.rkt @@ -30,13 +30,13 @@ (hasheq 'checksum (file->string "test-pkgs/pkg-v-one.zip.CHECKSUM") 'source - "http://localhost:9999/pkg-v-one.zip")) + "http://localhost:9997/pkg-v-one.zip")) (hash-set! *index-ht-1* "pkg-w" (hasheq 'checksum (file->string "test-pkgs/pkg-w-one.zip.CHECKSUM") 'source - "http://localhost:9999/pkg-w-one.zip")) + "http://localhost:9997/pkg-w-one.zip")) $ "raco pkg config --set catalogs http://localhost:9990" @@ -57,7 +57,7 @@ (hasheq 'checksum (file->string "test-pkgs/pkg-v-two.zip.CHECKSUM") 'source - "http://localhost:9999/pkg-v-two.zip")) + "http://localhost:9997/pkg-v-two.zip")) (shelly-case "update" @@ -68,12 +68,12 @@ (hasheq 'checksum (file->string "test-pkgs/pkg-v-three.zip.CHECKSUM") 'source - "http://localhost:9999/pkg-v-three.zip")) + "http://localhost:9997/pkg-v-three.zip")) (hash-set! *index-ht-1* "pkg-w" (hasheq 'checksum (file->string "test-pkgs/pkg-w-two.zip.CHECKSUM") 'source - "http://localhost:9999/pkg-w-two.zip")) + "http://localhost:9997/pkg-w-two.zip")) (shelly-case "update again" @@ -85,7 +85,7 @@ (hasheq 'checksum (file->string "test-pkgs/pkg-w-three.zip.CHECKSUM") 'source - "http://localhost:9999/pkg-w-three.zip")) + "http://localhost:9997/pkg-w-three.zip")) (shelly-case "update again" diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/util.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/util.rkt index 3220ecb1fe..29eec9802a 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/util.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/util.rkt @@ -108,7 +108,7 @@ (define (start-file-server) (serve/servlet (λ (req) (response/xexpr "None")) #:command-line? #t - #:port 9999 + #:port 9997 #:extra-files-paths (list (build-path test-directory "test-pkgs")))) (require "basic-index.rkt") @@ -192,7 +192,7 @@ (hasheq 'checksum (file->string "test-pkgs/pkg-test1.zip.CHECKSUM") 'source - "http://localhost:9999/pkg-test1.zip" + "http://localhost:9997/pkg-test1.zip" 'tags '("first"))) @@ -200,7 +200,7 @@ (hasheq 'checksum (file->string "test-pkgs/pkg-test2.zip.CHECKSUM") 'source - "http://localhost:9999/pkg-test2.zip" + "http://localhost:9997/pkg-test2.zip" 'dependencies '("pkg-test1"))) @@ -208,7 +208,7 @@ (hasheq 'checksum (file->string "test-pkgs/pkg-test2.zip.CHECKSUM") 'source - "http://localhost:9999/pkg-test2.zip" + "http://localhost:9997/pkg-test2.zip" 'dependencies '("pkg-test1")))) diff --git a/racket/collects/pkg/lib.rkt b/racket/collects/pkg/lib.rkt index 5b3ef7a2fa..e37c3fa5a7 100644 --- a/racket/collects/pkg/lib.rkt +++ b/racket/collects/pkg/lib.rkt @@ -34,6 +34,12 @@ (or/c 'installation 'user (and/c path? complete-path?))) +(define pkg-desc/opt + (let ([pkg-desc (lambda (source type name checksum auto? + #:path [path #f]) + (pkg-desc source type name checksum auto? path))]) + pkg-desc)) + (provide (all-from-out "path.rkt") with-pkg-lock @@ -58,13 +64,15 @@ (parameter/c (or/c #f real?))] [pkg-directory (-> string? (or/c path-string? #f))] - [pkg-desc - (-> string? - (or/c #f 'file 'dir 'link 'static-link 'file-url 'dir-url 'git 'github 'name) - (or/c string? #f) - (or/c string? #f) - boolean? - pkg-desc?)] + [rename + pkg-desc/opt pkg-desc + (->* (string? + (or/c #f 'file 'dir 'link 'static-link 'file-url 'dir-url 'git 'github 'clone 'name) + (or/c string? #f) + (or/c string? #f) + boolean?) + (#:path (or/c #f path-string?)) + pkg-desc?)] [pkg-config (->* (boolean? (listof string?)) (#:from-command-line? boolean?) diff --git a/racket/collects/pkg/main.rkt b/racket/collects/pkg/main.rkt index a5a68c2980..10e51a4819 100644 --- a/racket/collects/pkg/main.rkt +++ b/racket/collects/pkg/main.rkt @@ -114,7 +114,8 @@ #:install-force-flags (install-force-flags ...) #:update-deps-flags (update-deps-flags ...) #:install-copy-flags (install-copy-flags ...) - #:install-copy-defns (install-copy-defns ...)) + #:install-copy-defns (install-copy-defns ...) + #:install-copy-checks (install-copy-checks ...)) (with-syntax ([([scope-flags ...] [job-flags ...] [catalog-flags ...] @@ -123,7 +124,8 @@ [install-force-flags ...] [update-deps-flags ...] [install-copy-flags ...] - [install-copy-defns ...]) + [install-copy-defns ...] + [install-copy-checks ...]) (syntax-local-introduce #'([scope-flags ...] [job-flags ...] [catalog-flags ...] @@ -132,7 +134,8 @@ [install-force-flags ...] [update-deps-flags ...] [install-copy-flags ...] - [install-copy-defns ...]))]) + [install-copy-defns ...] + [install-copy-checks ...]))]) #`(commands "This tool is used for managing installed packages." "pkg-~a-command" @@ -167,6 +170,7 @@ 'install scope scope-dir installation user #f a-type (lambda () + install-copy-checks ... (when (and name (> (length pkg-source) 1)) ((current-pkg-error) (format "the --name flag only makes sense with a single package source"))) (unless (or (not name) (package-source->name name)) @@ -199,7 +203,9 @@ #:force-strip? force #:link-dirs? link-dirs? (for/list ([p (in-list sources)]) - (pkg-desc p a-type* name checksum #f)))))) + (pkg-desc p a-type* name checksum #f + #:path (and (eq? a-type* 'clone) + (path->complete-path clone)))))))) (setup "installed" no-setup fail-fast setup-collects jobs)))] ;; ---------------------------------------- [update @@ -226,40 +232,53 @@ 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 checksum #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 checksum #f))])) - #:from-command-line? #t - #:all? all - #:dep-behavior (if auto 'search-auto deps) - #:all-platforms? all-platforms - #:force? force - #:ignore-checksums? ignore-checksums - #:strict-doc-conflicts? strict-doc-conflicts - #:use-cache? (not no-cache) - #:update-deps? (or update-deps auto) - #:update-implies? (not ignore-implies) - #:strip (or (and source 'source) - (and binary 'binary) - (and binary-lib 'binary-lib)) - #:force-strip? force - #:link-dirs? link-dirs?)))) - (setup "updated" no-setup #f setup-collects jobs)))] + (let ([pkg-source (cond + [(and (null? pkg-source) + (not all) + (not clone)) + ;; In a package directory? + (define pkg (path->pkg (current-directory))) + (if pkg + (list pkg) + null)] + [else pkg-source])]) + (call-with-package-scope + 'update + scope scope-dir installation user pkg-source #f + (lambda () + install-copy-checks ... + (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 checksum #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 checksum #f + #:path (and (eq? a-type 'clone) + (path->complete-path clone))))])) + #:from-command-line? #t + #:all? all + #:dep-behavior (if auto 'search-auto deps) + #:all-platforms? all-platforms + #:force? force + #:ignore-checksums? ignore-checksums + #:strict-doc-conflicts? strict-doc-conflicts + #:use-cache? (not no-cache) + #:update-deps? (or update-deps auto) + #:update-implies? (not ignore-implies) + #:strip (or (and source 'source) + (and binary 'binary) + (and binary-lib 'binary-lib)) + #:force-strip? force + #:link-dirs? link-dirs?)))) + (setup "updated" no-setup #f setup-collects jobs))))] ;; ---------------------------------------- [remove "Remove packages" @@ -559,12 +578,29 @@ ([#: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")] + [(#:str dir #f) clone () ("Clone Git and GitHub package sources to and link")] [#:bool source () ("Strip packages' built elements before installing; implies --copy")] [#:bool binary () ("Strip packages' source elements before installing; implies --copy")] [#:bool binary-lib () ("Strip source & documentation before installing; implies --copy")]) #:install-copy-defns [(define link-dirs? (not (or copy source binary binary-lib))) - (define a-type (or (and link 'link) - (and static-link 'static-link) - (and (eq? type 'dir) link-dirs? 'link) - type))])) + (define link-type (or (and link 'link) + (and static-link 'static-link) + (and (eq? type 'dir) link-dirs? 'link) + (and clone 'clone))) + (define a-type (or link-type type))] + #:install-copy-checks + [(when (and type + link-type + (not (memq type + (case link-type + [(clone) '(git github)] + [else '(dir)])))) + ((current-pkg-error) (format "-t/--type value must be ~a with --~a" + (cond + [clone "`git' or `github'"] + [else "`dir'"]) + (cond + [link "link"] + [static-link "static-link"] + [clone "clone"]))))])) diff --git a/racket/collects/pkg/name.rkt b/racket/collects/pkg/name.rkt index a3600ad31a..f0ab9a427f 100644 --- a/racket/collects/pkg/name.rkt +++ b/racket/collects/pkg/name.rkt @@ -25,7 +25,7 @@ (define rx:git #rx"[.]git$") (define package-source-format? - (or/c 'name 'file 'dir 'git 'github 'file-url 'dir-url 'link 'static-link)) + (or/c 'name 'file 'dir 'git 'github 'clone 'file-url 'dir-url 'link 'static-link)) (define (validate-name name complain inferred?) (and name @@ -134,14 +134,22 @@ (eq? type 'name) (regexp-match? rx:package-name s)) (values (validate-name s complain #f) 'name)] + [(and (eq? type 'clone) + (not (regexp-match? #rx"^(?:https?|git(?:hub)?)://" s))) + (complain "repository URL must start 'http', 'https', 'git', or 'github'") + (values #f 'clone)] [(and (eq? type 'github) (not (regexp-match? #rx"^git(?:hub)?://" s))) - (package-source->name+type + (package-source->name+type (string-append "git://github.com/" s) - 'github)] + 'github + #:link-dirs? link-dirs? + #:complain complain-proc + #:must-infer-name? must-infer-name?)] [(if type (or (eq? type 'github) (eq? type 'git) + (eq? type 'clone) (eq? type 'file-url) (eq? type 'dir-url)) (regexp-match? #rx"^(https?|github|git)://" s)) @@ -152,7 +160,9 @@ (let ([p (url-path url)]) (cond [(if type - (eq? type 'github) + (or (eq? type 'github) + (and (eq? type 'clone) + (equal? (url-scheme url) "github"))) (or (equal? (url-scheme url) "github") (equal? (url-scheme url) "git"))) (unless (or (equal? (url-scheme url) "github") @@ -218,7 +228,8 @@ (extract-archive-name (last-non-empty p) complain-name))) (values name 'file-url)] [(if type - (eq? type 'git) + (or (eq? type 'git) + (eq? type 'clone)) (and (last-non-empty p) (string-and-regexp-match? rx:git (last-non-empty p)) ((num-empty p) . < . 2))) diff --git a/racket/collects/pkg/path.rkt b/racket/collects/pkg/path.rkt index c19934cd03..fcf236855f 100644 --- a/racket/collects/pkg/path.rkt +++ b/racket/collects/pkg/path.rkt @@ -129,7 +129,8 @@ (define orig (pkg-info-orig-pkg v)) (if (and (pair? orig) (or (eq? 'link (car orig)) - (eq? 'static-link (car orig)))) + (eq? 'static-link (car orig)) + (eq? 'clone (car orig)))) (let ([e (or (and cache (hash-ref cache `(pkg-dir ,(cadr orig)) #f)) (let ([e (explode (simplify-path diff --git a/racket/collects/pkg/private/archive.rkt b/racket/collects/pkg/private/archive.rkt index 45b32b5998..cbf2f7c46e 100644 --- a/racket/collects/pkg/private/archive.rkt +++ b/racket/collects/pkg/private/archive.rkt @@ -134,7 +134,7 @@ ;; Download/unpack existing package: (define-values (staged-name staged-dir staged-checksum clean? staged-mods) (pkg-stage - (pkg-desc (path->string pkg-dir) 'dir name checksum #f) + (pkg-desc (path->string pkg-dir) 'dir name checksum #f #f) #:in-place? #f #:use-cache? #t #:quiet? quiet?)) diff --git a/racket/collects/pkg/private/catalog-archive.rkt b/racket/collects/pkg/private/catalog-archive.rkt index 0fc5a9fc3c..38bb4885f0 100644 --- a/racket/collects/pkg/private/catalog-archive.rkt +++ b/racket/collects/pkg/private/catalog-archive.rkt @@ -78,7 +78,7 @@ ;; Download/unpack existing package: (define-values (staged-name staged-dir staged-checksum clean? staged-mods) (pkg-stage - (pkg-desc (db:pkg-source pkg) #f (db:pkg-name pkg) (db:pkg-checksum pkg) #f) + (pkg-desc (db:pkg-source pkg) #f (db:pkg-name pkg) (db:pkg-checksum pkg) #f #f) #:in-place? #t #:use-cache? #t #:quiet? quiet?)) diff --git a/racket/collects/pkg/private/desc.rkt b/racket/collects/pkg/private/desc.rkt index 2511e636e9..728c7019df 100644 --- a/racket/collects/pkg/private/desc.rkt +++ b/racket/collects/pkg/private/desc.rkt @@ -3,7 +3,7 @@ (provide (struct-out pkg-desc) pkg-desc=?) -(struct pkg-desc (source type name checksum auto?)) +(struct pkg-desc (source type name checksum auto? extra-path)) (define (pkg-desc=? a b) (define (->list a) @@ -11,5 +11,6 @@ (pkg-desc-type a) (pkg-desc-name a) (pkg-desc-checksum a) - (pkg-desc-auto? a))) + (pkg-desc-auto? a) + (pkg-desc-extra-path a))) (equal? (->list a) (->list b))) diff --git a/racket/collects/pkg/private/download.rkt b/racket/collects/pkg/private/download.rkt index a3de9bb9b4..0fd31d07c1 100644 --- a/racket/collects/pkg/private/download.rkt +++ b/racket/collects/pkg/private/download.rkt @@ -98,7 +98,7 @@ #:log-debug-string (lambda (s) (log-pkg-debug s)))))) -(define (download-repo! url host repo dest-dir checksum +(define (download-repo! url host port repo dest-dir checksum #:download-printf [download-printf #f] #:use-cache? [use-cache? #t]) (log-pkg-debug "\t\tDownloading ~a to ~a" (url->string url) dest-dir) @@ -107,7 +107,7 @@ (define unpacked? #f) (define (download!) - (git-checkout host repo + (git-checkout host #:port port repo #:dest-dir dest-dir #:ref checksum #:status-printf (or download-printf void) diff --git a/racket/collects/pkg/private/git.rkt b/racket/collects/pkg/private/git.rkt new file mode 100644 index 0000000000..60fcd4bf47 --- /dev/null +++ b/racket/collects/pkg/private/git.rkt @@ -0,0 +1,35 @@ +#lang racket/base +(require racket/system + racket/format + racket/promise + "print.rkt") + +(provide git) + +(define git-exe (delay (find-executable-path + (if (eq? (system-type) 'windows) + "git.exe" + "git")))) + +(define (git #:status [status void] + #:quiet-stderr? [quiet-stderr? #t] ; suppress stderr unless error + . args) + (define exe (force git-exe)) + (unless exe + (pkg-error (~a "could not find `git' executable\n" + " intended command: git ~a") + (apply ~a #:separator " " args))) + (status (apply ~a #:separator " " "git" args)) + (define stderr (if quiet-stderr? + (open-output-bytes) + (current-error-port))) + (define r ((parameterize ([current-error-port stderr]) + (with-handlers ([values (lambda (exn) + ;; re-raise after restoring stderr: + (lambda () (raise exn)))]) + (define r (apply system* exe args)) + (lambda () r))))) + (unless r + (when quiet-stderr? + (write-bytes (get-output-bytes stderr) (current-error-port))) + (pkg-error "Git command failed"))) diff --git a/racket/collects/pkg/private/install.rkt b/racket/collects/pkg/private/install.rkt index 58e98e6d87..38c84d1f2e 100644 --- a/racket/collects/pkg/private/install.rkt +++ b/racket/collects/pkg/private/install.rkt @@ -23,16 +23,20 @@ "metadata.rkt" "dep.rkt" "get-info.rkt" + "catalog.rkt" "dirs.rkt" "collects.rkt" - "addl-installs.rkt") + "addl-installs.rkt" + "repo-path.rkt" + "orig-pkg.rkt" + "git.rkt") (provide pkg-install pkg-update) (define (checksum-for-pkg-source pkg-source type pkg-name given-checksum download-printf) (case type - [(file-url dir-url github git) + [(file-url dir-url github git clone) (or given-checksum (remote-package-checksum `(url ,pkg-source) download-printf pkg-name #:type type))] [(file) @@ -41,6 +45,9 @@ (file->string checksum-pth)) (and (file-exists? pkg-source) (call-with-input-file* pkg-source sha1)))] + [(name) + (or given-checksum + (remote-package-checksum `(catalog ,pkg-source) download-printf pkg-name #:type type))] [else given-checksum])) (define (disallow-package-path-overlaps pkg-name @@ -154,9 +161,9 @@ (define all-db (merge-pkg-dbs)) (define path-pkg-cache (make-hash)) (define (install-package/outer infos desc info) - (match-define (pkg-desc pkg type orig-name given-checksum auto?) desc) + (match-define (pkg-desc pkg type orig-name given-checksum auto? pkg-extra-path) desc) (match-define - (install-info pkg-name orig-pkg pkg-dir clean? checksum module-paths additional-installs) + (install-info pkg-name orig-pkg pkg-dir git-dir clean? checksum module-paths additional-installs) info) (define name? (eq? 'catalog (first orig-pkg))) (define this-dep-behavior (or dep-behavior @@ -209,10 +216,13 @@ ;; Also, make sure it's installed in the scope that we're changing: (hash-ref current-scope-db pkg-name #f)) ;; promote an auto-installed package to a normally installed one - (lambda () - (unless quiet? - (download-printf "Promoting ~a from auto-installed to explicitly installed\n" pkg-name)) - (update-pkg-db! pkg-name (update-auto existing-pkg-info #f)))] + (cons + #f ; no repo change + ;; The `do-it` thunk: + (lambda () + (unless quiet? + (download-printf "Promoting ~a from auto-installed to explicitly installed\n" pkg-name)) + (update-pkg-db! pkg-name (update-auto existing-pkg-info #f))))] [else ;; Fail --- already installed (clean!) @@ -405,7 +415,8 @@ #:all-platforms? all-platforms? #:ignore-checksums? ignore-checksums? #:use-cache? use-cache? - #:from-command-line? from-command-line?) + #:from-command-line? from-command-line? + #:link-dirs? link-dirs?) name)) null)) deps)) @@ -508,7 +519,8 @@ #:all-platforms? all-platforms? #:ignore-checksums? ignore-checksums? #:use-cache? use-cache? - #:from-command-line? from-command-line?) + #:from-command-line? from-command-line? + #:link-dirs? link-dirs?) update-pkgs)]) (λ () (for-each (compose (remove-package quiet?) pkg-desc-name) to-update)))) (match this-dep-behavior @@ -531,48 +543,57 @@ (clean!) (report-mismatch update-deps)])]))] [else - (λ () - (when updating? - (download-printf "Re-installing ~a\n" pkg-name)) - (define final-pkg-dir - (cond + (cons + ;; The repo to get new commits, if any: + (and git-dir + (list (enclosing-path-for-repo (caddr orig-pkg) git-dir) + checksum)) + ;; The "do-it" function (see `repos+do-its` below): + (λ () + (when updating? + (download-printf "Re-installing ~a\n" pkg-name)) + (define final-pkg-dir + (cond [clean? - (define final-pkg-dir (select-package-directory - (build-path (pkg-installed-dir) pkg-name))) - (make-parent-directory* final-pkg-dir) - (copy-directory/files pkg-dir final-pkg-dir #:keep-modify-seconds? #t) + (define final-pkg-dir (or git-dir + (select-package-directory + (build-path (pkg-installed-dir) pkg-name)))) + (unless git-dir + (make-parent-directory* final-pkg-dir) + (copy-directory/files pkg-dir final-pkg-dir #:keep-modify-seconds? #t)) (clean!) final-pkg-dir] [else pkg-dir])) - (define single-collect (pkg-single-collection final-pkg-dir - #:name pkg-name - #:namespace post-metadata-ns)) - (log-pkg-debug "creating ~alink to ~e" - (if single-collect "single-collection " "") - final-pkg-dir) - (define scope (current-pkg-scope)) - (links final-pkg-dir - #:name single-collect - #:user? (not (or (eq? 'installation scope) - (path? scope))) - #:file (scope->links-file scope) - #:root? (not single-collect) - #:static-root? (and (pair? orig-pkg) - (eq? 'static-link (car orig-pkg)))) - (define alt-dir-name - ;; If we had to pick an alternate dir name, then record it: - (let-values ([(base name dir?) (split-path final-pkg-dir)]) - (and (regexp-match? #rx"[+]" name) - (path->string name)))) - (define this-pkg-info - (make-pkg-info orig-pkg checksum auto? single-collect alt-dir-name)) - (log-pkg-debug "updating db with ~e to ~e" pkg-name this-pkg-info) - (update-pkg-db! pkg-name this-pkg-info))])) + (define single-collect (pkg-single-collection final-pkg-dir + #:name pkg-name + #:namespace post-metadata-ns)) + (log-pkg-debug "creating ~alink to ~e" + (if single-collect "single-collection " "") + final-pkg-dir) + (define scope (current-pkg-scope)) + (links final-pkg-dir + #:name single-collect + #:user? (not (or (eq? 'installation scope) + (path? scope))) + #:file (scope->links-file scope) + #:root? (not single-collect) + #:static-root? (and (pair? orig-pkg) + (eq? 'static-link (car orig-pkg)))) + (define alt-dir-name + ;; If we had to pick an alternate dir name, then record it: + (let-values ([(base name dir?) (split-path final-pkg-dir)]) + (and (regexp-match? #rx"[+]" name) + (path->string name)))) + (define this-pkg-info + (make-pkg-info orig-pkg checksum auto? single-collect alt-dir-name)) + (log-pkg-debug "updating db with ~e to ~e" pkg-name this-pkg-info) + (update-pkg-db! pkg-name this-pkg-info)))])) (define metadata-ns (make-metadata-namespace)) (define infos (for/list ([v (in-list descs)]) (stage-package/info (pkg-desc-source v) (pkg-desc-type v) (pkg-desc-name v) + #:at-dir (pkg-desc-extra-path v) #:given-checksum (pkg-desc-checksum v) #:use-cache? use-cache? check-sums? download-printf @@ -598,14 +619,49 @@ (define all-descs (append old-descs descs)) (define all-infos (append old-infos infos)) - (define do-its + (define repo+do-its ; list of (cons #f-or-(list git-dir checksum) do-it-thunk) (map (curry install-package/outer all-infos) all-descs all-infos)) + + ;; collapse planned repo actions, and make sure they don't conflict: + (define repos + (for/fold ([ht (hash)]) ([repo+do-it (in-list repo+do-its)]) + (define repo (car repo+do-it)) + (cond + [repo + (define git-dir (car repo)) + (define checksum (cadr repo)) + (define prev-checksum (hash-ref ht git-dir #f)) + (when (and prev-checksum + (not (equal? prev-checksum checksum))) + (pkg-error (~a "multiple packages in the same clone have different target commits\n" + " clone: ~a\n" + " commit: ~a\n" + " other commit: ~a") + git-dir + prev-checksum + checksum)) + (hash-set ht git-dir checksum)] + [else ht]))) + + ;; relevant commits have been fecthed to the repos, and now we need + ;; to check them out; If a checkout fails, then we've left the + ;; package installation in no worse shape than if a manual `git + ;; pull` failed + (for ([(git-dir checksum) (in-hash repos)]) + (parameterize ([current-directory git-dir]) + (download-printf "Merging commits at ~a\n" + git-dir) + (git #:status (lambda (s) (download-printf "~a\n" s)) + "merge" "--ff-only" checksum))) + + ;; pre-succeed removes packages that are being updated (pre-succeed) (define post-metadata-ns (make-metadata-namespace)) - (for-each (λ (t) (t)) do-its) + ;; moves packages into place and installs links: + (for-each (λ (t) ((cdr t))) repo+do-its) (define (is-promote? info) ;; if the package name is in `current-scope-db', we must @@ -628,7 +684,7 @@ post-metadata-ns))) (cond - [(or (null? do-its) + [(or (null? repo+do-its) (and (not updating?) (andmap is-promote? all-infos))) ;; No actions, so no setup: 'skip] @@ -751,7 +807,7 @@ (for/list ([dep (in-list deps)]) (if (pkg-desc? dep) dep - (pkg-desc dep #f #f #f #t))))])]) + (pkg-desc dep #f #f #f #t #f))))])]) (begin0 (install-packages #:old-infos old-infos @@ -813,7 +869,8 @@ #:all-platforms? all-platforms? #:ignore-checksums? ignore-checksums? #:use-cache? use-cache? - #:from-command-line? from-command-line?) + #:from-command-line? from-command-line? + #:link-dirs? link-dirs?) pkg-name) (cond [(pkg-desc? pkg-name) @@ -821,6 +878,7 @@ (define-values (inferred-name type) (package-source->name+type (pkg-desc-source pkg-name) (pkg-desc-type pkg-name) + #:link-dirs? link-dirs? #:must-infer-name? (not (pkg-desc-name pkg-name)) #:complain complain-about-source)) (define name (or (pkg-desc-name pkg-name) @@ -832,6 +890,7 @@ name (pkg-desc-checksum pkg-name) download-printf)) + (hash-set! update-cache name new-checksum) ; record downloaded checksum (unless (or ignore-checksums? (not (pkg-desc-checksum pkg-name))) (unless (equal? (pkg-desc-checksum pkg-name) new-checksum) (pkg-error (~a "incorrect checksum on package\n" @@ -841,10 +900,16 @@ (pkg-desc-source pkg-name) (pkg-desc-checksum pkg-name) new-checksum))) + (if (or (not (equal? (pkg-info-checksum info) new-checksum)) ;; No checksum available => always update - (not new-checksum)) + (not new-checksum) + ;; Different source => always update + (not (equal? (pkg-info-orig-pkg info) + (desc->orig-pkg type + (pkg-desc-source pkg-name) + (pkg-desc-extra-path pkg-name))))) ;; Update: (begin (hash-set! update-cache (pkg-desc-source pkg-name) #t) @@ -852,7 +917,10 @@ (pkg-desc-type pkg-name) name (pkg-desc-checksum pkg-name) - (pkg-desc-auto? pkg-name)))) + (pkg-desc-auto? pkg-name) + (or (pkg-desc-extra-path pkg-name) + (and (eq? type 'clone) + (current-directory)))))) ;; No update needed, but maybe check dependencies: (if (or deps? implies?) @@ -865,7 +933,8 @@ #:all-platforms? all-platforms? #:ignore-checksums? ignore-checksums? #:use-cache? use-cache? - #:from-command-line? from-command-line?) + #:from-command-line? from-command-line? + #:link-dirs? link-dirs?) name) null))] [(eq? #t (hash-ref update-cache pkg-name #f)) @@ -881,12 +950,10 @@ (match orig-pkg [`(,(or 'link 'static-link) ,orig-pkg-dir) (if must-update? - (pkg-error (~a "cannot update linked packages~a\n" + (pkg-error (~a "cannot update linked packages;\n" + " except with a replacement package source\n" " package name: ~a\n" " package source: ~a") - (if from-command-line? - " without `--link'" - " without new link") pkg-name (normalize-path (path->complete-path orig-pkg-dir (pkg-installed-dir)))) @@ -894,6 +961,7 @@ [`(dir ,_) (if must-update? (pkg-error (~a "cannot update packages installed locally;\n" + " except with a replacement package source;\n" " package was installed via a local directory\n" " package name: ~a") pkg-name) @@ -901,11 +969,21 @@ [`(file ,_) (if must-update? (pkg-error (~a "cannot update packages installed locally;\n" + " except with a replacement package source;\n" " package was installed via a local file\n" " package name: ~a") pkg-name) null)] - [`(,_ ,orig-pkg-source) + [_ + (define-values (orig-pkg-source orig-pkg-type orig-pkg-dir) + (if (eq? 'clone (car orig-pkg)) + (values (caddr orig-pkg) + 'clone + (enclosing-path-for-repo (caddr orig-pkg) (cadr orig-pkg))) + ;; It would be better if the type were preseved + ;; from install time, but we always make the + ;; URL unambigious: + (values (cadr orig-pkg) #f #f))) (define new-checksum (or (hash-ref update-cache pkg-name #f) (remote-package-checksum orig-pkg download-printf pkg-name))) @@ -920,9 +998,8 @@ ;; 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 #f auto?)))) + (list (pkg-desc orig-pkg-source orig-pkg-type pkg-name #f auto? + orig-pkg-dir)))) (if (or deps? implies?) ;; Check dependencies (append-map @@ -935,7 +1012,8 @@ #:all-platforms? all-platforms? #:ignore-checksums? ignore-checksums? #:use-cache? use-cache? - #:from-command-line? from-command-line?) + #:from-command-line? from-command-line? + #:link-dirs? link-dirs?) ((package-dependencies metadata-ns db all-platforms? #:only-implies? (not deps?)) pkg-name)) @@ -975,14 +1053,18 @@ #:all-platforms? all-platforms? #:ignore-checksums? ignore-checksums? #:use-cache? use-cache? - #:from-command-line? from-command-line?) - pkgs)) + #:from-command-line? from-command-line? + #:link-dirs? link-dirs?) + (map (convert-clone-name-to-clone-repo db) + pkgs))) (cond [(empty? pkgs) (unless quiet? (printf/flush (~a "No packages given to update" (if from-command-line? - ";\n use `--all' to update all packages" + (~a + ";\n use `--all' to update all packages, or run from a package's directory" + "\n to update that package") "") "\n"))) 'skip] @@ -1015,6 +1097,49 @@ #:link-dirs? link-dirs? to-update)])) +;; If `pkg` is a description with the type 'clone, but its syntax +;; matches a ackage name, then infer a repo from the current package +;; installation and return an alternate description. +(define ((convert-clone-name-to-clone-repo db) pkg-name) + (cond + [(and (pkg-desc? pkg-name) + (eq? 'clone (pkg-desc-type pkg-name)) + (let-values ([(name type) (package-source->name+type (pkg-desc-source pkg-name) 'name)]) + name)) + => (lambda (name) + ;; Infer or complain + (define info (package-info name #:db db)) + (unless info + (pkg-error (~a "package is not currently installed\n" + " package: ~a") + name)) + (define new-pkg-name + (match (pkg-info-orig-pkg info) + [`(clone ,path ,url-str) + (pkg-error (~a "package is already a linked repository clone\n" + " package: ~a") + name)] + [`(url ,url-str) + (define-values (current-name current-type) + (package-source->name+type url-str #f)) + (case current-type + [(git github) + ;; found a repo URL + (pkg-desc url-str 'clone name + (pkg-desc-checksum pkg-name) + (pkg-desc-auto? pkg-name) + (pkg-desc-extra-path pkg-name))] + [else #f])] + [else #f])) + (unless new-pkg-name + (pkg-error (~a "package is not currently installed from a repository\n" + " package: ~a\n" + " current installation: ~a") + name + (pkg-info-orig-pkg info))) + new-pkg-name)] + [else pkg-name])) + ;; ---------------------------------------- (define (clear-checksums-in-cache! update-cache) @@ -1022,3 +1147,4 @@ #:when (string? v)) k)) (for ([k (in-list l)]) (hash-remove! update-cache k))) + diff --git a/racket/collects/pkg/private/migrate.rkt b/racket/collects/pkg/private/migrate.rkt index 20211a44f2..c6fdef4757 100644 --- a/racket/collects/pkg/private/migrate.rkt +++ b/racket/collects/pkg/private/migrate.rkt @@ -1,12 +1,15 @@ #lang racket/base (require racket/match + net/url "../path.rkt" "config.rkt" "lock.rkt" "pkg-db.rkt" "desc.rkt" "params.rkt" - "install.rkt") + "install.rkt" + "repo-path.rkt" + "dirs.rkt") (provide pkg-migrate) @@ -24,17 +27,25 @@ (define from-db (parameterize ([current-pkg-scope-version from-version]) (installed-pkg-table #:scope 'user))) + (define installed-dir + (parameterize ([current-pkg-scope 'user]) + (pkg-installed-dir))) + (define (path->complete-string p) + (path->string (path->complete-path p installed-dir))) (define to-install (sort (for/list ([(name info) (in-hash from-db)] #:unless (pkg-info-auto? info)) - (define-values (source type) + (define-values (source type dir) (match (pkg-info-orig-pkg info) - [(list 'catalog name) (values name 'name)] - [(list 'url url) (values url #f)] - [(list 'link path) (values path 'link)] - [(list 'static-link path) (values path 'static-link)])) - (pkg-desc source type name #f #f)) + [(list 'catalog name) (values name 'name #f)] + [(list 'url url) (values url #f #f)] + [(list 'link path) (values (path->complete-string path) 'link #f)] + [(list 'static-link path) (values (path->complete-string path) 'static-link #f)] + [(list 'clone path url) (values url 'clone (enclosing-path-for-repo + url + (path->complete-path path)))])) + (pkg-desc source type name #f #f dir)) stringorig-pkg) + +(define (desc->orig-pkg type src extra-path) + (case type + [(name) `(catalog ,src)] + [(link static-link) `(,type + ,(path->string + (find-relative-path (pkg-installed-dir) + (simple-form-path src) + #:more-than-root? #t)))] + [(clone) + (define-values (host port repo branch path) + (split-git-or-hub-url (string->url src))) + `(clone ,(path->string + (find-relative-path (pkg-installed-dir) + (simple-form-path + (apply build-path + extra-path + path)) + #:more-than-root? #t)) + ,src)] + [(file dir) `(,type ,(simple-form-path* src))] + [else `(url ,src)])) diff --git a/racket/collects/pkg/private/pkg-db.rkt b/racket/collects/pkg/private/pkg-db.rkt index 37ee2976a5..913829ee51 100644 --- a/racket/collects/pkg/private/pkg-db.rkt +++ b/racket/collects/pkg/private/pkg-db.rkt @@ -175,7 +175,7 @@ (let () (match-define (pkg-info orig-pkg checksum _) info) (match orig-pkg - [`(,(or 'link 'static-link) ,orig-pkg-dir) + [`(,(or 'link 'static-link 'clone) ,orig-pkg-dir . ,_) (path->complete-path orig-pkg-dir (pkg-installed-dir))] [_ (build-path (pkg-installed-dir) diff --git a/racket/collects/pkg/private/remove.rkt b/racket/collects/pkg/private/remove.rkt index b6df2c973f..be1bcee4bf 100644 --- a/racket/collects/pkg/private/remove.rkt +++ b/racket/collects/pkg/private/remove.rkt @@ -36,7 +36,7 @@ (define user? (not (or (eq? scope 'installation) (path? scope)))) (match orig-pkg - [`(,(or 'link 'static-link) ,_) + [`(,(or 'link 'static-link 'clone) ,_ . ,_) (links pkg-dir #:remove? #t #:user? user? diff --git a/racket/collects/pkg/private/repo-path.rkt b/racket/collects/pkg/private/repo-path.rkt new file mode 100644 index 0000000000..af65d6728f --- /dev/null +++ b/racket/collects/pkg/private/repo-path.rkt @@ -0,0 +1,58 @@ +#lang racket/base +(require net/url + racket/string + racket/format + racket/match + racket/list + "download.rkt") + +(provide split-github-url + split-git-url + split-git-or-hub-url + enclosing-path-for-repo) + +(define (split-github-url pkg-url) + (if (equal? (url-scheme pkg-url) "github") + ;; github:// + (map path/param-path (url-path/no-slash pkg-url)) + ;; git:// + (let* ([paths (map path/param-path (url-path/no-slash pkg-url))]) + (list* (car paths) + (regexp-replace* #rx"[.]git$" (cadr paths) "") + (or (url-fragment pkg-url) "master") + (extract-git-path pkg-url))))) + +(define (extract-git-path pkg-url) + (let ([a (assoc 'path (url-query pkg-url))]) + (or (and a (cdr a) (string-split (cdr a) "/")) + null))) + +;; returns: (values host repo branch path) +(define (split-git-url pkg-url) + (values (url-host pkg-url) + (url-port pkg-url) + (string-join (map (compose ~a path/param-path) + (url-path/no-slash pkg-url)) + "/") + (or (url-fragment pkg-url) "master") + (extract-git-path pkg-url))) + +(define (split-git-or-hub-url pkg-url) + (if (equal? "github" (url-scheme pkg-url)) + (match (split-github-url pkg-url) + [(list* user repo branch path) + (values "github.com" #f (~a "/" user "/" repo) branch path)]) + (split-git-url pkg-url))) + +(define (enclosing-path-for-repo url-str in-repo-dir) + (define-values (host port repo branch path) + (split-git-or-hub-url (string->url url-str))) + (let loop ([path path] + [in-repo-dir in-repo-dir]) + (cond + [(null? path) in-repo-dir] + [else + (define-values (base name dir?) (split-path in-repo-dir)) + (if (not (path? base)) + (error "path for git repo link is too short for path in package source") + (loop (cdr path) base))]))) diff --git a/racket/collects/pkg/private/stage.rkt b/racket/collects/pkg/private/stage.rkt index 2386aad17f..3244b8c856 100644 --- a/racket/collects/pkg/private/stage.rkt +++ b/racket/collects/pkg/private/stage.rkt @@ -25,14 +25,17 @@ "params.rkt" "get-info.rkt" "mod-paths.rkt" - "addl-installs.rkt") + "addl-installs.rkt" + "repo-path.rkt" + "orig-pkg.rkt" + "git.rkt") (provide (struct-out install-info) remote-package-checksum stage-package/info pkg-stage) -(struct install-info (name orig-pkg directory clean? checksum module-paths additional-installs)) +(struct install-info (name orig-pkg directory git-directory clean? checksum module-paths additional-installs)) (define (remote-package-checksum pkg download-printf pkg-name #:type [type #f]) (match pkg @@ -42,6 +45,11 @@ (package-url->checksum pkg-url-str #:type type #:download-printf download-printf + #:pkg-name pkg-name)] + [`(clone ,_ ,pkg-url-str) + (package-url->checksum pkg-url-str + #:type 'clone + #:download-printf download-printf #:pkg-name pkg-name)])) ;; Downloads a package (if needed) and unpacks it (if needed) into a @@ -49,6 +57,7 @@ (define (stage-package/info pkg given-type given-pkg-name + #:at-dir given-at-dir #:given-checksum [given-checksum #f] #:cached-url [cached-url #f] #:use-cache? use-cache? @@ -85,13 +94,90 @@ (not (regexp-match? #rx"^git(?:hub)?://" pkg))) ;; Add "git://github.com/" (stage-package/info (string-append "git://github.com/" pkg) type - pkg-name + pkg-name + #:at-dir given-at-dir #:given-checksum given-checksum #:use-cache? use-cache? check-sums? download-printf metadata-ns #:strip strip-mode #:force-strip? force-strip?)] + [(eq? type 'clone) + (define pkg-url (string->url pkg)) + (define pkg-no-query (url->string + (struct-copy url pkg-url + [query null]))) + (define-values (host port repo branch path) + (split-git-or-hub-url pkg-url)) + (define clone-dir (or given-at-dir + (current-directory))) + + (define tmp-dir (make-temporary-file + (string-append "~a-" pkg-name) + 'directory)) + + (define (status s) (download-printf "~a\n" s)) + + (define staged? #f) + (dynamic-wind + void + (λ () + (unless (and (directory-exists? clone-dir) + (directory-exists? (build-path clone-dir ".git"))) + (download-printf "Cloning remote repository ~a\n to ~a\n" + pkg-no-query + clone-dir) + (make-directory* clone-dir) + (parameterize ([current-directory clone-dir]) + (git #:status status "clone" "-b" branch pkg-no-query "."))) + + (define orig-pkg (desc->orig-pkg 'clone pkg given-at-dir)) + + (define checksum + (or given-checksum + (remote-package-checksum orig-pkg download-printf pkg-name))) + + (parameterize ([current-directory clone-dir]) + (download-printf "Fetching from remote repository ~a\n" + pkg-no-query) + (git #:status status "fetch" pkg-no-query)) + + ;; Make a clone of the [to-be-]linked checkout so that + ;; we can check dependencies, etc., before changing + ;; the checkout. + (download-printf "Cloning repository locally for staging\n") + (git #:status status "clone" clone-dir tmp-dir) + (parameterize ([current-directory tmp-dir]) + (git #:status status "fetch" clone-dir (or checksum branch)) + (git #:status status "checkout" (or checksum branch))) + + (lift-git-directory-content tmp-dir path) + + (begin0 + (update-install-info-checksum + (update-install-info-orig-pkg + (update-install-info-git-dir + (stage-package/info tmp-dir + 'dir + pkg-name + #:at-dir given-at-dir + #:given-checksum checksum + #:cached-url pkg-url + #:use-cache? use-cache? + check-sums? + download-printf + metadata-ns + #:strip strip-mode + #:force-strip? force-strip? + #:in-place? #t + #:in-place-clean? #t) + (apply build-path clone-dir path)) + orig-pkg) + checksum) + (set! staged? #t))) + (λ () + (unless staged? + (delete-directory/files tmp-dir))))] [(or (eq? type 'file-url) (eq? type 'dir-url) (eq? type 'github) @@ -100,7 +186,7 @@ (define pkg-url (string->url pkg-url-str)) (define scheme (url-scheme pkg-url)) - (define orig-pkg `(url ,pkg-url-str)) + (define orig-pkg (desc->orig-pkg type pkg-url-str #f)) (define found-checksum ;; If a checksum is given, use that. In the case of a non-github ;; source, we could try to get the checksum from the source, and @@ -119,7 +205,7 @@ (~a "cannot use empty checksum for Git repostory package source\n" " source: ~a") pkg)) - (define-values (host repo branch path) (split-git-url pkg-url)) + (define-values (host port repo branch path) (split-git-url pkg-url)) (define tmp-dir (make-temporary-file (string-append @@ -131,21 +217,16 @@ (dynamic-wind void (λ () - (download-repo! pkg-url host repo tmp-dir checksum + (download-repo! pkg-url host port repo tmp-dir checksum #:use-cache? use-cache? #:download-printf download-printf) - (unless (null? path) - (unless (directory-exists? (apply build-path tmp-dir path)) - (pkg-error - (~a "specified directory is not in Git respository\n" - " path: ~a") - (apply build-path path))) - (lift-directory-content tmp-dir path)) + (lift-git-directory-content tmp-dir path) (begin0 (stage-package/info tmp-dir 'dir pkg-name + #:at-dir given-at-dir #:given-checksum checksum #:cached-url pkg-url #:use-cache? use-cache? @@ -218,6 +299,7 @@ (stage-package/info tmp-dir 'dir pkg-name + #:at-dir given-at-dir #:given-checksum checksum #:cached-url new-url #:use-cache? use-cache? @@ -308,6 +390,7 @@ (stage-package/info package-path download-type pkg-name + #:at-dir given-at-dir #:given-checksum checksum #:cached-url pkg-url #:use-cache? use-cache? @@ -410,6 +493,7 @@ (stage-package/info pkg-dir 'dir pkg-name + #:at-dir given-at-dir #:given-checksum checksum #:cached-url cached-url #:use-cache? use-cache? @@ -440,12 +524,10 @@ [(or (eq? type 'link) (eq? type 'static-link)) (install-info pkg-name - `(,type ,(path->string - (find-relative-path (pkg-installed-dir) - (simple-form-path pkg-path) - #:more-than-root? #t))) + (desc->orig-pkg type pkg-path #f) pkg-path - #f + #f ; no git-dir + #f ; no clean? given-checksum ; if a checksum is provided, just use it (directory->module-paths pkg pkg-name metadata-ns) (directory->additional-installs pkg pkg-name metadata-ns))] @@ -473,6 +555,7 @@ (install-info pkg-name `(dir ,(simple-form-path* pkg-path)) pkg-dir + #f ; no git-dir (or (not in-place?) in-place-clean?) given-checksum ; if a checksum is provided, just use it (directory->module-paths pkg-dir pkg-name metadata-ns) @@ -485,6 +568,7 @@ (define info (stage-package/info source #f pkg-name + #:at-dir given-at-dir #:given-checksum checksum #:use-cache? use-cache? check-sums? @@ -499,7 +583,7 @@ (update-install-info-checksum info checksum) - `(catalog ,pkg))] + (desc->orig-pkg 'name pkg #f))] [else (pkg-error "cannot infer package source type\n source: ~a" pkg)])) @@ -513,6 +597,7 @@ (define i (stage-package/info (pkg-desc-source desc) (pkg-desc-type desc) (pkg-desc-name desc) + #:at-dir (pkg-desc-extra-path desc) #:given-checksum (pkg-desc-checksum desc) #:use-cache? use-cache? #t @@ -535,19 +620,25 @@ #:pkg-name [pkg-name "package"]) (define pkg-url (string->url pkg-url-str)) - (define type (or given-type - (let-values ([(name type) (package-source->name+type pkg-url-str given-type)]) - type))) + (define type (if (eq? given-type 'clone) + (if (equal? "github" (url-scheme (string->url pkg-url-str))) + 'github + 'git) + (or given-type + (let-values ([(name type) (package-source->name+type pkg-url-str given-type)]) + type)))) (case type [(git) - (define-values (host repo branch path) + (define-values (host port repo branch path) (split-git-url pkg-url)) - ;; supplying `#:dest-dir #f` means that we just resolve `branch` + (download-printf "Querying Git references for ~a at ~a\n" pkg-name pkg-url-str) + ;; Supplying `#:dest-dir #f` means that we just resolve `branch` ;; to an ID: - (git-checkout host repo + (git-checkout host #:port port repo #:dest-dir #f #:ref branch - #:status-printf download-printf + #:status-printf (lambda (fmt . args) + (log-pkg-debug (apply format fmt args))) #:transport (string->symbol (url-scheme pkg-url)))] [(github) (match-define (list* user repo branch path) @@ -565,7 +656,7 @@ (cons 'client_secret (github-client_secret))) empty)) #f)) - (download-printf "Querying GitHub ~a\n" kind) + (download-printf "Querying GitHub ~a for ~a\n" kind pkg-name) (log-pkg-debug "Querying GitHub at ~a" (url->string api-u)) (define api-bs (call/input-url+200 @@ -624,6 +715,8 @@ (cond [(equal? "git" (url-scheme as-url)) str] + [(equal? "github" (url-scheme as-url)) + str] [else (define p (reverse (url-path as-url))) (define skip (if (equal? "" (path/param-path (car p))) @@ -651,35 +744,23 @@ (struct-copy install-info if [checksum op])) +(define (update-install-info-git-dir if dir) + (struct-copy install-info if + [git-directory dir])) + ;; ---------------------------------------- (define github-client_id (make-parameter #f)) (define github-client_secret (make-parameter #f)) -(define (split-github-url pkg-url) - (if (equal? (url-scheme pkg-url) "github") - ;; github:// - (map path/param-path (url-path/no-slash pkg-url)) - ;; git:// - (let* ([paths (map path/param-path (url-path/no-slash pkg-url))]) - (list* (car paths) - (regexp-replace* #rx"[.]git$" (cadr paths) "") - (or (url-fragment pkg-url) "master") - (extract-git-path pkg-url))))) - -(define (extract-git-path pkg-url) - (let ([a (assoc 'path (url-query pkg-url))]) - (or (and a (cdr a) (string-split (cdr a) "/")) - null))) - -;; returns: (values host repo branch path) -(define (split-git-url pkg-url) - (values (url-host pkg-url) - (string-join (map (compose ~a path/param-path) - (url-path/no-slash pkg-url)) - "/") - (or (url-fragment pkg-url) "master") - (extract-git-path pkg-url))) +(define (lift-git-directory-content tmp-dir path) + (unless (null? path) + (unless (directory-exists? (apply build-path tmp-dir path)) + (pkg-error + (~a "specified directory is not in Git respository\n" + " path: ~a") + (apply build-path path))) + (lift-directory-content tmp-dir path))) ;; ----------------------------------------