raco pkg {install,update}: add --clone <dir> mode
Using `--clone <dir>` with a Git-based package source causes the package installation to be linked to a clone of the repository as a subdirectory of <dir>. 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.
This commit is contained in:
Matthew Flatt
parent
04f5fe3815
commit
6379aaddef
|
|
@ -192,6 +192,6 @@
|
|||
frame)
|
||||
|
||||
(module+ main
|
||||
(void (make-pkg-installer))
|
||||
#;
|
||||
(void (make-pkg-installer))
|
||||
(void (make-pkg-gui)))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
(string<? (cadr sa) (cadr sb))
|
||||
(case (car sa)
|
||||
[(link) #t]
|
||||
[(link static-link clone) #t]
|
||||
[(catalog) (eq? b 'url)]
|
||||
[(url) #f])))])))))
|
||||
(set! sorted-installed (list->vector l))
|
||||
|
|
|
|||
|
|
@ -28,6 +28,7 @@
|
|||
[(catalog) ""]
|
||||
[(link) "="]
|
||||
[(static-link) "="]
|
||||
[(clone) "="]
|
||||
[(url) "@"])))
|
||||
|
||||
(define by-list-panel%
|
||||
|
|
|
|||
|
|
@ -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
|
||||
...
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
148
pkgs/racket-pkgs/racket-doc/pkg/scribblings/git-workflow.scrbl
Normal file
148
pkgs/racket-pkgs/racket-doc/pkg/scribblings/git-workflow.scrbl
Normal file
|
|
@ -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.}
|
||||
|
||||
]
|
||||
|
|
@ -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}.
|
||||
|
|
|
|||
|
|
@ -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?]
|
||||
|
|
|
|||
|
|
@ -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]{
|
||||
|
|
|
|||
|
|
@ -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"]
|
||||
|
|
|
|||
|
|
@ -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 string<? #:key cadr)
|
||||
|
|
|
|||
|
|
@ -29,13 +29,13 @@
|
|||
$ (~a "raco pkg config --set catalogs file://" (path->string 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)))
|
||||
|
|
|
|||
|
|
@ -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"))))
|
||||
|
|
|
|||
163
pkgs/racket-pkgs/racket-test/tests/pkg/tests-clone.rkt
Normal file
163
pkgs/racket-pkgs/racket-test/tests/pkg/tests-clone.rkt
Normal file
|
|
@ -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)))))
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 <input= "y\n"
|
||||
$ "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"
|
||||
$ "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"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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"))))
|
||||
|
||||
|
|
|
|||
|
|
@ -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,12 +64,14 @@
|
|||
(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)
|
||||
[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?
|
||||
boolean?)
|
||||
(#:path (or/c #f path-string?))
|
||||
pkg-desc?)]
|
||||
[pkg-config
|
||||
(->* (boolean? (listof string?))
|
||||
|
|
|
|||
|
|
@ -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,10 +232,21 @@
|
|||
job-flags ...
|
||||
#:args pkg-source
|
||||
install-copy-defns ...
|
||||
(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
|
||||
|
|
@ -243,7 +260,9 @@
|
|||
(package-source->name+type pkg-source a-type))
|
||||
(if (eq? pkg-type 'name)
|
||||
pkg-name
|
||||
(pkg-desc pkg-source a-type name checksum #f))]))
|
||||
(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)
|
||||
|
|
@ -259,7 +278,7 @@
|
|||
(and binary-lib 'binary-lib))
|
||||
#:force-strip? force
|
||||
#:link-dirs? link-dirs?))))
|
||||
(setup "updated" no-setup #f setup-collects jobs)))]
|
||||
(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 <dir> 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)
|
||||
(define link-type (or (and link 'link)
|
||||
(and static-link 'static-link)
|
||||
(and (eq? type 'dir) link-dirs? 'link)
|
||||
type))]))
|
||||
(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"]))))]))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
(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)))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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?))
|
||||
|
|
|
|||
|
|
@ -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?))
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
35
racket/collects/pkg/private/git.rkt
Normal file
35
racket/collects/pkg/private/git.rkt
Normal file
|
|
@ -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")))
|
||||
|
|
@ -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
|
||||
(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)))]
|
||||
(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,16 +543,24 @@
|
|||
(clean!)
|
||||
(report-mismatch update-deps)])]))]
|
||||
[else
|
||||
(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)))
|
||||
(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)
|
||||
(copy-directory/files pkg-dir final-pkg-dir #:keep-modify-seconds? #t))
|
||||
(clean!)
|
||||
final-pkg-dir]
|
||||
[else
|
||||
|
|
@ -568,11 +588,12 @@
|
|||
(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))]))
|
||||
(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)))
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
string<?
|
||||
#:key pkg-desc-name))
|
||||
(unless quiet?
|
||||
|
|
|
|||
33
racket/collects/pkg/private/orig-pkg.rkt
Normal file
33
racket/collects/pkg/private/orig-pkg.rkt
Normal file
|
|
@ -0,0 +1,33 @@
|
|||
#lang racket/base
|
||||
(require racket/path
|
||||
net/url
|
||||
"dirs.rkt"
|
||||
"repo-path.rkt"
|
||||
"path.rkt")
|
||||
|
||||
;; An "orig-pkg" is the way that that a pacage source is recorded
|
||||
;; in the installed-package database.
|
||||
|
||||
(provide desc->orig-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)]))
|
||||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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?
|
||||
|
|
|
|||
58
racket/collects/pkg/private/repo-path.rkt
Normal file
58
racket/collects/pkg/private/repo-path.rkt
Normal file
|
|
@ -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))])))
|
||||
|
|
@ -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?
|
||||
|
|
@ -86,12 +95,89 @@
|
|||
;; Add "git://github.com/"
|
||||
(stage-package/info (string-append "git://github.com/" pkg) type
|
||||
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
|
||||
(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)))
|
||||
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)))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user