refresh: Add `--key-server' and `--gpg'.
* guix/scripts/refresh.scm (%options): Add `--key-server' and `--gpg'. (show-help): Update accordingly. (update-package): New procedure, formerly in `guix-refresh'. (guix-refresh): Use it. Parameterize `%openpgp-key-server' and `%gpg-command'.
This commit is contained in:
parent
0ba91c945b
commit
f92300852f
|
@ -1313,6 +1313,19 @@ The command above specifically updates the @code{emacs} and
|
||||||
@code{idutils} packages. The @code{--select} option would have no
|
@code{idutils} packages. The @code{--select} option would have no
|
||||||
effect in this case.
|
effect in this case.
|
||||||
|
|
||||||
|
The following options can be used to customize GnuPG operation:
|
||||||
|
|
||||||
|
@table @code
|
||||||
|
|
||||||
|
@item --key-server=@var{host}
|
||||||
|
Use @var{host} as the OpenPGP key server when importing a public key.
|
||||||
|
|
||||||
|
@item --gpg=@var{command}
|
||||||
|
Use @var{command} as the GnuPG 2.x command. @var{command} is searched
|
||||||
|
for in @code{$PATH}.
|
||||||
|
|
||||||
|
@end table
|
||||||
|
|
||||||
|
|
||||||
@c *********************************************************************
|
@c *********************************************************************
|
||||||
@node GNU Distribution
|
@node GNU Distribution
|
||||||
|
|
|
@ -22,6 +22,7 @@
|
||||||
#:use-module (guix utils)
|
#:use-module (guix utils)
|
||||||
#:use-module (guix packages)
|
#:use-module (guix packages)
|
||||||
#:use-module (guix gnu-maintenance)
|
#:use-module (guix gnu-maintenance)
|
||||||
|
#:use-module (guix gnupg)
|
||||||
#:use-module (gnu packages)
|
#:use-module (gnu packages)
|
||||||
#:use-module ((gnu packages base) #:select (%final-inputs))
|
#:use-module ((gnu packages base) #:select (%final-inputs))
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
|
@ -57,6 +58,13 @@
|
||||||
(leave (_ "~a: invalid selection; expected `core' or `non-core'")
|
(leave (_ "~a: invalid selection; expected `core' or `non-core'")
|
||||||
arg)))))
|
arg)))))
|
||||||
|
|
||||||
|
(option '("key-server") #t #f
|
||||||
|
(lambda (opt name arg result)
|
||||||
|
(alist-cons 'key-server arg result)))
|
||||||
|
(option '("gpg") #t #f
|
||||||
|
(lambda (opt name arg result)
|
||||||
|
(alist-cons 'gpg-command arg result)))
|
||||||
|
|
||||||
(option '(#\h "help") #f #f
|
(option '(#\h "help") #f #f
|
||||||
(lambda args
|
(lambda args
|
||||||
(show-help)
|
(show-help)
|
||||||
|
@ -78,6 +86,11 @@ specified with `--select'.\n"))
|
||||||
-s, --select=SUBSET select all the packages in SUBSET, one of
|
-s, --select=SUBSET select all the packages in SUBSET, one of
|
||||||
`core' or `non-core'"))
|
`core' or `non-core'"))
|
||||||
(newline)
|
(newline)
|
||||||
|
(display (_ "
|
||||||
|
--key-server=HOST use HOST as the OpenPGP key server"))
|
||||||
|
(display (_ "
|
||||||
|
--gpg=COMMAND use COMMAND as the GnuPG 2.x command"))
|
||||||
|
(newline)
|
||||||
(display (_ "
|
(display (_ "
|
||||||
-h, --help display this help and exit"))
|
-h, --help display this help and exit"))
|
||||||
(display (_ "
|
(display (_ "
|
||||||
|
@ -85,6 +98,34 @@ specified with `--select'.\n"))
|
||||||
(newline)
|
(newline)
|
||||||
(show-bug-report-information))
|
(show-bug-report-information))
|
||||||
|
|
||||||
|
(define (update-package store package)
|
||||||
|
"Update the source file that defines PACKAGE with the new version."
|
||||||
|
(let-values (((version tarball)
|
||||||
|
(catch #t
|
||||||
|
(lambda ()
|
||||||
|
(package-update store package))
|
||||||
|
(lambda _
|
||||||
|
(values #f #f))))
|
||||||
|
((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
|
||||||
|
(compose sha256 get-bytevector-all))))
|
||||||
|
(update-package-source package version hash)))
|
||||||
|
(warning (_ "~a: version ~a could not be \
|
||||||
|
downloaded and authenticated; not updating")
|
||||||
|
(package-name package) version)))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
;;; Entry point.
|
;;; Entry point.
|
||||||
|
@ -148,34 +189,13 @@ update would trigger a complete rebuild."
|
||||||
(with-error-handling
|
(with-error-handling
|
||||||
(if update?
|
(if update?
|
||||||
(let ((store (open-connection)))
|
(let ((store (open-connection)))
|
||||||
(for-each (lambda (package)
|
(parameterize ((%openpgp-key-server
|
||||||
(let-values (((version tarball)
|
(or (assoc-ref opts 'key-server)
|
||||||
(catch #t
|
(%openpgp-key-server)))
|
||||||
(lambda ()
|
(%gpg-command
|
||||||
(package-update store package))
|
(or (assoc-ref opts 'gpg-command)
|
||||||
(lambda _
|
(%gpg-command))))
|
||||||
(values #f #f))))
|
(for-each (cut update-package store <>) packages)))
|
||||||
((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
|
|
||||||
(compose sha256
|
|
||||||
get-bytevector-all))))
|
|
||||||
(update-package-source package version
|
|
||||||
hash)))
|
|
||||||
(warning (_ "~a: version ~a could not be \
|
|
||||||
downloaded and authenticated; not updating")
|
|
||||||
(package-name package) version)))))
|
|
||||||
packages))
|
|
||||||
(for-each (lambda (package)
|
(for-each (lambda (package)
|
||||||
(match (false-if-exception (package-update-path package))
|
(match (false-if-exception (package-update-path package))
|
||||||
((new-version . directory)
|
((new-version . directory)
|
||||||
|
|
Loading…
Reference in New Issue