raco pkg {install,update}: add --pull option
This commit is contained in:
Matthew Flatt
parent
51d38152d4
commit
8aa16faa6d
|
|
@ -134,10 +134,14 @@ ways:
|
|||
|
||||
@item{When pulling changes to repositories that have local copies,
|
||||
@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
|
||||
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
|
||||
changes to the package made locally, but it implies that the
|
||||
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]
|
||||
[#:force-strip? force-string? boolean? #f]
|
||||
[#: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])
|
||||
(or/c 'skip
|
||||
#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]
|
||||
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?))]
|
||||
|
|
@ -305,6 +307,7 @@ The package lock must be held; see @racket[with-pkg-lock].
|
|||
[#:force-strip? force-string? boolean? #f]
|
||||
[#:lookup-for-clone? lookup-for-clone? boolean? #f]
|
||||
[#: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]
|
||||
[#:infer-clone-from-dir? infer-clone-from-dir? boolean? #f])
|
||||
(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]
|
||||
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?)]
|
||||
|
|
|
|||
|
|
@ -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
|
||||
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
|
||||
@DFlag{multi-clone} flags.}
|
||||
#: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} ...
|
||||
|
|
@ -695,6 +712,8 @@ the given @nonterm{pkg-source}s.
|
|||
clone to non-clone linking---but only for sharing differences implied by the immediate
|
||||
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{jobs} @nonterm{n} or @Flag{j} @nonterm{n} --- 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
|
||||
when no arguments are provided.}
|
||||
#: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} ...
|
||||
--- 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
|
||||
$ "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
|
||||
"removal of --clone installation leaves local clone intact"
|
||||
$ "raco pkg remove a"
|
||||
|
|
|
|||
|
|
@ -115,7 +115,8 @@
|
|||
#:link-dirs? boolean?
|
||||
#:infer-clone-from-dir? 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?)))))]
|
||||
[pkg-remove
|
||||
(->* ((listof string?))
|
||||
|
|
@ -151,7 +152,8 @@
|
|||
#:strip (or/c #f 'source 'binary 'binary-lib)
|
||||
#:force-strip? 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?)))))]
|
||||
[pkg-migrate
|
||||
(->* (string?)
|
||||
|
|
|
|||
|
|
@ -261,6 +261,7 @@
|
|||
(if batch
|
||||
'fail
|
||||
'ask))
|
||||
#:pull-behavior pull
|
||||
#:link-dirs? link-dirs?
|
||||
#:use-trash? (not no-trash)
|
||||
(for/list ([p (in-list sources)])
|
||||
|
|
@ -360,6 +361,7 @@
|
|||
(if batch
|
||||
'fail
|
||||
'ask))
|
||||
#:pull-behavior pull
|
||||
#:link-dirs? link-dirs?
|
||||
#:infer-clone-from-dir? (not (or link static-link copy))
|
||||
#:use-trash? (not no-trash)))))
|
||||
|
|
@ -684,7 +686,10 @@
|
|||
#:install-clone-flags
|
||||
([(#:sym mode [fail force convert ask] #f) multi-clone ()
|
||||
("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
|
||||
([#:bool update-deps () "For `search-ask' or `search-auto', also update dependencies"]
|
||||
[#:bool ignore-implies () "When updating, treat `implies' like other dependencies"])
|
||||
|
|
|
|||
|
|
@ -37,13 +37,15 @@
|
|||
pkg-update)
|
||||
|
||||
(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
|
||||
[(file-url dir-url github git clone)
|
||||
(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
|
||||
#:catalog-lookup-cache catalog-lookup-cache))]
|
||||
#:catalog-lookup-cache catalog-lookup-cache
|
||||
#:remote-checksum-cache remote-checksum-cache))]
|
||||
[(file)
|
||||
(define checksum-pth (format "~a.CHECKSUM" pkg-source))
|
||||
(or (and (file-exists? checksum-pth)
|
||||
|
|
@ -54,7 +56,8 @@
|
|||
(or given-checksum
|
||||
(remote-package-checksum `(catalog ,pkg-source) download-printf pkg-name
|
||||
#:type type
|
||||
#:catalog-lookup-cache catalog-lookup-cache))]
|
||||
#:catalog-lookup-cache catalog-lookup-cache
|
||||
#:remote-checksum-cache remote-checksum-cache))]
|
||||
[else given-checksum]))
|
||||
|
||||
(define (disallow-package-path-overlaps pkg-name
|
||||
|
|
@ -128,6 +131,7 @@
|
|||
#:update-implies? update-implies?
|
||||
#:update-cache update-cache
|
||||
#:catalog-lookup-cache catalog-lookup-cache
|
||||
#:remote-checksum-cache remote-checksum-cache
|
||||
#:updating? updating-all?
|
||||
#:extra-updating extra-updating
|
||||
#:ignore-checksums? ignore-checksums?
|
||||
|
|
@ -145,6 +149,7 @@
|
|||
#:local-docs-ok? local-docs-ok?
|
||||
#:ai-cache ai-cache
|
||||
#:clone-info clone-info
|
||||
#:pull-behavior pull-behavior
|
||||
descs)
|
||||
(define download-printf (if quiet? void printf/flush))
|
||||
(define check-sums? (not ignore-checksums?))
|
||||
|
|
@ -216,7 +221,7 @@
|
|||
(cons
|
||||
#f ; no repo change
|
||||
;; The `do-it` thunk:
|
||||
(lambda ()
|
||||
(lambda (fail-repos)
|
||||
(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))))]
|
||||
|
|
@ -413,6 +418,7 @@
|
|||
#:update-cache update-cache
|
||||
#:namespace metadata-ns
|
||||
#:catalog-lookup-cache catalog-lookup-cache
|
||||
#:remote-checksum-cache remote-checksum-cache
|
||||
#:all-platforms? all-platforms?
|
||||
#:ignore-checksums? ignore-checksums?
|
||||
#:use-cache? use-cache?
|
||||
|
|
@ -522,6 +528,7 @@
|
|||
#:update-cache update-cache
|
||||
#:namespace metadata-ns
|
||||
#:catalog-lookup-cache catalog-lookup-cache
|
||||
#:remote-checksum-cache remote-checksum-cache
|
||||
#:all-platforms? all-platforms?
|
||||
#:ignore-checksums? ignore-checksums?
|
||||
#:use-cache? use-cache?
|
||||
|
|
@ -552,13 +559,14 @@
|
|||
(clean!)
|
||||
(report-mismatch update-deps)])]))]
|
||||
[else
|
||||
(define repo (and git-dir
|
||||
(enclosing-path-for-repo (caddr orig-pkg) git-dir)))
|
||||
(cons
|
||||
;; The repo to get new commits, if any:
|
||||
(and git-dir
|
||||
(list (enclosing-path-for-repo (caddr orig-pkg) git-dir)
|
||||
checksum))
|
||||
(and repo (list repo
|
||||
checksum))
|
||||
;; The "do-it" function (see `repos+do-its` below):
|
||||
(λ ()
|
||||
(λ (fail-repos)
|
||||
(when updating?
|
||||
(download-printf "Re-installing ~a\n" pkg-name))
|
||||
(define final-pkg-dir
|
||||
|
|
@ -595,8 +603,14 @@
|
|||
(and (path? name)
|
||||
(regexp-match? #rx"[+]" 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
|
||||
(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)
|
||||
(update-pkg-db! pkg-name this-pkg-info)))]))
|
||||
(define metadata-ns (make-metadata-namespace))
|
||||
|
|
@ -609,6 +623,7 @@
|
|||
check-sums? download-printf
|
||||
metadata-ns
|
||||
#:catalog-lookup-cache catalog-lookup-cache
|
||||
#:remote-checksum-cache remote-checksum-cache
|
||||
#:strip strip-mode
|
||||
#:force-strip? force-strip?
|
||||
#:link-dirs? link-dirs?)))
|
||||
|
|
@ -653,25 +668,50 @@
|
|||
;; 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 checksums) (in-hash repos)])
|
||||
(parameterize ([current-directory git-dir])
|
||||
(download-printf "Merging commits at ~a\n"
|
||||
git-dir)
|
||||
(when ((length checksums) . > . 1)
|
||||
(download-printf (~a "Multiple packages in the of the clone\n"
|
||||
" " git-dir "\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")))
|
||||
(for ([checksum (in-list checksums)])
|
||||
(git #:status (lambda (s) (download-printf "~a\n" s))
|
||||
"merge" "--ff-only" checksum))))
|
||||
(define fail-repos
|
||||
(for/fold ([fail-repos #hash()]) ([(git-dir checksums) (in-hash repos)])
|
||||
(parameterize ([current-directory git-dir])
|
||||
(download-printf "Merging commits at ~a\n"
|
||||
git-dir)
|
||||
(when ((length checksums) . > . 1)
|
||||
(download-printf (~a "Multiple packages in the of the clone\n"
|
||||
" " git-dir "\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")))
|
||||
(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))
|
||||
#: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)
|
||||
|
||||
(define post-metadata-ns (make-metadata-namespace))
|
||||
;; 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)
|
||||
;; if the package name is in `current-scope-db', we must
|
||||
|
|
@ -776,6 +816,7 @@
|
|||
#:update-implies? [update-implies? #t]
|
||||
#:update-cache [update-cache (make-hash)]
|
||||
#:catalog-lookup-cache [catalog-lookup-cache (make-hash)]
|
||||
#:remote-checksum-cache [remote-checksum-cache (make-hash)]
|
||||
#:updating? [updating? #f]
|
||||
#:quiet? [quiet? #f]
|
||||
#:use-trash? [use-trash? #f]
|
||||
|
|
@ -789,6 +830,7 @@
|
|||
#:repo-descs [old-repo-descs (initial-repo-descs
|
||||
(read-pkg-db)
|
||||
(if quiet? void printf/flush))]
|
||||
#:pull-behavior [pull-behavior 'ff-only]
|
||||
#:convert-to-non-clone? [convert-to-non-clone? #f])
|
||||
(define download-printf (if quiet? void printf/flush))
|
||||
|
||||
|
|
@ -834,6 +876,7 @@
|
|||
#:update-implies? update-implies?
|
||||
#:update-cache update-cache
|
||||
#:catalog-lookup-cache catalog-lookup-cache
|
||||
#:remote-checksum-cache remote-checksum-cache
|
||||
#:pre-succeed (lambda () (pre-succeed) (more-pre-succeed))
|
||||
#:updating? updating?
|
||||
#:quiet? quiet?
|
||||
|
|
@ -844,6 +887,7 @@
|
|||
#:force-strip? force-strip?
|
||||
#:multi-clone-behavior (vector-ref clone-info 0)
|
||||
#:repo-descs (vector-ref clone-info 1)
|
||||
#:pull-behavior pull-behavior
|
||||
(for/list ([dep (in-list deps)])
|
||||
(if (pkg-desc? dep)
|
||||
dep
|
||||
|
|
@ -862,6 +906,7 @@
|
|||
#:update-implies? update-implies?
|
||||
#:update-cache update-cache
|
||||
#:catalog-lookup-cache catalog-lookup-cache
|
||||
#:remote-checksum-cache remote-checksum-cache
|
||||
#:pre-succeed (λ ()
|
||||
(for ([pkg-name (in-hash-keys extra-updating)])
|
||||
((remove-package #t quiet? use-trash?) pkg-name))
|
||||
|
|
@ -879,6 +924,7 @@
|
|||
#:ai-cache (box #f)
|
||||
#:clone-info (vector clone-behavior
|
||||
repo-descs)
|
||||
#:pull-behavior pull-behavior
|
||||
new-descs)
|
||||
(unless (empty? summary-deps)
|
||||
(unless quiet?
|
||||
|
|
@ -913,6 +959,7 @@
|
|||
#:implies? implies?
|
||||
#:namespace metadata-ns
|
||||
#:catalog-lookup-cache catalog-lookup-cache
|
||||
#:remote-checksum-cache remote-checksum-cache
|
||||
#:update-cache update-cache
|
||||
#:all-platforms? all-platforms?
|
||||
#:ignore-checksums? ignore-checksums?
|
||||
|
|
@ -944,7 +991,8 @@
|
|||
name
|
||||
(pkg-desc-checksum pkg-name)
|
||||
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
|
||||
(unless (or ignore-checksums? (not (pkg-desc-checksum pkg-name)))
|
||||
(unless (equal? (pkg-desc-checksum pkg-name) new-checksum)
|
||||
|
|
@ -1077,7 +1125,8 @@
|
|||
(hash-ref update-cache pkg-name
|
||||
(lambda ()
|
||||
(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:
|
||||
(hash-set! update-cache pkg-name new-checksum)
|
||||
(or (and new-checksum
|
||||
|
|
@ -1112,7 +1161,8 @@
|
|||
#:link-dirs? [link-dirs? #f]
|
||||
#:infer-clone-from-dir? [infer-clone-from-dir? #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 metadata-ns (make-metadata-namespace))
|
||||
(define db (read-pkg-db))
|
||||
|
|
@ -1122,6 +1172,7 @@
|
|||
[else in-pkgs]))
|
||||
(define update-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
|
||||
#:must-update? (and (not all-mode?)
|
||||
(not update-deps?))
|
||||
|
|
@ -1131,6 +1182,7 @@
|
|||
#:update-cache update-cache
|
||||
#:namespace metadata-ns
|
||||
#:catalog-lookup-cache catalog-lookup-cache
|
||||
#:remote-checksum-cache remote-checksum-cache
|
||||
#:all-platforms? all-platforms?
|
||||
#:ignore-checksums? ignore-checksums?
|
||||
#:use-cache? use-cache?
|
||||
|
|
@ -1195,6 +1247,7 @@
|
|||
#:update-implies? update-implies?
|
||||
#:update-cache update-cache
|
||||
#:catalog-lookup-cache catalog-lookup-cache
|
||||
#:remote-checksum-cache remote-checksum-cache
|
||||
#:quiet? quiet?
|
||||
#:use-trash? use-trash?
|
||||
#:from-command-line? from-command-line?
|
||||
|
|
@ -1210,6 +1263,7 @@
|
|||
#:convert-to-non-clone? (and lookup-for-clone?
|
||||
(andmap pkg-desc? in-pkgs)
|
||||
(not (ormap pkg-desc-extra-path in-pkgs)))
|
||||
#:pull-behavior pull-behavior
|
||||
to-update)]))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
|
|
|||
|
|
@ -42,22 +42,32 @@
|
|||
|
||||
(define (remote-package-checksum pkg download-printf pkg-name
|
||||
#:type [type #f]
|
||||
#:catalog-lookup-cache [catalog-lookup-cache #f])
|
||||
(match pkg
|
||||
[`(catalog ,pkg-name . ,_)
|
||||
(hash-ref (package-catalog-lookup pkg-name #f catalog-lookup-cache
|
||||
download-printf)
|
||||
'checksum)]
|
||||
[`(url ,pkg-url-str)
|
||||
(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)]))
|
||||
#: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
|
||||
[`(catalog ,pkg-name . ,_)
|
||||
(hash-ref (package-catalog-lookup pkg-name #f catalog-lookup-cache
|
||||
download-printf)
|
||||
'checksum)]
|
||||
[`(url ,pkg-url-str)
|
||||
(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)]))
|
||||
(when remote-checksum-cache
|
||||
(hash-set! remote-checksum-cache pkg checksum))
|
||||
checksum]))
|
||||
|
||||
;; Downloads a package (if needed) and unpacks it (if needed) into a
|
||||
;; temporary directory.
|
||||
|
|
@ -72,6 +82,7 @@
|
|||
download-printf
|
||||
metadata-ns
|
||||
#:catalog-lookup-cache [catalog-lookup-cache #f]
|
||||
#:remote-checksum-cache [remote-checksum-cache #f]
|
||||
#:strip [strip-mode #f]
|
||||
#:force-strip? [force-strip? #f]
|
||||
#:in-place? [in-place? #f]
|
||||
|
|
@ -124,7 +135,9 @@
|
|||
|
||||
(define 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
|
||||
;; 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
|
||||
;; to avoid an extra trip to the server.
|
||||
(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?
|
||||
(check-checksum given-checksum found-checksum "unexpected" pkg #f))
|
||||
(define checksum (or found-checksum given-checksum))
|
||||
|
|
@ -608,6 +623,7 @@
|
|||
download-printf
|
||||
metadata-ns
|
||||
#:catalog-lookup-cache catalog-lookup-cache
|
||||
#:remote-checksum-cache remote-checksum-cache
|
||||
#:strip strip-mode
|
||||
#:force-strip? force-strip?))
|
||||
(when check-sums?
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user