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:
		
							parent
							
								
									fddf97456c
								
							
						
					
					
						commit
						cd08d64b3a
					
				
					 2 changed files with 18 additions and 7 deletions
				
			
		| 
						 | 
					@ -348,7 +348,8 @@ update would trigger a complete rebuild."
 | 
				
			||||||
           (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 @@ warn about packages that have no matching updater."
 | 
				
			||||||
  (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 @@ all are dependent packages: ~{~a~^ ~}~%")
 | 
				
			||||||
                                   (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)
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -330,12 +330,14 @@ than that of PACKAGE."
 | 
				
			||||||
                                        #$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 @@ values: 'interactive' (default), 'always', and 'never'."
 | 
				
			||||||
          (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 @@ string such as \"xz\".  Otherwise return #f."
 | 
				
			||||||
            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 @@ SOURCE, an <upstream-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 @@ SOURCE, an <upstream-source>."
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(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 @@ this method: ~s")
 | 
				
			||||||
                        (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
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Reference in a new issue