[PATCH] guix refresh: Add '--key-download'.

[Nikita Karetnikov <nikita@karetnikov.org>]

[-- Attachment #1.1: Type: text/plain, Size: 6595 bytes --]

> First the whole string should be enclosed in (_ ...), otherwise xgettext
> will just extract "~a~a" for translation.

Should I do the same here?

+                  (match arg
+                    ((or "interactive" "always" "never")
+                     (alist-cons 'key-download (string->symbol arg)
+                                 result))

> Perhaps change it to

>   #:key (key-download 'interactive)

I've tried that, but things like (package-update #:key-download
key-download) don't look right.  Here is a simplified example:

;; guix/scripts/refresh.scm
(define* (update-package #:key (key-download 'interactive))
  (package-update #:key-download key-download))

;; guix/gnu-maintenance.scm
(define* (download-tarball #:key (key-download 'interactive))
  (gnupg-verify* #:key-download key-download))

(define* (package-update #:key (key-download 'interactive))
  (download-tarball #:key-download key-download))

;; guix/gnupg.scm
(define* (gnupg-verify* #:key (key-download 'interactive))
  (begin (display key-download)
         (newline)))

scheme@(guile-user)> (update-package)
interactive
scheme@(guile-user)> (update-package #:key-download 'never)
never

> > +          (define (receive?)
> > +            (string=? "y"               ; XXX: i18n

> Guile’s (ice-9 i18n) exports ‘locale-yes-regexp’ and ‘locale-no-regexp’
> (info "(guile) Accessing Locale Information").

Is it fine now?

I'm attaching a patch.  Examples (some commands were omitted):

# ./pre-inst-env guix refresh -u

[...]

ftp://ftp.gnu.org/.../guile-2.0.9.tar.gz.sig	100.0% of 0.2 KiB
gpg: Signature made Wed 10 Apr 2013 06:14:45 AM UTC using DSA key ID EA52ECF4
gpg: Can't check signature: No public key
Would you like to download this key and add it to your keyring?
n
guix refresh: warning: signature verification failed for `guile-2.0.9.tar.gz'
guix refresh: warning: (could be because the public key is not in your keyring)

Should I prepend "guix refresh: " to the question?

# ./pre-inst-env guix refresh -u

[...]

ftp://ftp.gnu.org/.../guile-2.0.9.tar.gz.sig	100.0% of 0.2 KiB
gpg: Signature made Wed 10 Apr 2013 06:14:45 AM UTC using DSA key ID EA52ECF4
gpg: Can't check signature: No public key
Would you like to download this key and add it to your keyring?
y
gpg: requesting key EA52ECF4 from hkp server pgp.mit.edu
gpg: key EA52ECF4: public key "Ludovic Courtès <ludo@gnu.org>" imported
gpg: no ultimately trusted keys found
gpg: Total number processed: 1
gpg:               imported: 1
gpg: Signature made Wed 10 Apr 2013 06:14:45 AM UTC using DSA key ID EA52ECF4
gpg: Good signature from "Ludovic Courtès <ludo@gnu.org>"
gpg:                 aka "Ludovic Courtès <ludo@chbouib.org>"
gpg:                 aka "Ludovic Courtès <lcourtes@altern.org>"
gpg:                 aka "Ludovic Courtès (INRIA) <ludovic.courtes@inria.fr>"
gpg: WARNING: This key is not certified with a trusted signature!
gpg:          There is no indication that the signature belongs to the owner.
Primary key fingerprint: 83C4 F8E5 10A3 3B4C 5BEA  D15D 77DD 95E2 EA52 ECF4
gnu/packages/guile.scm:49:12: guile: updating from version 1.8.8 to version 2.0.9...

# ./pre-inst-env guix refresh -u --key-download=never

[...]

ftp://ftp.gnu.org/.../guile-2.0.9.tar.gz.sig	100.0% of 0.2 KiB
gpg: Signature made Wed 10 Apr 2013 06:14:45 AM UTC using DSA key ID EA52ECF4
gpg: Can't check signature: No public key
guix refresh: warning: signature verification failed for `guile-2.0.9.tar.gz'
guix refresh: warning: (could be because the public key is not in your keyring)

# ./pre-inst-env guix refresh -u --key-download=always

[...]

ftp://ftp.gnu.org/.../guile-2.0.9.tar.gz.sig	100.0% of 0.2 KiB
gpg: Signature made Wed 10 Apr 2013 06:14:45 AM UTC using DSA key ID EA52ECF4
gpg: Can't check signature: No public key
gpg: requesting key EA52ECF4 from hkp server pgp.mit.edu
gpg: key EA52ECF4: public key "Ludovic Courtès <ludo@gnu.org>" imported
gpg: no ultimately trusted keys found
gpg: Total number processed: 1
gpg:               imported: 1
gpg: Signature made Wed 10 Apr 2013 06:14:45 AM UTC using DSA key ID EA52ECF4
gpg: Good signature from "Ludovic Courtès <ludo@gnu.org>"
gpg:                 aka "Ludovic Courtès <ludo@chbouib.org>"
gpg:                 aka "Ludovic Courtès <lcourtes@altern.org>"
gpg:                 aka "Ludovic Courtès (INRIA) <ludovic.courtes@inria.fr>"
gpg: WARNING: This key is not certified with a trusted signature!
gpg:          There is no indication that the signature belongs to the owner.
Primary key fingerprint: 83C4 F8E5 10A3 3B4C 5BEA  D15D 77DD 95E2 EA52 ECF4
gnu/packages/guile.scm:49:12: guile: updating from version 1.8.8 to version 2.0.9...

# ./pre-inst-env guix refresh -u --key-download=interactive

ftp://ftp.gnu.org/.../guile-2.0.9.tar.gz.sig	100.0% of 0.2 KiB
gpg: Signature made Wed 10 Apr 2013 06:14:45 AM UTC using DSA key ID EA52ECF4
gpg: Can't check signature: No public key
Would you like to download this key and add it to your keyring?
n
guix refresh: warning: signature verification failed for `guile-2.0.9.tar.gz'
guix refresh: warning: (could be because the public key is not in your keyring)

# ./pre-inst-env guix refresh -u --key-download=interactive

ftp://ftp.gnu.org/.../guile-2.0.9.tar.gz.sig	100.0% of 0.2 KiB
gpg: Signature made Wed 10 Apr 2013 06:14:45 AM UTC using DSA key ID EA52ECF4
gpg: Can't check signature: No public key
Would you like to download this key and add it to your keyring?
y
gpg: requesting key EA52ECF4 from hkp server pgp.mit.edu
gpg: key EA52ECF4: public key "Ludovic Courtès <ludo@gnu.org>" imported
gpg: no ultimately trusted keys found
gpg: Total number processed: 1
gpg:               imported: 1
gpg: Signature made Wed 10 Apr 2013 06:14:45 AM UTC using DSA key ID EA52ECF4
gpg: Good signature from "Ludovic Courtès <ludo@gnu.org>"
gpg:                 aka "Ludovic Courtès <ludo@chbouib.org>"
gpg:                 aka "Ludovic Courtès <lcourtes@altern.org>"
gpg:                 aka "Ludovic Courtès (INRIA) <ludovic.courtes@inria.fr>"
gpg: WARNING: This key is not certified with a trusted signature!
gpg:          There is no indication that the signature belongs to the owner.
Primary key fingerprint: 83C4 F8E5 10A3 3B4C 5BEA  D15D 77DD 95E2 EA52 ECF4
gnu/packages/guile.scm:49:12: guile: updating from version 1.8.8 to version 2.0.9...

# ./pre-inst-env guix refresh -u --key-download=foo
guix refresh: error: unsupported policy: foo


[-- Attachment #1.2: 0001-guix-refresh-Add-key-download.patch --]
[-- Type: text/x-diff, Size: 12099 bytes --]

From 394191811139e66183309bc44979b146d6a9f969 Mon Sep 17 00:00:00 2001
From: Nikita Karetnikov <nikita@karetnikov.org>
Date: Fri, 7 Jun 2013 04:14:17 +0000
Subject: [PATCH] guix refresh: Add  '--key-download'.

* guix/gnu-maintenance.scm (download-tarball, package-update): Add
  'key-download'.
  guix/gnupg.scm (gnupg-verify*): Add 'key-download' and adjust
  'gnupg-verify*' accordingly.
  guix/scripts/refresh.scm (show-help, %options): Add and document
  '--key-download'.
  (update-package): Add 'key-download'.
  (guix-refresh): Adjust to handle 'key-download'.
---
 guix/gnu-maintenance.scm |   17 ++++++---
 guix/gnupg.scm           |   38 ++++++++++++++++++----
 guix/scripts/refresh.scm |   79 +++++++++++++++++++++++++++++-----------------
 3 files changed, 92 insertions(+), 42 deletions(-)

diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index b54cd84..0f1a05b 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -341,16 +341,19 @@ pairs.  Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
          (_ #f))))
 
 (define* (download-tarball store project directory version
-                           #:optional (archive-type "gz"))
+                           #:optional (archive-type "gz")
+                                      (key-download 'interactive))
   "Download PROJECT's tarball over FTP and check its OpenPGP signature.  On
-success, return the tarball file name."
+success, return the tarball file name.  KEY-DOWNLOAD specifies a download
+policy for missing OpenPGP keys; allowed values: INTERACTIVE (default),
+ALWAYS, and NEVER."
   (let* ((server  (ftp-server/directory project))
          (base    (string-append project "-" version ".tar." archive-type))
          (url     (string-append "ftp://" server "/" directory "/" base))
          (sig-url (string-append url ".sig"))
          (tarball (download-to-store store url))
          (sig     (download-to-store store sig-url)))
-    (let ((ret (gnupg-verify* sig tarball)))
+    (let ((ret (gnupg-verify* sig tarball key-download)))
       (if ret
           tarball
           (begin
@@ -359,9 +362,11 @@ success, return the tarball file name."
             (warning (_ "(could be because the public key is not in your keyring)~%"))
             #f)))))
 
-(define (package-update store package)
+(define* (package-update store package #:optional (key-download 'interactive))
   "Return the new version and the file name of the new version tarball for
-PACKAGE, or #f and #f when PACKAGE is up-to-date."
+PACKAGE, or #f and #f when PACKAGE is up-to-date.  KEY-DOWNLOAD specifies a
+download policy for missing OpenPGP keys; allowed values: ALWAYS, NEVER, and
+INTERACTIVE (default)."
   (match (package-update-path package)
     ((version . directory)
      (let-values (((name)
@@ -372,7 +377,7 @@ PACKAGE, or #f and #f when PACKAGE is up-to-date."
                               (file-extension (origin-uri source)))
                          "gz"))))
        (let ((tarball (download-tarball store name directory version
-                                        archive-type)))
+                                        archive-type key-download)))
          (values version tarball))))
     (_
      (values #f #f))))
diff --git a/guix/gnupg.scm b/guix/gnupg.scm
index c17a495..5396f20 100644
--- a/guix/gnupg.scm
+++ b/guix/gnupg.scm
@@ -21,7 +21,9 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 i18n)
   #:use-module (srfi srfi-1)
+  #:use-module (guix ui)
   #:export (%gpg-command
             %openpgp-key-server
             gnupg-verify
@@ -145,16 +147,38 @@ missing key."
 (define (gnupg-receive-keys key-id server)
   (system* (%gpg-command) "--keyserver" server "--recv-keys" key-id))
 
-(define* (gnupg-verify* sig file #:optional (server (%openpgp-key-server)))
+(define* (gnupg-verify* sig file
+                        #:optional (key-download 'interactive)
+                                   (server (%openpgp-key-server)))
   "Like `gnupg-verify', but try downloading the public key if it's missing.
-Return #t if the signature was good, #f otherwise."
+Return #t if the signature was good, #f otherwise.  KEY-DOWNLOAD specifies a
+download policy for missing OpenPGP keys; allowed values: ALWAYS, NEVER, and
+INTERACTIVE (default)."
   (let ((status (gnupg-verify sig file)))
     (or (gnupg-status-good-signature? status)
         (let ((missing (gnupg-status-missing-key? status)))
-          (and missing
-               (begin
-                 ;; Download the missing key and try again.
-                 (gnupg-receive-keys missing server)
-                 (gnupg-status-good-signature? (gnupg-verify sig file))))))))
+          (define (download-and-try-again)
+            (begin
+              ;; Download the missing key and try again.
+              (gnupg-receive-keys missing server)
+              (gnupg-status-good-signature? (gnupg-verify sig file))))
+
+          (define (receive?)
+            (let ((answer
+                   (_ (begin (format #t "~a~a~%"
+                                     "Would you like to download this key "
+                                     "and add it to your keyring?")
+                             (read-line)))))
+              (string-match (locale-yes-regexp) answer)))
+
+          (and
+           missing
+           (case key-download
+             ((never) #f)
+             ((always)
+              (download-and-try-again))
+             (else
+              (and (receive?)
+                   (download-and-try-again)))))))))
 
 ;;; gnupg.scm ends here
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index 10715eb..f54b5ad 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 #:optional (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))
                   (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)
+               packages)))
           (for-each (lambda (package)
                       (match (false-if-exception (package-update-path package))
                         ((new-version . directory)
-- 
1.7.5.4


[-- Attachment #2: Type: application/pgp-signature, Size: 835 bytes --]