raco pkg {install,update}: add --pull
option
This commit is contained in:
parent
51d38152d4
commit
8aa16faa6d
|
@ -134,10 +134,14 @@ ways:
|
||||||
|
|
||||||
@item{When pulling changes to repositories that have local copies,
|
@item{When pulling changes to repositories that have local copies,
|
||||||
@command-ref{update} pulls changes with the equivalent of @exec{git
|
@command-ref{update} pulls changes with the equivalent of @exec{git
|
||||||
pull --ff-only}.}
|
pull --ff-only} by default. Supplying @exec{@DFlag{pull} rebase}
|
||||||
|
pulls changes with the equivalent of @exec{git pull --rebase}, instead.
|
||||||
|
Supplying @exec{@DFlag{pull} try} attempts to pull with @exec{git
|
||||||
|
pull --ff-only}, but failure is ignored.}
|
||||||
|
|
||||||
@item{When @command-ref{update} is given a specific commit as the target
|
@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
|
of the update, it uses the equivalent of @exec{git merge --ff-only
|
||||||
|
@nonterm{checksum}} or @exec{git merge --rebase
|
||||||
@nonterm{checksum}}. This approach is intended to preserve any
|
@nonterm{checksum}}. This approach is intended to preserve any
|
||||||
changes to the package made locally, but it implies that the
|
changes to the package made locally, but it implies that the
|
||||||
package cannot be ``downgraded'' to a older commit simply by
|
package cannot be ``downgraded'' to a older commit simply by
|
||||||
|
|
|
@ -252,6 +252,7 @@ is true, error messages may suggest specific command-line flags for
|
||||||
[#:strip strip (or/c #f 'source 'binary 'binary-lib) #f]
|
[#:strip strip (or/c #f 'source 'binary 'binary-lib) #f]
|
||||||
[#:force-strip? force-string? boolean? #f]
|
[#:force-strip? force-string? boolean? #f]
|
||||||
[#:multi-clone-mode multi-clone-mode (or/c 'fail 'force 'convert 'ask) 'fail]
|
[#:multi-clone-mode multi-clone-mode (or/c 'fail 'force 'convert 'ask) 'fail]
|
||||||
|
[#:pull-mode pull-mode (or/c 'ff-only 'try 'rebase) 'ff-only]
|
||||||
[#:link-dirs? link-dirs? boolean? #f])
|
[#:link-dirs? link-dirs? boolean? #f])
|
||||||
(or/c 'skip
|
(or/c 'skip
|
||||||
#f
|
#f
|
||||||
|
@ -285,7 +286,8 @@ The package lock must be held; see @racket[with-pkg-lock].
|
||||||
|
|
||||||
@history[#:changed "6.1.1.5" @elem{Added the @racket[#:multi-clone-mode]
|
@history[#:changed "6.1.1.5" @elem{Added the @racket[#:multi-clone-mode]
|
||||||
and @racket[#:infer-clone-from-dir?] arguments.}
|
and @racket[#:infer-clone-from-dir?] arguments.}
|
||||||
#:changed "6.1.1.6" @elem{Added the @racket[#:use-trash?] argument.}]}
|
#:changed "6.1.1.6" @elem{Added the @racket[#:use-trash?] argument.}
|
||||||
|
#:changed "6.1.1.8" @elem{Added the @racket[#:pull-mode] argument.}]}
|
||||||
|
|
||||||
|
|
||||||
@defproc[(pkg-update [sources (listof (or/c string? pkg-desc?))]
|
@defproc[(pkg-update [sources (listof (or/c string? pkg-desc?))]
|
||||||
|
@ -305,6 +307,7 @@ The package lock must be held; see @racket[with-pkg-lock].
|
||||||
[#:force-strip? force-string? boolean? #f]
|
[#:force-strip? force-string? boolean? #f]
|
||||||
[#:lookup-for-clone? lookup-for-clone? boolean? #f]
|
[#:lookup-for-clone? lookup-for-clone? boolean? #f]
|
||||||
[#:multi-clone-mode multi-clone-mode (or/c 'fail 'force 'convert 'ask) 'fail]
|
[#:multi-clone-mode multi-clone-mode (or/c 'fail 'force 'convert 'ask) 'fail]
|
||||||
|
[#:pull-mode pull-mode (or/c 'ff-only 'try 'rebase) 'ff-only]
|
||||||
[#:link-dirs? link-dirs? boolean? #f]
|
[#:link-dirs? link-dirs? boolean? #f]
|
||||||
[#:infer-clone-from-dir? infer-clone-from-dir? boolean? #f])
|
[#:infer-clone-from-dir? infer-clone-from-dir? boolean? #f])
|
||||||
(or/c 'skip
|
(or/c 'skip
|
||||||
|
@ -340,7 +343,8 @@ The package lock must be held; see @racket[with-pkg-lock].
|
||||||
|
|
||||||
@history[#:changed "6.1.1.5" @elem{Added the @racket[#:multi-clone-mode]
|
@history[#:changed "6.1.1.5" @elem{Added the @racket[#:multi-clone-mode]
|
||||||
and @racket[#:infer-clone-from-dir?] arguments.}
|
and @racket[#:infer-clone-from-dir?] arguments.}
|
||||||
#:changed "6.1.1.6" @elem{Added the @racket[#:use-trash?] argument.}]}
|
#:changed "6.1.1.6" @elem{Added the @racket[#:use-trash?] argument.}
|
||||||
|
#:changed "6.1.1.8" @elem{Added the @racket[#:pull-mode] argument.}]}
|
||||||
|
|
||||||
|
|
||||||
@defproc[(pkg-remove [names (listof string?)]
|
@defproc[(pkg-remove [names (listof string?)]
|
||||||
|
|
|
@ -571,6 +571,22 @@ sub-commands.
|
||||||
|
|
||||||
]}
|
]}
|
||||||
|
|
||||||
|
@item{@DFlag{pull} @nonterm{mode} --- Specifies the way that commits
|
||||||
|
are merged to clone-linked packages (see @secref["git-workflow"])
|
||||||
|
on installation or update. The following modes are available:
|
||||||
|
|
||||||
|
@itemlist[
|
||||||
|
|
||||||
|
@item{@exec{ff-only} --- Commits are merged using @DFlag{ff-only}, and installation fails
|
||||||
|
if the fast-forward merge fails.}
|
||||||
|
|
||||||
|
@item{@exec{try} --- Like @exec{ff-only}, but if the fast-forward fails, the repository checkout is
|
||||||
|
left as-is, and installation continues.}
|
||||||
|
|
||||||
|
@item{@exec{rebase} --- Commits are merged using @exec{git rebase} instead of @exec{git merge}.}
|
||||||
|
|
||||||
|
]}
|
||||||
|
|
||||||
|
|
||||||
@item{@DFlag{no-setup} --- Does not run @exec{raco setup} after installation. This behavior is also the case if the
|
@item{@DFlag{no-setup} --- Does not run @exec{raco setup} after installation. This behavior is also the case if the
|
||||||
environment variable @envvar{PLT_PKG_NOSETUP} is set to any non-empty value.}
|
environment variable @envvar{PLT_PKG_NOSETUP} is set to any non-empty value.}
|
||||||
|
@ -588,7 +604,8 @@ sub-commands.
|
||||||
@history[#:changed "6.1.1.5" @elem{Added the @DFlag{batch}, @DFlag{clone}, and
|
@history[#:changed "6.1.1.5" @elem{Added the @DFlag{batch}, @DFlag{clone}, and
|
||||||
@DFlag{multi-clone} flags.}
|
@DFlag{multi-clone} flags.}
|
||||||
#:changed "6.1.1.6" @elem{Added the @DFlag{no-trash} flag, and changed
|
#:changed "6.1.1.6" @elem{Added the @DFlag{no-trash} flag, and changed
|
||||||
the @DFlag{deps} default to depend only on interactive mode.}]}
|
the @DFlag{deps} default to depend only on interactive mode.}
|
||||||
|
#:changed "6.1.1.8" @elem{Added the @DFlag{pull} flag.}]}
|
||||||
|
|
||||||
|
|
||||||
@subcommand{@command/toc{update} @nonterm{option} ... @nonterm{pkg-source} ...
|
@subcommand{@command/toc{update} @nonterm{option} ... @nonterm{pkg-source} ...
|
||||||
|
@ -695,6 +712,8 @@ the given @nonterm{pkg-source}s.
|
||||||
clone to non-clone linking---but only for sharing differences implied by the immediate
|
clone to non-clone linking---but only for sharing differences implied by the immediate
|
||||||
command-line arguments compared against existing package installations.}
|
command-line arguments compared against existing package installations.}
|
||||||
|
|
||||||
|
@item{@DFlag{pull} @nonterm{mode} --- Same as for @command-ref{install}}
|
||||||
|
|
||||||
@item{@DFlag{no-setup} --- Same as for @command-ref{install}.}
|
@item{@DFlag{no-setup} --- Same as for @command-ref{install}.}
|
||||||
@item{@DFlag{jobs} @nonterm{n} or @Flag{j} @nonterm{n} --- Same as for @command-ref{install}.}
|
@item{@DFlag{jobs} @nonterm{n} or @Flag{j} @nonterm{n} --- Same as for @command-ref{install}.}
|
||||||
@item{@DFlag{batch} --- Same as for @command-ref{install}.}
|
@item{@DFlag{batch} --- Same as for @command-ref{install}.}
|
||||||
|
@ -706,7 +725,8 @@ the given @nonterm{pkg-source}s.
|
||||||
added update of enclosing package
|
added update of enclosing package
|
||||||
when no arguments are provided.}
|
when no arguments are provided.}
|
||||||
#:changed "6.1.1.6" @elem{Added the @DFlag{no-trash} flag, and changed
|
#:changed "6.1.1.6" @elem{Added the @DFlag{no-trash} flag, and changed
|
||||||
the @DFlag{deps} default to depend only on interactive mode.}]}
|
the @DFlag{deps} default to depend only on interactive mode.}
|
||||||
|
#:changed "6.1.1.8" @elem{Added the @DFlag{pull} flag.}]}
|
||||||
|
|
||||||
@subcommand{@command/toc{remove} @nonterm{option} ... @nonterm{pkg} ...
|
@subcommand{@command/toc{remove} @nonterm{option} ... @nonterm{pkg} ...
|
||||||
--- Attempts to remove the given packages. By default, if a package is the dependency
|
--- Attempts to remove the given packages. By default, if a package is the dependency
|
||||||
|
|
|
@ -90,6 +90,26 @@
|
||||||
$ (~a "raco pkg update a") =exit> 1
|
$ (~a "raco pkg update a") =exit> 1
|
||||||
$ "racket -l a" =stdout> "3.5\n")
|
$ "racket -l a" =stdout> "3.5\n")
|
||||||
|
|
||||||
|
(shelly-case
|
||||||
|
"failed update can be ignored with `--pull try'"
|
||||||
|
(set-file (build-path clone-dir "a" "main.rkt") "#lang racket/base 3.5")
|
||||||
|
$ (~a "raco pkg update --pull try a") =exit> 0 =stdout> #rx"anyway"
|
||||||
|
$ "racket -l a" =stdout> "3.5\n")
|
||||||
|
|
||||||
|
(shelly-case
|
||||||
|
"rebase mode fails on conflicts"
|
||||||
|
$ (~a "raco pkg update --pull rebase a") =exit> 1
|
||||||
|
$ "racket -l a" =stdout> "3.5\n")
|
||||||
|
|
||||||
|
(shelly-case
|
||||||
|
"rebase succeeds on non-conflifting changes"
|
||||||
|
(set-file (build-path clone-dir "a" "main.rkt") "#lang racket/base 3") ; reverts local change
|
||||||
|
(set-file (build-path clone-dir "a" "more.rkt") "#lang racket/base 30")
|
||||||
|
$ (~a "cd " (build-path clone-dir "a") "; git add .; git commit -m change")
|
||||||
|
$ (~a "raco pkg update --pull rebase a")
|
||||||
|
$ "racket -l a" =stdout> "4\n"
|
||||||
|
$ "racket -l a/more" =stdout> "30\n")
|
||||||
|
|
||||||
(shelly-case
|
(shelly-case
|
||||||
"removal of --clone installation leaves local clone intact"
|
"removal of --clone installation leaves local clone intact"
|
||||||
$ "raco pkg remove a"
|
$ "raco pkg remove a"
|
||||||
|
|
|
@ -115,7 +115,8 @@
|
||||||
#:link-dirs? boolean?
|
#:link-dirs? boolean?
|
||||||
#:infer-clone-from-dir? boolean?
|
#:infer-clone-from-dir? boolean?
|
||||||
#:lookup-for-clone? boolean?
|
#:lookup-for-clone? boolean?
|
||||||
#:multi-clone-behavior (or/c 'fail 'force 'convert 'ask))
|
#:multi-clone-behavior (or/c 'fail 'force 'convert 'ask)
|
||||||
|
#:pull-behavior (or/c 'ff-only 'rebase 'try))
|
||||||
(or/c #f 'skip (listof (or/c path-string? (non-empty-listof path-string?)))))]
|
(or/c #f 'skip (listof (or/c path-string? (non-empty-listof path-string?)))))]
|
||||||
[pkg-remove
|
[pkg-remove
|
||||||
(->* ((listof string?))
|
(->* ((listof string?))
|
||||||
|
@ -151,7 +152,8 @@
|
||||||
#:strip (or/c #f 'source 'binary 'binary-lib)
|
#:strip (or/c #f 'source 'binary 'binary-lib)
|
||||||
#:force-strip? boolean?
|
#:force-strip? boolean?
|
||||||
#:link-dirs? boolean?
|
#:link-dirs? boolean?
|
||||||
#:multi-clone-behavior (or/c 'fail 'force 'convert 'ask))
|
#:multi-clone-behavior (or/c 'fail 'force 'convert 'ask)
|
||||||
|
#:pull-behavior (or/c 'ff-only 'rebase 'try))
|
||||||
(or/c #f 'skip (listof (or/c path-string? (non-empty-listof path-string?)))))]
|
(or/c #f 'skip (listof (or/c path-string? (non-empty-listof path-string?)))))]
|
||||||
[pkg-migrate
|
[pkg-migrate
|
||||||
(->* (string?)
|
(->* (string?)
|
||||||
|
|
|
@ -261,6 +261,7 @@
|
||||||
(if batch
|
(if batch
|
||||||
'fail
|
'fail
|
||||||
'ask))
|
'ask))
|
||||||
|
#:pull-behavior pull
|
||||||
#:link-dirs? link-dirs?
|
#:link-dirs? link-dirs?
|
||||||
#:use-trash? (not no-trash)
|
#:use-trash? (not no-trash)
|
||||||
(for/list ([p (in-list sources)])
|
(for/list ([p (in-list sources)])
|
||||||
|
@ -360,6 +361,7 @@
|
||||||
(if batch
|
(if batch
|
||||||
'fail
|
'fail
|
||||||
'ask))
|
'ask))
|
||||||
|
#:pull-behavior pull
|
||||||
#:link-dirs? link-dirs?
|
#:link-dirs? link-dirs?
|
||||||
#:infer-clone-from-dir? (not (or link static-link copy))
|
#:infer-clone-from-dir? (not (or link static-link copy))
|
||||||
#:use-trash? (not no-trash)))))
|
#:use-trash? (not no-trash)))))
|
||||||
|
@ -684,7 +686,10 @@
|
||||||
#:install-clone-flags
|
#:install-clone-flags
|
||||||
([(#:sym mode [fail force convert ask] #f) multi-clone ()
|
([(#:sym mode [fail force convert ask] #f) multi-clone ()
|
||||||
("Specify treatment of multiple clones of a repository;"
|
("Specify treatment of multiple clones of a repository;"
|
||||||
"<mode>s: convert, ask (interactive default), fail (other default), or force")])
|
"<mode>s: convert, ask (interactive default), fail (other default), or force")]
|
||||||
|
[(#:sym mode [ff-only try rebase] 'ff-only) pull ()
|
||||||
|
("Specify `git pull' mode for repository clonse;"
|
||||||
|
"<mode>s: ff-only (the default), try, or rebase")])
|
||||||
#:update-deps-flags
|
#:update-deps-flags
|
||||||
([#:bool update-deps () "For `search-ask' or `search-auto', also update dependencies"]
|
([#:bool update-deps () "For `search-ask' or `search-auto', also update dependencies"]
|
||||||
[#:bool ignore-implies () "When updating, treat `implies' like other dependencies"])
|
[#:bool ignore-implies () "When updating, treat `implies' like other dependencies"])
|
||||||
|
|
|
@ -37,13 +37,15 @@
|
||||||
pkg-update)
|
pkg-update)
|
||||||
|
|
||||||
(define (checksum-for-pkg-source pkg-source type pkg-name given-checksum download-printf
|
(define (checksum-for-pkg-source pkg-source type pkg-name given-checksum download-printf
|
||||||
#:catalog-lookup-cache [catalog-lookup-cache #f])
|
#:catalog-lookup-cache [catalog-lookup-cache #f]
|
||||||
|
#:remote-checksum-cache [remote-checksum-cache #f])
|
||||||
(case type
|
(case type
|
||||||
[(file-url dir-url github git clone)
|
[(file-url dir-url github git clone)
|
||||||
(or given-checksum
|
(or given-checksum
|
||||||
(remote-package-checksum `(url ,pkg-source) download-printf pkg-name
|
(remote-package-checksum `(url ,pkg-source) download-printf pkg-name
|
||||||
#:type type
|
#:type type
|
||||||
#:catalog-lookup-cache catalog-lookup-cache))]
|
#:catalog-lookup-cache catalog-lookup-cache
|
||||||
|
#:remote-checksum-cache remote-checksum-cache))]
|
||||||
[(file)
|
[(file)
|
||||||
(define checksum-pth (format "~a.CHECKSUM" pkg-source))
|
(define checksum-pth (format "~a.CHECKSUM" pkg-source))
|
||||||
(or (and (file-exists? checksum-pth)
|
(or (and (file-exists? checksum-pth)
|
||||||
|
@ -54,7 +56,8 @@
|
||||||
(or given-checksum
|
(or given-checksum
|
||||||
(remote-package-checksum `(catalog ,pkg-source) download-printf pkg-name
|
(remote-package-checksum `(catalog ,pkg-source) download-printf pkg-name
|
||||||
#:type type
|
#:type type
|
||||||
#:catalog-lookup-cache catalog-lookup-cache))]
|
#:catalog-lookup-cache catalog-lookup-cache
|
||||||
|
#:remote-checksum-cache remote-checksum-cache))]
|
||||||
[else given-checksum]))
|
[else given-checksum]))
|
||||||
|
|
||||||
(define (disallow-package-path-overlaps pkg-name
|
(define (disallow-package-path-overlaps pkg-name
|
||||||
|
@ -128,6 +131,7 @@
|
||||||
#:update-implies? update-implies?
|
#:update-implies? update-implies?
|
||||||
#:update-cache update-cache
|
#:update-cache update-cache
|
||||||
#:catalog-lookup-cache catalog-lookup-cache
|
#:catalog-lookup-cache catalog-lookup-cache
|
||||||
|
#:remote-checksum-cache remote-checksum-cache
|
||||||
#:updating? updating-all?
|
#:updating? updating-all?
|
||||||
#:extra-updating extra-updating
|
#:extra-updating extra-updating
|
||||||
#:ignore-checksums? ignore-checksums?
|
#:ignore-checksums? ignore-checksums?
|
||||||
|
@ -145,6 +149,7 @@
|
||||||
#:local-docs-ok? local-docs-ok?
|
#:local-docs-ok? local-docs-ok?
|
||||||
#:ai-cache ai-cache
|
#:ai-cache ai-cache
|
||||||
#:clone-info clone-info
|
#:clone-info clone-info
|
||||||
|
#:pull-behavior pull-behavior
|
||||||
descs)
|
descs)
|
||||||
(define download-printf (if quiet? void printf/flush))
|
(define download-printf (if quiet? void printf/flush))
|
||||||
(define check-sums? (not ignore-checksums?))
|
(define check-sums? (not ignore-checksums?))
|
||||||
|
@ -216,7 +221,7 @@
|
||||||
(cons
|
(cons
|
||||||
#f ; no repo change
|
#f ; no repo change
|
||||||
;; The `do-it` thunk:
|
;; The `do-it` thunk:
|
||||||
(lambda ()
|
(lambda (fail-repos)
|
||||||
(unless quiet?
|
(unless quiet?
|
||||||
(download-printf "Promoting ~a from auto-installed to explicitly installed\n" pkg-name))
|
(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))))]
|
||||||
|
@ -413,6 +418,7 @@
|
||||||
#:update-cache update-cache
|
#:update-cache update-cache
|
||||||
#:namespace metadata-ns
|
#:namespace metadata-ns
|
||||||
#:catalog-lookup-cache catalog-lookup-cache
|
#:catalog-lookup-cache catalog-lookup-cache
|
||||||
|
#:remote-checksum-cache remote-checksum-cache
|
||||||
#:all-platforms? all-platforms?
|
#:all-platforms? all-platforms?
|
||||||
#:ignore-checksums? ignore-checksums?
|
#:ignore-checksums? ignore-checksums?
|
||||||
#:use-cache? use-cache?
|
#:use-cache? use-cache?
|
||||||
|
@ -522,6 +528,7 @@
|
||||||
#:update-cache update-cache
|
#:update-cache update-cache
|
||||||
#:namespace metadata-ns
|
#:namespace metadata-ns
|
||||||
#:catalog-lookup-cache catalog-lookup-cache
|
#:catalog-lookup-cache catalog-lookup-cache
|
||||||
|
#:remote-checksum-cache remote-checksum-cache
|
||||||
#:all-platforms? all-platforms?
|
#:all-platforms? all-platforms?
|
||||||
#:ignore-checksums? ignore-checksums?
|
#:ignore-checksums? ignore-checksums?
|
||||||
#:use-cache? use-cache?
|
#:use-cache? use-cache?
|
||||||
|
@ -552,13 +559,14 @@
|
||||||
(clean!)
|
(clean!)
|
||||||
(report-mismatch update-deps)])]))]
|
(report-mismatch update-deps)])]))]
|
||||||
[else
|
[else
|
||||||
|
(define repo (and git-dir
|
||||||
|
(enclosing-path-for-repo (caddr orig-pkg) git-dir)))
|
||||||
(cons
|
(cons
|
||||||
;; The repo to get new commits, if any:
|
;; The repo to get new commits, if any:
|
||||||
(and git-dir
|
(and repo (list repo
|
||||||
(list (enclosing-path-for-repo (caddr orig-pkg) git-dir)
|
|
||||||
checksum))
|
checksum))
|
||||||
;; The "do-it" function (see `repos+do-its` below):
|
;; The "do-it" function (see `repos+do-its` below):
|
||||||
(λ ()
|
(λ (fail-repos)
|
||||||
(when updating?
|
(when updating?
|
||||||
(download-printf "Re-installing ~a\n" pkg-name))
|
(download-printf "Re-installing ~a\n" pkg-name))
|
||||||
(define final-pkg-dir
|
(define final-pkg-dir
|
||||||
|
@ -595,8 +603,14 @@
|
||||||
(and (path? name)
|
(and (path? name)
|
||||||
(regexp-match? #rx"[+]" name)
|
(regexp-match? #rx"[+]" name)
|
||||||
(path->string name))))
|
(path->string name))))
|
||||||
|
(define new-checksum
|
||||||
|
(if (hash-ref fail-repos repo #f)
|
||||||
|
;; Failed `git pull` => record checksum as #f, because we've lost track
|
||||||
|
;; of the state of this package:
|
||||||
|
#f
|
||||||
|
checksum))
|
||||||
(define this-pkg-info
|
(define this-pkg-info
|
||||||
(make-pkg-info orig-pkg checksum auto? single-collect alt-dir-name))
|
(make-pkg-info orig-pkg new-checksum auto? single-collect alt-dir-name))
|
||||||
(log-pkg-debug "updating db with ~e to ~e" pkg-name this-pkg-info)
|
(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 metadata-ns (make-metadata-namespace))
|
||||||
|
@ -609,6 +623,7 @@
|
||||||
check-sums? download-printf
|
check-sums? download-printf
|
||||||
metadata-ns
|
metadata-ns
|
||||||
#:catalog-lookup-cache catalog-lookup-cache
|
#:catalog-lookup-cache catalog-lookup-cache
|
||||||
|
#:remote-checksum-cache remote-checksum-cache
|
||||||
#:strip strip-mode
|
#:strip strip-mode
|
||||||
#:force-strip? force-strip?
|
#:force-strip? force-strip?
|
||||||
#:link-dirs? link-dirs?)))
|
#:link-dirs? link-dirs?)))
|
||||||
|
@ -653,7 +668,8 @@
|
||||||
;; to check them out; if a checkout fails, then we've left the
|
;; to check them out; if a checkout fails, then we've left the
|
||||||
;; package installation in no worse shape than if a manual `git
|
;; package installation in no worse shape than if a manual `git
|
||||||
;; pull` failed
|
;; pull` failed
|
||||||
(for ([(git-dir checksums) (in-hash repos)])
|
(define fail-repos
|
||||||
|
(for/fold ([fail-repos #hash()]) ([(git-dir checksums) (in-hash repos)])
|
||||||
(parameterize ([current-directory git-dir])
|
(parameterize ([current-directory git-dir])
|
||||||
(download-printf "Merging commits at ~a\n"
|
(download-printf "Merging commits at ~a\n"
|
||||||
git-dir)
|
git-dir)
|
||||||
|
@ -662,16 +678,40 @@
|
||||||
" " git-dir "\n"
|
" " git-dir "\n"
|
||||||
" have different target commits; will try each commit, which will work\n"
|
" have different target commits; will try each commit, which will work\n"
|
||||||
" as long as some commit is a fast-forward of all of them\n")))
|
" as long as some commit is a fast-forward of all of them\n")))
|
||||||
(for ([checksum (in-list checksums)])
|
(for/fold ([fail-repos fail-repos]) ([checksum (in-list checksums)])
|
||||||
|
(define rebase? (eq? pull-behavior 'rebase))
|
||||||
|
(define ok?
|
||||||
(git #:status (lambda (s) (download-printf "~a\n" s))
|
(git #:status (lambda (s) (download-printf "~a\n" s))
|
||||||
"merge" "--ff-only" checksum))))
|
#:fail-mode 'status
|
||||||
|
(if rebase? "rebase" "merge")
|
||||||
|
(if rebase? "--onto" "--ff-only")
|
||||||
|
checksum))
|
||||||
|
(cond
|
||||||
|
[ok? fail-repos]
|
||||||
|
[else
|
||||||
|
(case pull-behavior
|
||||||
|
[(try)
|
||||||
|
(download-printf (~a "Pulling commits failed, but continuing anyway~a\n")
|
||||||
|
(if from-command-line?
|
||||||
|
" due to `--pull try'"
|
||||||
|
""))
|
||||||
|
(hash-set fail-repos git-dir #t)]
|
||||||
|
[else
|
||||||
|
(pkg-error (~a "pulling commits to clone failed~a\n"
|
||||||
|
" clone: ~a\n"
|
||||||
|
" target commit: ~a")
|
||||||
|
(if from-command-line?
|
||||||
|
";\n fix clone manually or use `--pull try' or `--pull rebase'"
|
||||||
|
"")
|
||||||
|
git-dir
|
||||||
|
checksum)])])))))
|
||||||
|
|
||||||
;; pre-succeed removes packages that are being updated
|
;; pre-succeed removes packages that are being updated
|
||||||
(pre-succeed)
|
(pre-succeed)
|
||||||
|
|
||||||
(define post-metadata-ns (make-metadata-namespace))
|
(define post-metadata-ns (make-metadata-namespace))
|
||||||
;; moves packages into place and installs links:
|
;; moves packages into place and installs links:
|
||||||
(for-each (λ (t) ((cdr t))) repo+do-its)
|
(for-each (λ (t) ((cdr t) fail-repos)) repo+do-its)
|
||||||
|
|
||||||
(define (is-promote? info)
|
(define (is-promote? info)
|
||||||
;; if the package name is in `current-scope-db', we must
|
;; if the package name is in `current-scope-db', we must
|
||||||
|
@ -776,6 +816,7 @@
|
||||||
#:update-implies? [update-implies? #t]
|
#:update-implies? [update-implies? #t]
|
||||||
#:update-cache [update-cache (make-hash)]
|
#:update-cache [update-cache (make-hash)]
|
||||||
#:catalog-lookup-cache [catalog-lookup-cache (make-hash)]
|
#:catalog-lookup-cache [catalog-lookup-cache (make-hash)]
|
||||||
|
#:remote-checksum-cache [remote-checksum-cache (make-hash)]
|
||||||
#:updating? [updating? #f]
|
#:updating? [updating? #f]
|
||||||
#:quiet? [quiet? #f]
|
#:quiet? [quiet? #f]
|
||||||
#:use-trash? [use-trash? #f]
|
#:use-trash? [use-trash? #f]
|
||||||
|
@ -789,6 +830,7 @@
|
||||||
#:repo-descs [old-repo-descs (initial-repo-descs
|
#:repo-descs [old-repo-descs (initial-repo-descs
|
||||||
(read-pkg-db)
|
(read-pkg-db)
|
||||||
(if quiet? void printf/flush))]
|
(if quiet? void printf/flush))]
|
||||||
|
#:pull-behavior [pull-behavior 'ff-only]
|
||||||
#:convert-to-non-clone? [convert-to-non-clone? #f])
|
#:convert-to-non-clone? [convert-to-non-clone? #f])
|
||||||
(define download-printf (if quiet? void printf/flush))
|
(define download-printf (if quiet? void printf/flush))
|
||||||
|
|
||||||
|
@ -834,6 +876,7 @@
|
||||||
#:update-implies? update-implies?
|
#:update-implies? update-implies?
|
||||||
#:update-cache update-cache
|
#:update-cache update-cache
|
||||||
#:catalog-lookup-cache catalog-lookup-cache
|
#:catalog-lookup-cache catalog-lookup-cache
|
||||||
|
#:remote-checksum-cache remote-checksum-cache
|
||||||
#:pre-succeed (lambda () (pre-succeed) (more-pre-succeed))
|
#:pre-succeed (lambda () (pre-succeed) (more-pre-succeed))
|
||||||
#:updating? updating?
|
#:updating? updating?
|
||||||
#:quiet? quiet?
|
#:quiet? quiet?
|
||||||
|
@ -844,6 +887,7 @@
|
||||||
#:force-strip? force-strip?
|
#:force-strip? force-strip?
|
||||||
#:multi-clone-behavior (vector-ref clone-info 0)
|
#:multi-clone-behavior (vector-ref clone-info 0)
|
||||||
#:repo-descs (vector-ref clone-info 1)
|
#:repo-descs (vector-ref clone-info 1)
|
||||||
|
#:pull-behavior pull-behavior
|
||||||
(for/list ([dep (in-list deps)])
|
(for/list ([dep (in-list deps)])
|
||||||
(if (pkg-desc? dep)
|
(if (pkg-desc? dep)
|
||||||
dep
|
dep
|
||||||
|
@ -862,6 +906,7 @@
|
||||||
#:update-implies? update-implies?
|
#:update-implies? update-implies?
|
||||||
#:update-cache update-cache
|
#:update-cache update-cache
|
||||||
#:catalog-lookup-cache catalog-lookup-cache
|
#:catalog-lookup-cache catalog-lookup-cache
|
||||||
|
#:remote-checksum-cache remote-checksum-cache
|
||||||
#:pre-succeed (λ ()
|
#:pre-succeed (λ ()
|
||||||
(for ([pkg-name (in-hash-keys extra-updating)])
|
(for ([pkg-name (in-hash-keys extra-updating)])
|
||||||
((remove-package #t quiet? use-trash?) pkg-name))
|
((remove-package #t quiet? use-trash?) pkg-name))
|
||||||
|
@ -879,6 +924,7 @@
|
||||||
#:ai-cache (box #f)
|
#:ai-cache (box #f)
|
||||||
#:clone-info (vector clone-behavior
|
#:clone-info (vector clone-behavior
|
||||||
repo-descs)
|
repo-descs)
|
||||||
|
#:pull-behavior pull-behavior
|
||||||
new-descs)
|
new-descs)
|
||||||
(unless (empty? summary-deps)
|
(unless (empty? summary-deps)
|
||||||
(unless quiet?
|
(unless quiet?
|
||||||
|
@ -913,6 +959,7 @@
|
||||||
#:implies? implies?
|
#:implies? implies?
|
||||||
#:namespace metadata-ns
|
#:namespace metadata-ns
|
||||||
#:catalog-lookup-cache catalog-lookup-cache
|
#:catalog-lookup-cache catalog-lookup-cache
|
||||||
|
#:remote-checksum-cache remote-checksum-cache
|
||||||
#:update-cache update-cache
|
#:update-cache update-cache
|
||||||
#:all-platforms? all-platforms?
|
#:all-platforms? all-platforms?
|
||||||
#:ignore-checksums? ignore-checksums?
|
#:ignore-checksums? ignore-checksums?
|
||||||
|
@ -944,7 +991,8 @@
|
||||||
name
|
name
|
||||||
(pkg-desc-checksum pkg-name)
|
(pkg-desc-checksum pkg-name)
|
||||||
download-printf
|
download-printf
|
||||||
#:catalog-lookup-cache catalog-lookup-cache))
|
#:catalog-lookup-cache catalog-lookup-cache
|
||||||
|
#:remote-checksum-cache remote-checksum-cache))
|
||||||
(hash-set! update-cache name new-checksum) ; record downloaded checksum
|
(hash-set! update-cache name new-checksum) ; record downloaded checksum
|
||||||
(unless (or ignore-checksums? (not (pkg-desc-checksum pkg-name)))
|
(unless (or ignore-checksums? (not (pkg-desc-checksum pkg-name)))
|
||||||
(unless (equal? (pkg-desc-checksum pkg-name) new-checksum)
|
(unless (equal? (pkg-desc-checksum pkg-name) new-checksum)
|
||||||
|
@ -1077,7 +1125,8 @@
|
||||||
(hash-ref update-cache pkg-name
|
(hash-ref update-cache pkg-name
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(remote-package-checksum orig-pkg download-printf pkg-name
|
(remote-package-checksum orig-pkg download-printf pkg-name
|
||||||
#:catalog-lookup-cache catalog-lookup-cache))))
|
#:catalog-lookup-cache catalog-lookup-cache
|
||||||
|
#:remote-checksum-cache remote-checksum-cache))))
|
||||||
;; Record downloaded checksum:
|
;; Record downloaded checksum:
|
||||||
(hash-set! update-cache pkg-name new-checksum)
|
(hash-set! update-cache pkg-name new-checksum)
|
||||||
(or (and new-checksum
|
(or (and new-checksum
|
||||||
|
@ -1112,7 +1161,8 @@
|
||||||
#:link-dirs? [link-dirs? #f]
|
#:link-dirs? [link-dirs? #f]
|
||||||
#:infer-clone-from-dir? [infer-clone-from-dir? #f]
|
#:infer-clone-from-dir? [infer-clone-from-dir? #f]
|
||||||
#:lookup-for-clone? [lookup-for-clone? #f]
|
#:lookup-for-clone? [lookup-for-clone? #f]
|
||||||
#:multi-clone-behavior [clone-behavior 'fail])
|
#:multi-clone-behavior [clone-behavior 'fail]
|
||||||
|
#:pull-behavior [pull-behavior 'ff-only])
|
||||||
(define download-printf (if quiet? void printf/flush))
|
(define download-printf (if quiet? void printf/flush))
|
||||||
(define metadata-ns (make-metadata-namespace))
|
(define metadata-ns (make-metadata-namespace))
|
||||||
(define db (read-pkg-db))
|
(define db (read-pkg-db))
|
||||||
|
@ -1122,6 +1172,7 @@
|
||||||
[else in-pkgs]))
|
[else in-pkgs]))
|
||||||
(define update-cache (make-hash))
|
(define update-cache (make-hash))
|
||||||
(define catalog-lookup-cache (make-hash))
|
(define catalog-lookup-cache (make-hash))
|
||||||
|
(define remote-checksum-cache (make-hash))
|
||||||
(define to-updat* (append-map (packages-to-update download-printf db
|
(define to-updat* (append-map (packages-to-update download-printf db
|
||||||
#:must-update? (and (not all-mode?)
|
#:must-update? (and (not all-mode?)
|
||||||
(not update-deps?))
|
(not update-deps?))
|
||||||
|
@ -1131,6 +1182,7 @@
|
||||||
#:update-cache update-cache
|
#:update-cache update-cache
|
||||||
#:namespace metadata-ns
|
#:namespace metadata-ns
|
||||||
#:catalog-lookup-cache catalog-lookup-cache
|
#:catalog-lookup-cache catalog-lookup-cache
|
||||||
|
#:remote-checksum-cache remote-checksum-cache
|
||||||
#:all-platforms? all-platforms?
|
#:all-platforms? all-platforms?
|
||||||
#:ignore-checksums? ignore-checksums?
|
#:ignore-checksums? ignore-checksums?
|
||||||
#:use-cache? use-cache?
|
#:use-cache? use-cache?
|
||||||
|
@ -1195,6 +1247,7 @@
|
||||||
#:update-implies? update-implies?
|
#:update-implies? update-implies?
|
||||||
#:update-cache update-cache
|
#:update-cache update-cache
|
||||||
#:catalog-lookup-cache catalog-lookup-cache
|
#:catalog-lookup-cache catalog-lookup-cache
|
||||||
|
#:remote-checksum-cache remote-checksum-cache
|
||||||
#:quiet? quiet?
|
#:quiet? quiet?
|
||||||
#:use-trash? use-trash?
|
#:use-trash? use-trash?
|
||||||
#:from-command-line? from-command-line?
|
#:from-command-line? from-command-line?
|
||||||
|
@ -1210,6 +1263,7 @@
|
||||||
#:convert-to-non-clone? (and lookup-for-clone?
|
#:convert-to-non-clone? (and lookup-for-clone?
|
||||||
(andmap pkg-desc? in-pkgs)
|
(andmap pkg-desc? in-pkgs)
|
||||||
(not (ormap pkg-desc-extra-path in-pkgs)))
|
(not (ormap pkg-desc-extra-path in-pkgs)))
|
||||||
|
#:pull-behavior pull-behavior
|
||||||
to-update)]))
|
to-update)]))
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
|
|
|
@ -42,7 +42,14 @@
|
||||||
|
|
||||||
(define (remote-package-checksum pkg download-printf pkg-name
|
(define (remote-package-checksum pkg download-printf pkg-name
|
||||||
#:type [type #f]
|
#:type [type #f]
|
||||||
#:catalog-lookup-cache [catalog-lookup-cache #f])
|
#:catalog-lookup-cache [catalog-lookup-cache #f]
|
||||||
|
#:remote-checksum-cache [remote-checksum-cache #f])
|
||||||
|
(cond
|
||||||
|
[(and remote-checksum-cache
|
||||||
|
(hash-ref remote-checksum-cache pkg #f))
|
||||||
|
=> (lambda (checksum) checksum)]
|
||||||
|
[else
|
||||||
|
(define checksum
|
||||||
(match pkg
|
(match pkg
|
||||||
[`(catalog ,pkg-name . ,_)
|
[`(catalog ,pkg-name . ,_)
|
||||||
(hash-ref (package-catalog-lookup pkg-name #f catalog-lookup-cache
|
(hash-ref (package-catalog-lookup pkg-name #f catalog-lookup-cache
|
||||||
|
@ -58,6 +65,9 @@
|
||||||
#:type 'clone
|
#:type 'clone
|
||||||
#:download-printf download-printf
|
#:download-printf download-printf
|
||||||
#:pkg-name pkg-name)]))
|
#:pkg-name pkg-name)]))
|
||||||
|
(when remote-checksum-cache
|
||||||
|
(hash-set! remote-checksum-cache pkg checksum))
|
||||||
|
checksum]))
|
||||||
|
|
||||||
;; Downloads a package (if needed) and unpacks it (if needed) into a
|
;; Downloads a package (if needed) and unpacks it (if needed) into a
|
||||||
;; temporary directory.
|
;; temporary directory.
|
||||||
|
@ -72,6 +82,7 @@
|
||||||
download-printf
|
download-printf
|
||||||
metadata-ns
|
metadata-ns
|
||||||
#:catalog-lookup-cache [catalog-lookup-cache #f]
|
#:catalog-lookup-cache [catalog-lookup-cache #f]
|
||||||
|
#:remote-checksum-cache [remote-checksum-cache #f]
|
||||||
#:strip [strip-mode #f]
|
#:strip [strip-mode #f]
|
||||||
#:force-strip? [force-strip? #f]
|
#:force-strip? [force-strip? #f]
|
||||||
#:in-place? [in-place? #f]
|
#:in-place? [in-place? #f]
|
||||||
|
@ -124,7 +135,9 @@
|
||||||
|
|
||||||
(define checksum
|
(define checksum
|
||||||
(or given-checksum
|
(or given-checksum
|
||||||
(remote-package-checksum orig-pkg download-printf pkg-name)))
|
(remote-package-checksum orig-pkg download-printf pkg-name
|
||||||
|
#:catalog-lookup-cache catalog-lookup-cache
|
||||||
|
#:remote-checksum-cache remote-checksum-cache)))
|
||||||
|
|
||||||
;; If the clone directory already exists, and if it already has
|
;; If the clone directory already exists, and if it already has
|
||||||
;; the target commit, then we use that directory. It may have
|
;; the target commit, then we use that directory. It may have
|
||||||
|
@ -225,7 +238,9 @@
|
||||||
;; then check whether it matches the expected one, but we choose
|
;; then check whether it matches the expected one, but we choose
|
||||||
;; to avoid an extra trip to the server.
|
;; to avoid an extra trip to the server.
|
||||||
(or given-checksum
|
(or given-checksum
|
||||||
(remote-package-checksum orig-pkg download-printf pkg-name)))
|
(remote-package-checksum orig-pkg download-printf pkg-name
|
||||||
|
#:catalog-lookup-cache catalog-lookup-cache
|
||||||
|
#:remote-checksum-cache remote-checksum-cache)))
|
||||||
(when check-sums?
|
(when check-sums?
|
||||||
(check-checksum given-checksum found-checksum "unexpected" pkg #f))
|
(check-checksum given-checksum found-checksum "unexpected" pkg #f))
|
||||||
(define checksum (or found-checksum given-checksum))
|
(define checksum (or found-checksum given-checksum))
|
||||||
|
@ -608,6 +623,7 @@
|
||||||
download-printf
|
download-printf
|
||||||
metadata-ns
|
metadata-ns
|
||||||
#:catalog-lookup-cache catalog-lookup-cache
|
#:catalog-lookup-cache catalog-lookup-cache
|
||||||
|
#:remote-checksum-cache remote-checksum-cache
|
||||||
#:strip strip-mode
|
#:strip strip-mode
|
||||||
#:force-strip? force-strip?))
|
#:force-strip? force-strip?))
|
||||||
(when check-sums?
|
(when check-sums?
|
||||||
|
|
Loading…
Reference in New Issue
Block a user