refresh: Warn about packages that lack an updater.

* guix/upstream.scm (package-update-path): Rename to...
(package-latest-release): ... this.  Remove 'version>?' check.
(package-latest-release*): New procedure.
(package-update): Use it.
* guix/scripts/refresh.scm (lookup-updater): Rename to...
(lookup-updater-by-name): ... this.
(warn-no-updater): New procedure.
(update-package): Add #:warn? parameter and honor it.
(check-for-package-update): New procedure.
(guix-refresh)[warn?]: New variable.
Replace inline code when UPDATE? is false with a call to
'check-for-package-update'.
Pass WARN? to 'check-for-package-update' and 'update-package'.
* doc/guix.texi (Invoking guix refresh): Document it.  Fix a couple of
typos.
master
Ludovic Courtès 2016-11-29 15:07:07 +01:00
parent a409de9811
commit e9c72306fd
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 95 additions and 50 deletions

View File

@ -5250,10 +5250,19 @@ gnu/packages/gettext.scm:29:13: gettext would be upgraded from 0.18.1.1 to 0.18.
gnu/packages/glib.scm:77:12: glib would be upgraded from 2.34.3 to 2.37.0 gnu/packages/glib.scm:77:12: glib would be upgraded from 2.34.3 to 2.37.0
@end example @end example
It does so by browsing the FTP directory of each package and determining Alternately, one can specify packages to consider, in which case a
the highest version number of the source tarballs therein. The command warning is emitted for packages that lack an updater:
@example
$ guix refresh coreutils guile guile-ssh
gnu/packages/ssh.scm:205:2: warning: no updater for guile-ssh
gnu/packages/guile.scm:136:12: guile would be upgraded from 2.0.12 to 2.0.13
@end example
@command{guix refresh} browses the upstream repository of each package and determines
the highest version number of the releases therein. The command
knows how to update specific types of packages: GNU packages, ELPA knows how to update specific types of packages: GNU packages, ELPA
packages, etc.---see the documentation for @option{--type} below. The packages, etc.---see the documentation for @option{--type} below. There
are many packages, though, for which it lacks a method to determine are many packages, though, for which it lacks a method to determine
whether a new upstream release is available. However, the mechanism is whether a new upstream release is available. However, the mechanism is
extensible, so feel free to get in touch with us to add a new method! extensible, so feel free to get in touch with us to add a new method!
@ -5293,7 +5302,7 @@ usually run from a checkout of the Guix source tree (@pxref{Running
Guix Before It Is Installed}): Guix Before It Is Installed}):
@example @example
$ ./pre-inst-env guix refresh -s non-core $ ./pre-inst-env guix refresh -s non-core -u
@end example @end example
@xref{Defining Packages}, for more information on package definitions. @xref{Defining Packages}, for more information on package definitions.
@ -5359,7 +5368,7 @@ In addition, @command{guix refresh} can be passed one or more package
names, as in this example: names, as in this example:
@example @example
$ ./pre-inst-env guix refresh -u emacs idutils gcc-4.8.4 $ ./pre-inst-env guix refresh -u emacs idutils gcc@@4.8
@end example @end example
@noindent @noindent

View File

