suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

raco pkg update: avoid duplicate updates of a single package

Browse Source 
A table was incorrectly used to track both the checksum and
update status of packages; fix that, so that `raco pkg update --all`
doesn't generate a plan with multiple updates of a single package.
Meanwhile, also protect against multiple and inconsistent planned
updates of a package (by collapsing multiple consistent plans into
one).
This commit is contained in:
Matthew Flatt 2014-12-16 10:07:46 -07:00
parent 2b62ffe90b
commit ebd817f278
1 changed files with 35 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
racket/collects/pkg/private/install.rkt
View File

@ -904,7 +904,9 @@
;; If `must-update?', then complain if the package is not ;; If `must-update?', then complain if the package is not
;; updatable. ;; updatable.
;; The `update-cache' argument is used to cache which packages ;; The `update-cache' argument is used to cache which packages
;; are already being updated and downloaded checksums. ;; are already being updated and their downloaded checksums;
;; it maps a package name to a checksum, and a box of the package
;; name to #t (to avoid multiple update attempts).
(define ((packages-to-update download-printf db (define ((packages-to-update download-printf db
#:must-update? [must-update? #t] #:must-update? [must-update? #t]
#:deps? deps? #:deps? deps?
@ -922,7 +924,8 @@
pkg-name) pkg-name)
(let update-loop ([pkg-name pkg-name] (let update-loop ([pkg-name pkg-name]
[must-update? must-update?] [must-update? must-update?]
[force-update? force-update?]) [force-update? force-update?]
[report-skip? #t])
(cond (cond
[(pkg-desc? pkg-name) [(pkg-desc? pkg-name)
;; Infer the package-source type and name: ;; Infer the package-source type and name:
@ -965,7 +968,7 @@
(pkg-desc-extra-path pkg-name))))) (pkg-desc-extra-path pkg-name)))))
;; Update: ;; Update:
(begin (begin
(hash-set! update-cache (pkg-desc-source pkg-name) #t) (hash-set! update-cache (box name) #t)
(list (pkg-desc (pkg-desc-source pkg-name) (list (pkg-desc (pkg-desc-source pkg-name)
(pkg-desc-type pkg-name) (pkg-desc-type pkg-name)
name name
@ -977,9 +980,9 @@
;; No update needed, but maybe check dependencies: ;; No update needed, but maybe check dependencies:
(if (or deps? (if (or deps?
implies?) implies?)
(update-loop name #f #f) (update-loop name #f #f #f)
null))] null))]
[(hash-ref update-cache pkg-name #f) [(hash-ref update-cache (box pkg-name) #f)
;; package is already being updated ;; package is already being updated
null] null]
;; A string indicates that package source that should be ;; A string indicates that package source that should be
@ -1005,27 +1008,27 @@
(cond (cond
[(pair? missing-deps) [(pair? missing-deps)
;; A dependency is missing. Treat the dependenct package as ;; A dependency is missing. Treat the dependent package as
;; needing an update, even if it is installed as a link, so ;; needing an update, even if it is installed as a link, so
;; that the user is asked about installing dependencies, etc. ;; that the user is asked about installing dependencies, etc.
(log-pkg-debug "Missing dependencies of ~s: ~s" pkg-name missing-deps) (log-pkg-debug "Missing dependencies of ~s: ~s" pkg-name missing-deps)
(update-loop (pkg-info->desc pkg-name info) #f #t)] (update-loop (pkg-info->desc pkg-name info) #f #t #t)]
[else [else
(define (update-dependencies) (define (update-dependencies)
(hash-set! update-cache (box pkg-name) #t)
(if (or deps? implies?) (if (or deps? implies?)
;; Check dependencies ;; Check dependencies
(append-map (append-map
(lambda (dep) (update-loop dep #f #f)) (lambda (dep) (update-loop dep #f #f #t))
deps) deps)
null)) null))
(define (skip/update-dependencies kind) (define (skip/update-dependencies kind)
(unless all-mode? (unless (or all-mode? (not report-skip?))
(download-printf "Skipping update of ~a: ~a\n" (download-printf "Skipping update of ~a: ~a\n"
kind kind
pkg-name)) pkg-name))
(hash-set! update-cache pkg-name #t)
(update-dependencies)) (update-dependencies))
(match orig-pkg (match orig-pkg
@ -1069,22 +1072,23 @@
;; URL unambigious: ;; URL unambigious:
(values (cadr orig-pkg) #f #f))) (values (cadr orig-pkg) #f #f)))
(define new-checksum (define new-checksum
(or (hash-ref update-cache pkg-name #f) (hash-ref update-cache pkg-name
(remote-package-checksum orig-pkg download-printf pkg-name (lambda ()
#:catalog-lookup-cache catalog-lookup-cache))) (remote-package-checksum orig-pkg download-printf pkg-name
#:catalog-lookup-cache catalog-lookup-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
(not (equal? checksum new-checksum)) (not (equal? checksum new-checksum))
;; Update it:
(begin (begin
;; Update it:
(hash-set! update-cache pkg-name #t)
;; Flush cache of downloaded checksums, in case ;; Flush cache of downloaded checksums, in case
;; there was a race between our checkig and updates on ;; there was a race between our checkig and updates on
;; the catalog server: ;; the catalog server:
(clear-checksums-in-cache! update-cache) (clear-checksums-in-cache! update-cache)
(list (pkg-desc orig-pkg-source orig-pkg-type pkg-name #f auto? (list (pkg-desc orig-pkg-source orig-pkg-type pkg-name #f auto?
orig-pkg-dir)))) orig-pkg-dir))))
;; Continue with dependencies, maybe
(update-dependencies))])]))] (update-dependencies))])]))]
[else null]))) [else null])))
@ -1116,7 +1120,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 to-update (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?))
#:deps? (or update-deps? #:deps? (or update-deps?
@ -1157,11 +1161,25 @@
"") "")
"\n"))])) "\n"))]))
'skip] 'skip]
[(empty? to-update) [(empty? to-updat*)
(unless quiet? (unless quiet?
(printf/flush "No updates available\n")) (printf/flush "No updates available\n"))
'skip] 'skip]
[else [else
(define to-update
(hash-values
(for/fold ([ht #hash()]) ([u (in-list to-updat*)])
(cond
[(hash-ref ht (pkg-desc-name u) #f)
=> (lambda (v)
(cond
[(pkg-desc=? v u) ht]
[else
(pkg-error (~a "cannot update with conflicting update information;\n"
" package name: ~a")
(pkg-desc-name u))]))]
[else
(hash-set ht (pkg-desc-name u) u)]))))
(unless quiet? (unless quiet?
(printf "Updating:\n") (printf "Updating:\n")
(for ([u (in-list to-update)]) (for ([u (in-list to-update)])