From f92300852f1ec6afc9cb55594d5a94f7cab9ef54 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Sat, 11 May 2013 14:36:58 +0200
Subject: 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'.
---
 doc/guix.texi            | 13 +++++++++
 guix/scripts/refresh.scm | 76 ++++++++++++++++++++++++++++++------------------
 2 files changed, 61 insertions(+), 28 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 9147f43b90..b14310f908 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -1313,6 +1313,19 @@ The command above specifically updates the @code{emacs} and
 @code{idutils} packages.  The @code{--select} option would have no
 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 *********************************************************************
 @node GNU Distribution
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index 37de3b628d..10715ebc2d 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -22,6 +22,7 @@
   #:use-module (guix utils)
   #:use-module (guix packages)
   #:use-module (guix gnu-maintenance)
+  #:use-module (guix gnupg)
   #:use-module (gnu packages)
   #:use-module ((gnu packages base) #:select (%final-inputs))
   #:use-module (ice-9 match)
@@ -57,6 +58,13 @@
                      (leave (_ "~a: invalid selection; expected `core' or `non-core'")
                             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
                 (lambda args
                   (show-help)
@@ -78,6 +86,11 @@ specified with `--select'.\n"))
   -s, --select=SUBSET    select all the packages in SUBSET, one of
                          `core' or `non-core'"))
   (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 (_ "
   -h, --help             display this help and exit"))
   (display (_ "
@@ -85,6 +98,34 @@ specified with `--select'.\n"))
   (newline)
   (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.
@@ -148,34 +189,13 @@ update would trigger a complete rebuild."
     (with-error-handling
       (if update?
           (let ((store (open-connection)))
-            (for-each (lambda (package)
-                        (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)))))
-                      packages))
+            (parameterize ((%openpgp-key-server
+                            (or (assoc-ref opts 'key-server)
+                                (%openpgp-key-server)))
+                           (%gpg-command
+                            (or (assoc-ref opts 'gpg-command)
+                                (%gpg-command))))
+              (for-each (cut update-package store <>) packages)))
           (for-each (lambda (package)
                       (match (false-if-exception (package-update-path package))
                         ((new-version . directory)
-- 
cgit v1.2.3