refresh: Honor '--key-server'.

Previously, the '--key-server' option would be ignored in an invocation
like:

  ./pre-inst-env guix refresh python-scipy=1.8.1 -t pypi -u \
     --key-server=pgp.mit.edu

* guix/upstream.scm (download-tarball): Add #:key-server parameter and
pass it to 'gnupg-verify*'.
(package-update/url-fetch, package-update/git-fetch)
(package-update): Likewise.
* guix/scripts/refresh.scm (update-package): Add #:key-server and pass
it down to 'package-update'.
(guix-refresh): Pass #:key-server to 'update-package'.
This commit is contained in:
Ludovic Courtès 2023-05-17 16:19:20 +02:00
parent fddf97456c
commit cd08d64b3a
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 18 additions and 7 deletions

View file

@ -348,7 +348,8 @@ (define (warn-no-updater package)
(package-name package))) (package-name package)))
(define* (update-package store package version updaters (define* (update-package store package version updaters
#:key (key-download 'interactive) warn?) #:key (key-download 'interactive) key-server
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'. When WARN? is true, values: 'interactive' (default), 'always', and 'never'. When WARN? is true,
@ -356,7 +357,9 @@ (define* (update-package store package version updaters
(if (lookup-updater package updaters) (if (lookup-updater package updaters)
(let ((version output source (let ((version output source
(package-update store package updaters (package-update store package updaters
#:key-download key-download #:version version)) #:version version
#:key-download key-download
#:key-server key-server))
(loc (or (package-field-location package 'version) (loc (or (package-field-location package 'version)
(package-location package)))) (package-location package))))
(when version (when version
@ -628,6 +631,7 @@ (define (options->updaters opts)
(update-spec-package update) (update-spec-package update)
(update-spec-version update) (update-spec-version update)
updaters updaters
#:key-server (%openpgp-key-server)
#:key-download key-download #:key-download key-download
#:warn? warn?)) #:warn? warn?))
update-specs) update-specs)

View file

@ -330,12 +330,14 @@ (define compressor
#$output))))) #$output)))))
(define* (download-tarball store url signature-url (define* (download-tarball store url signature-url
#:key (key-download 'interactive)) #:key (key-download 'interactive) key-server)
"Download the tarball at URL to the store; check its OpenPGP signature at "Download the tarball at URL to the store; check its OpenPGP signature at
SIGNATURE-URL, unless SIGNATURE-URL is false. On success, return the tarball SIGNATURE-URL, unless SIGNATURE-URL is false. On success, return the tarball
file name; return #f on failure (network failure or authentication failure). file name; return #f on failure (network failure or authentication failure).
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'; KEY-SERVER specifies
the OpenPGP key server where the key should be looked up."
(let ((tarball (download-to-store store url))) (let ((tarball (download-to-store store url)))
(if (not signature-url) (if (not signature-url)
tarball tarball
@ -356,6 +358,7 @@ (define* (download-tarball store url signature-url
(let-values (((status data) (let-values (((status data)
(if sig (if sig
(gnupg-verify* sig data (gnupg-verify* sig data
#:server key-server
#:key-download key-download) #:key-download key-download)
(values 'missing-signature data)))) (values 'missing-signature data))))
(match status (match status
@ -446,7 +449,7 @@ (define (package-archive-type package)
extension))))) extension)))))
(define* (package-update/url-fetch store package source (define* (package-update/url-fetch store package source
#:key key-download) #:key key-download key-server)
"Return the version, tarball, and SOURCE, to update PACKAGE to "Return the version, tarball, and SOURCE, to update PACKAGE to
SOURCE, an <upstream-source>." SOURCE, an <upstream-source>."
(match source (match source
@ -470,11 +473,13 @@ (define* (package-update/url-fetch store package source
(and (pair? signature-urls) (and (pair? signature-urls)
(or signature-url (or signature-url
(first signature-urls))) (first signature-urls)))
#:key-server key-server
#:key-download key-download))) #:key-download key-download)))
(values version tarball source)))))) (values version tarball source))))))
(define* (package-update/git-fetch store package source #:key key-download) (define* (package-update/git-fetch store package source
#:key key-download key-server)
"Return the version, checkout, and SOURCE, to update PACKAGE to "Return the version, checkout, and SOURCE, to update PACKAGE to
SOURCE, an <upstream-source>." SOURCE, an <upstream-source>."
;; TODO: it would be nice to authenticate commits, e.g. with ;; TODO: it would be nice to authenticate commits, e.g. with
@ -495,7 +500,8 @@ (define %method-updates
(define* (package-update store package (define* (package-update store package
#:optional (updaters (force %updaters)) #:optional (updaters (force %updaters))
#:key (key-download 'interactive) (version #f)) #:key (version #f)
(key-download 'interactive) key-server)
"Return the new version, the file name of the new version tarball, and input "Return the new version, the file name of the new version tarball, and input
changes for PACKAGE; return #f (three values) when PACKAGE is up-to-date; changes for PACKAGE; return #f (three values) when PACKAGE is up-to-date;
raise an error when the updater could not determine available releases. raise an error when the updater could not determine available releases.
@ -532,6 +538,7 @@ (define* (package-update store package
(location (package-location package))))))) (location (package-location package)))))))
((_ . update) ((_ . update)
(update store package source (update store package source
#:key-server key-server
#:key-download key-download)))) #:key-download key-download))))
(values #f #f #f))) (values #f #f #f)))
(#f (#f