guix refresh: Add '--key-download'.

* guix/gnu-maintenance.scm (download-tarball): Add a 'key-download'
  keyword argument and pass it to 'gnupg-verify*'.  Make
  'archive-type' a keyword argument.
  (package-update): Add a 'key-download' keyword argument.  Pass
  'archive-type' and 'key-download' keyword arguments to
  'download-tarball'.

* guix/gnupg.scm: Import (ice-9 i18n) and (guix ui).
  (gnupg-verify*): Add a 'key-download' keyword argument and adjust
  'gnupg-verify*' to use it.  Make 'server' a keyword argument.

* guix/scripts/refresh.scm (show-help, %options): Add and document
  '--key-download'.
  (update-package): Add a 'key-download' keyword argument and pass it
  to 'package-update'.
  (guix-refresh): Pass 'key-download' to 'update-package'.  Limit
  lines to a maximum of 79 characters.

1 files changed, 50 insertions, 29 deletions

diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index 10715ebc2d..b8d4efd204 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -64,6 +65,15 @@
         (option '("gpg") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'gpg-command arg result)))
+        (option '("key-download") #t #f
+                (lambda (opt name arg result)
+                  (match arg
+                    ((or "interactive" "always" "never")
+                     (alist-cons 'key-download (string->symbol arg)
+                                 result))
+                    (_
+                     (leave (_ "unsupported policy: ~a~%")
+                            arg)))))
 
         (option '(#\h "help") #f #f
                 (lambda args
@@ -90,6 +100,11 @@ specified with `--select'.\n"))
       --key-server=HOST  use HOST as the OpenPGP key server"))
   (display (_ "
       --gpg=COMMAND      use COMMAND as the GnuPG 2.x command"))
+  (display (_ "
+      --key-download=POLICY
+                         handle missing OpenPGP keys according to POLICY:
+                         'always', 'never', and 'interactive', which is also
+                         used when 'key-download' is not specified"))
   (newline)
   (display (_ "
   -h, --help             display this help and exit"))
@@ -98,12 +113,14 @@ 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."
+(define* (update-package store package #:key (key-download 'interactive))
+  "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'."
   (let-values (((version tarball)
                 (catch #t
                   (lambda ()
-                    (package-update store package))
+                    (package-update store package #:key-download key-download))
                   (lambda _
                     (values #f #f))))
                ((loc)
@@ -161,31 +178,33 @@ update would trigger a complete rebuild."
         ;; XXX: Fails to catch MPFR/MPC, whose *source* is used as input.
         (member (package-name package) names))))
 
-  (let* ((opts     (parse-options))
-         (update?  (assoc-ref opts 'update?))
-         (packages (match (concatenate
-                           (filter-map (match-lambda
-                                        (('argument . value)
-                                         (let ((p (find-packages-by-name value)))
-                                           (unless p
-                                             (leave (_ "~a: no package by that name")
-                                                    value))
-                                           p))
-                                        (_ #f))
-                                       opts))
-                     (()                          ; default to all packages
-                      (let ((select? (match (assoc-ref opts 'select)
-                                       ('core core-package?)
-                                       ('non-core (negate core-package?))
-                                       (_ (const #t)))))
-                        ;; TODO: Keep only the newest of each package.
-                        (fold-packages (lambda (package result)
-                                         (if (select? package)
-                                             (cons package result)
-                                             result))
-                                       '())))
-                     (some                        ; user-specified packages
-                      some))))
+  (let* ((opts         (parse-options))
+         (update?      (assoc-ref opts 'update?))
+         (key-download (assoc-ref opts 'key-download))
+         (packages
+          (match (concatenate
+                  (filter-map (match-lambda
+                               (('argument . value)
+                                (let ((p (find-packages-by-name value)))
+                                  (unless p
+                                    (leave (_ "~a: no package by that name")
+                                           value))
+                                  p))
+                               (_ #f))
+                              opts))
+                 (()                          ; default to all packages
+                  (let ((select? (match (assoc-ref opts 'select)
+                                        ('core core-package?)
+                                        ('non-core (negate core-package?))
+                                        (_ (const #t)))))
+                    ;; TODO: Keep only the newest of each package.
+                    (fold-packages (lambda (package result)
+                                     (if (select? package)
+                                         (cons package result)
+                                         result))
+                                   '())))
+                 (some                        ; user-specified packages
+                  some))))
     (with-error-handling
       (if update?
           (let ((store (open-connection)))
@@ -195,7 +214,9 @@ update would trigger a complete rebuild."
                            (%gpg-command
                             (or (assoc-ref opts 'gpg-command)
                                 (%gpg-command))))
-              (for-each (cut update-package store <>) packages)))
+              (for-each
+               (cut update-package store <> #:key-download key-download)
+               packages)))
           (for-each (lambda (package)
                       (match (false-if-exception (package-update-path package))
                         ((new-version . directory)