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.
This commit is contained in:
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
@end example
It does so by browsing the FTP directory of each package and determining
the highest version number of the source tarballs therein. The command
Alternately, one can specify packages to consider, in which case a
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
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
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!
@ -5293,7 +5302,7 @@ usually run from a checkout of the Guix source tree (@pxref{Running
Guix Before It Is Installed}):
@example
$ ./pre-inst-env guix refresh -s non-core
$ ./pre-inst-env guix refresh -s non-core -u
@end example
@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:
@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
@noindent

View file

@ -208,7 +208,7 @@ (define %updaters
((guix import gem) => %gem-updater)
((guix import github) => %github-updater)))
(define (lookup-updater name)
(define (lookup-updater-by-name name)
"Return the updater called NAME."
(or (find (lambda (updater)
(eq? name (upstream-updater-name updater)))
@ -225,31 +225,60 @@ (define (list-updaters-and-exit)
%updaters)
(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
#:key (key-download 'interactive))
#:key (key-download 'interactive) warn?)
"Update the source file that defines PACKAGE with the new version.
KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed
values: 'interactive' (default), 'always', and 'never'."
(let-values (((version tarball)
(package-update store package updaters
#:key-download key-download))
((loc)
(or (package-field-location package 'version)
(package-location package))))
(when version
(if (and=> tarball file-exists?)
(begin
(format (current-error-port)
(_ "~a: ~a: updating from version ~a to version ~a...~%")
(location->string loc)
(package-name package)
(package-version package) version)
(let ((hash (call-with-input-file tarball
port-sha256)))
(update-package-source package version hash)))
(warning (_ "~a: version ~a could not be \
values: 'interactive' (default), 'always', and 'never'. When WARN? is true,
warn about packages that have no matching updater."
(if (lookup-updater package updaters)
(let-values (((version tarball)
(package-update store package updaters
#:key-download key-download))
((loc)
(or (package-field-location package 'version)
(package-location package))))
(when version
(if (and=> tarball file-exists?)
(begin
(format (current-error-port)
(_ "~a: ~a: updating from version ~a to version ~a...~%")
(location->string loc)
(package-name package)
(package-version package) version)
(let ((hash (call-with-input-file tarball
port-sha256)))
(update-package-source package version hash)))
(warning (_ "~a: version ~a could not be \
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 @@ (define (options->updaters opts)
;; Return the list of updaters to use.
(match (filter-map (match-lambda
(('updaters . names)
(map lookup-updater names))
(map lookup-updater-by-name names))
(_ #f))
opts)
(()
@ -360,6 +389,12 @@ (define core-package?
(updaters (options->updaters opts))
(list-dependent? (assoc-ref opts 'list-dependent?))
(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
(match (filter-map (match-lambda
(('argument . spec)
@ -397,22 +432,13 @@ (define core-package?
(%gpg-command))))
(for-each
(cut update-package store <> updaters
#:key-download key-download)
#:key-download key-download
#:warn? warn?)
packages)
(with-monad %store-monad
(return #t))))
(else
(for-each (lambda (package)
(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)))
(for-each (cut check-for-package-update <> #:warn? warn?)
packages)
(with-monad %store-monad
(return #t)))))))))

View file

@ -49,8 +49,11 @@ (define-module (guix upstream)
upstream-updater-predicate
upstream-updater-latest
lookup-updater
download-tarball
package-update-path
package-latest-release
package-latest-release*
package-update
update-package-source))
@ -127,17 +130,24 @@ (define (lookup-updater package updaters)
(and (pred package) latest)))
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
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)
((? procedure? latest-release)
(match (latest-release package)
((and source ($ <upstream-source> name version))
(and (version>? version (package-version package))
source))
(_ #f)))
(#f #f)))
(latest-release package))
(_ #f)))
(define (package-latest-release* package updaters)
"Like 'package-latest-release', but ensure that the return source is newer
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
#:key (key-download 'interactive))
@ -179,7 +189,7 @@ (define* (package-update store package updaters
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',
and 'interactive' (default)."
(match (package-update-path package updaters)
(match (package-latest-release* package updaters)
(($ <upstream-source> _ version urls signature-urls)
(let*-values (((name)
(package-name package))