@ -208,7 +208,7 @@ unavailable optional dependencies such as Guile-JSON."
((guix import gem) => %gem-updater) ((guix import gem) => %gem-updater)
((guix import github) => %github-updater))) ((guix import github) => %github-updater)))
(define (lookup-updater name) (define (lookup-updater-by-name name)
"Return the updater called NAME." "Return the updater called NAME."
(or (find (lambda (updater) (or (find (lambda (updater)
(eq? name (upstream-updater-name updater))) (eq? name (upstream-updater-name updater)))
@ -225,31 +225,60 @@ unavailable optional dependencies such as Guile-JSON."
%updaters) %updaters)
(exit 0)) (exit 0))
(define (warn-no-updater package)
(format (current-error-port)
(_ "~a: warning: no updater for ~a~%")
(location->string (package-location package))
(package-name package)))
(define* (update-package store package updaters (define* (update-package store package updaters
#:key (key-download 'interactive)) #:key (key-download 'interactive) warn?)
"Update the source file that defines PACKAGE with the new version. "Update the source file that defines PACKAGE with the new version.
KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed
values: 'interactive' (default), 'always', and 'never'." values: 'interactive' (default), 'always', and 'never'. When WARN? is true,
(let-values (((version tarball) warn about packages that have no matching updater."
(package-update store package updaters (if (lookup-updater package updaters)
#:key-download key-download)) (let-values (((version tarball)
((loc) (package-update store package updaters
(or (package-field-location package 'version) #:key-download key-download))
(package-location package)))) ((loc)
(when version (or (package-field-location package 'version)
(if (and=> tarball file-exists?) (package-location package))))
(begin (when version
(format (current-error-port) (if (and=> tarball file-exists?)
(_ "~a: ~a: updating from version ~a to version ~a...~%") (begin
(location->string loc) (format (current-error-port)
(package-name package) (_ "~a: ~a: updating from version ~a to version ~a...~%")
(package-version package) version) (location->string loc)
(let ((hash (call-with-input-file tarball (package-name package)
port-sha256))) (package-version package) version)
(update-package-source package version hash))) (let ((hash (call-with-input-file tarball
(warning (_ "~a: version ~a could not be \ port-sha256)))
(update-package-source package version hash)))
(warning (_ "~a: version ~a could not be \
downloaded and authenticated; not updating~%") downloaded and authenticated; not updating~%")
(package-name package) version))))) (package-name package) version))))
(when warn?
(warn-no-updater package))))
(define* (check-for-package-update package #:key warn?)
"Check whether an update is available for PACKAGE and print a message. When
WARN? is true and no updater exists for PACKAGE, print a warning."
(match (package-latest-release package %updaters)
((? upstream-source? source)
(when (version>? (upstream-source-version source)
(package-version package))
(let ((loc (or (package-field-location package 'version)
(package-location package))))
(format (current-error-port)
(_ "~a: ~a would be upgraded from ~a to ~a~%")
(location->string loc)
(package-name package) (package-version package)
(upstream-source-version source)))))
(#f
(when warn?
(warn-no-updater package)))))
;;; ;;;
@ -312,7 +341,7 @@ dependent packages are rebuilt: ~{~a~^ ~}~%"
;; Return the list of updaters to use. ;; Return the list of updaters to use.
(match (filter-map (match-lambda (match (filter-map (match-lambda
(('updaters . names) (('updaters . names)
(map lookup-updater names)) (map lookup-updater-by-name names))
(_ #f)) (_ #f))
opts) opts)
(() (()
@ -360,6 +389,12 @@ update would trigger a complete rebuild."
(updaters (options->updaters opts)) (updaters (options->updaters opts))
(list-dependent? (assoc-ref opts 'list-dependent?)) (list-dependent? (assoc-ref opts 'list-dependent?))
(key-download (assoc-ref opts 'key-download)) (key-download (assoc-ref opts 'key-download))
;; Warn about missing updaters when a package is explicitly given on
;; the command line.
(warn? (or (assoc-ref opts 'argument)
(assoc-ref opts 'expression)))
(packages (packages
(match (filter-map (match-lambda (match (filter-map (match-lambda
(('argument . spec) (('argument . spec)
@ -397,22 +432,13 @@ update would trigger a complete rebuild."
(%gpg-command)))) (%gpg-command))))
(for-each (for-each
(cut update-package store <> updaters (cut update-package store <> updaters
#:key-download key-download) #:key-download key-download
#:warn? warn?)
packages) packages)
(with-monad %store-monad (with-monad %store-monad
(return #t)))) (return #t))))
(else (else
(for-each (lambda (package) (for-each (cut check-for-package-update <> #:warn? warn?)
(match (package-update-path package updaters)
((? upstream-source? source)
(let ((loc (or (package-field-location package 'version)
(package-location package))))
(format (current-error-port)
(_ "~a: ~a would be upgraded from ~a to ~a~%")
(location->string loc)
(package-name package) (package-version package)
(upstream-source-version source))))
(#f #f)))
packages) packages)
(with-monad %store-monad (with-monad %store-monad
(return #t))))))))) (return #t)))))))))

View File

@ -49,8 +49,11 @@
upstream-updater-predicate upstream-updater-predicate
upstream-updater-latest upstream-updater-latest
lookup-updater
download-tarball download-tarball
package-update-path package-latest-release
package-latest-release*
package-update package-update
update-package-source)) update-package-source))
@ -127,17 +130,24 @@ them matches."
(and (pred package) latest))) (and (pred package) latest)))
updaters)) updaters))
(define (package-update-path package updaters) (define (package-latest-release package updaters)
"Return an upstream source to update PACKAGE, a <package> object, or #f if "Return an upstream source to update PACKAGE, a <package> object, or #f if
no update is needed or known." none of UPDATERS matches PACKAGE. It is the caller's responsibility to ensure
that the returned source is newer than the current one."
(match (lookup-updater package updaters) (match (lookup-updater package updaters)
((? procedure? latest-release) ((? procedure? latest-release)
(match (latest-release package) (latest-release package))
((and source ($ <upstream-source> name version)) (_ #f)))
(and (version>? version (package-version package))
source)) (define (package-latest-release* package updaters)
(_ #f))) "Like 'package-latest-release', but ensure that the return source is newer
(#f #f))) than that of PACKAGE."
(match (package-latest-release package updaters)
((and source ($ <upstream-source> name version))
(and (version>? version (package-version package))
source))
(_
#f)))
(define* (download-tarball store url signature-url (define* (download-tarball store url signature-url
#:key (key-download 'interactive)) #:key (key-download 'interactive))
@ -179,7 +189,7 @@ values: the item from LST1 and the item from LST2 that match PRED."
PACKAGE, or #f and #f when PACKAGE is up-to-date. KEY-DOWNLOAD specifies a PACKAGE, or #f and #f when PACKAGE is up-to-date. KEY-DOWNLOAD specifies a
download policy for missing OpenPGP keys; allowed values: 'always', 'never', download policy for missing OpenPGP keys; allowed values: 'always', 'never',
and 'interactive' (default)." and 'interactive' (default)."
(match (package-update-path package updaters) (match (package-latest-release* package updaters)
(($ <upstream-source> _ version urls signature-urls) (($ <upstream-source> _ version urls signature-urls)
(let*-values (((name) (let*-values (((name)
(package-name package)) (package-name package))