02/15: refresh: Honor '--key-server'.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit cd08d64b3a1d18cceba2fb7ec01c27b1c08f88d2
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Wed May 17 16:19:20 2023 +0200

    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'.
---
 guix/scripts/refresh.scm |  8 ++++++--
 guix/upstream.scm        | 17 ++++++++++++-----
 2 files changed, 18 insertions(+), 7 deletions(-)

diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index 47c4d55ec4..bfa6269aa3 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -348,7 +348,8 @@ update would trigger a complete rebuild."
            (package-name package)))
 
 (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.
 KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed
 values: 'interactive' (default), 'always', and 'never'.  When WARN? is true,
@@ -356,7 +357,9 @@ warn about packages that have no matching updater."
   (if (lookup-updater package updaters)
       (let ((version output source
                      (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)
                      (package-location package))))
         (when version
@@ -628,6 +631,7 @@ all are dependent packages: ~{~a~^ ~}~%")
                                    (update-spec-package update)
                                    (update-spec-version update)
                                    updaters
+                                   #:key-server (%openpgp-key-server)
                                    #:key-download key-download
                                    #:warn? warn?))
                  update-specs)
diff --git a/guix/upstream.scm b/guix/upstream.scm
index 52fae11832..aac501c466 100644
--- a/guix/upstream.scm
+++ b/guix/upstream.scm
@@ -330,12 +330,14 @@ than that of PACKAGE."
                                         #$output)))))
 
 (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
 SIGNATURE-URL, unless SIGNATURE-URL is false.  On success, return the tarball
 file name; return #f on failure (network failure or authentication failure).
+
 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)))
     (if (not signature-url)
         tarball
@@ -356,6 +358,7 @@ values: 'interactive' (default), 'always', and 'never'."
           (let-values (((status data)
                         (if sig
                             (gnupg-verify* sig data
+                                           #:server key-server
                                            #:key-download key-download)
                             (values 'missing-signature data))))
             (match status
@@ -446,7 +449,7 @@ string such as \"xz\".  Otherwise return #f."
             extension)))))
 
 (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
 SOURCE, an <upstream-source>."
   (match source
@@ -470,11 +473,13 @@ SOURCE, an <upstream-source>."
                                         (and (pair? signature-urls)
                                              (or signature-url
                                                  (first signature-urls)))
+                                        #:key-server key-server
                                         #:key-download key-download)))
          (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
 SOURCE, an <upstream-source>."
   ;; TODO: it would be nice to authenticate commits, e.g. with
@@ -495,7 +500,8 @@ SOURCE, an <upstream-source>."
 
 (define* (package-update store package
                          #: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
 changes for PACKAGE; return #f (three values) when PACKAGE is up-to-date;
 raise an error when the updater could not determine available releases.
@@ -532,6 +538,7 @@ this method: ~s")
                         (location (package-location package)))))))
              ((_ . update)
               (update store package source
+                      #:key-server key-server
                       #:key-download key-download))))
          (values #f #f #f)))
     (#f