gnupdate: Automatically download missing OpenPGP keys.

* maintainers/scripts/gnu/gnupdate (%gpg-command, %openpgp-key-server):
  New variables.
  (gnupg-verify, gnupg-status-good-signature?,
  gnupg-status-missing-key?, gnupg-receive-keys, gnupg-verify*): New
  procedures.
  (fetch-gnu): Use `gnupg-verify*'.

svn path=/nixpkgs/trunk/; revision=29014

1 files changed, 116 insertions, 2 deletions

diff --git a/maintainers/scripts/gnu/gnupdate b/maintainers/scripts/gnu/gnupdate
index 6e89542ec5757..9a1edda50937b 100755
--- a/maintainers/scripts/gnu/gnupdate
+++ b/maintainers/scripts/gnu/gnupdate
@@ -402,6 +402,120 @@ replaced by the result of their application to DERIVATIONS, a vhash."
 
 
 ;;;
+;;; GnuPG interface.
+;;;
+
+(define %gpg-command "gpg2")
+(define %openpgp-key-server "keys.gnupg.net")
+
+(define (gnupg-verify sig file)
+  "Verify signature SIG for FILE.  Return a status s-exp or #f if GnuPG
+failed."
+
+  (define (status-line->sexp line)
+    ;; See file `doc/DETAILS' in GnuPG.
+    (define sigid-rx
+      (make-regexp
+       "^\\[GNUPG:\\] SIG_ID ([A-Za-z0-9/]+) ([[:digit:]]{4}-[[:digit:]]{2}-[[:digit:]]{2}) ([[:digit:]]+)"))
+    (define goodsig-rx
+      (make-regexp "^\\[GNUPG:\\] GOODSIG ([[:xdigit:]]+) (.+)$"))
+    (define validsig-rx
+      (make-regexp
+       "^\\[GNUPG:\\] VALIDSIG ([[:xdigit:]]+) ([[:digit:]]{4}-[[:digit:]]{2}-[[:digit:]]{2}) ([[:digit:]]+) .*$"))
+    (define errsig-rx
+      (make-regexp
+       "^\\[GNUPG:\\] ERRSIG ([[:xdigit:]]+) ([^ ]+) ([^ ]+) ([^ ]+) ([[:digit:]]+) ([[:digit:]]+)"))
+
+    (cond ((regexp-exec sigid-rx line)
+           =>
+           (lambda (match)
+             `(signature-id ,(match:substring match 1) ; sig id
+                            ,(match:substring match 2) ; date
+                            ,(string->number      ; timestamp
+                              (match:substring match 3)))))
+          ((regexp-exec goodsig-rx line)
+           =>
+           (lambda (match)
+             `(good-signature ,(match:substring match 1) ; key id
+                              ,(match:substring match 2)))) ; user name
+          ((regexp-exec validsig-rx line)
+           =>
+           (lambda (match)
+             `(valid-signature ,(match:substring match 1) ; fingerprint
+                               ,(match:substring match 2) ; sig creation date
+                               ,(string->number   ; timestamp
+                                 (match:substring match 3)))))
+          ((regexp-exec errsig-rx line)
+           =>
+           (lambda (match)
+             `(signature-error ,(match:substring match 1) ; key id or fingerprint
+                               ,(match:substring match 2) ; pubkey algo
+                               ,(match:substring match 3) ; hash algo
+                               ,(match:substring match 4) ; sig class
+                               ,(string->number   ; timestamp
+                                 (match:substring match 5))
+                               ,(let ((rc
+                                       (string->number ; return code
+                                        (match:substring match 6))))
+                                  (case rc
+                                    ((9) 'missing-key)
+                                    ((4) 'unknown-algorithm)
+                                    (else rc))))))
+          (else
+           `(unparsed-line ,line))))
+
+  (define (parse-status input)
+    (let loop ((line   (read-line input))
+               (result '()))
+      (if (eof-object? line)
+          (reverse result)
+          (loop (read-line input)
+                (cons (status-line->sexp line) result)))))
+
+  (let* ((pipe   (open-pipe* OPEN_READ %gpg-command "--status-fd=1"
+                             "--verify" sig file))
+         (status (parse-status pipe)))
+    (if (pipe-failed? pipe)
+        #f
+        status)))
+
+(define (gnupg-status-good-signature? status)
+  "If STATUS, as returned by `gnupg-verify', denotes a good signature, return
+a key-id/user pair; return #f otherwise."
+  (any (lambda (sexp)
+         (match sexp
+           (('good-signature key-id user)
+            (cons key-id user))
+           (_ #f)))
+       status))
+
+(define (gnupg-status-missing-key? status)
+  "If STATUS denotes a missing-key error, then return the key-id of the
+missing key."
+  (any (lambda (sexp)
+         (match sexp
+           (('signature-error key-id _ ...)
+            key-id)
+           (_ #f)))
+       status))
+
+(define (gnupg-receive-keys key-id)
+  (system* %gpg-command "--keyserver" %openpgp-key-server "--recv-keys" key-id))
+
+(define (gnupg-verify* sig file)
+  "Like `gnupg-verify', but try downloading the public key if it's missing.
+Return #t if the signature was good, #f otherwise."
+  (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)
+                 (gnupg-status-good-signature? (gnupg-verify sig file))))))))
+
+
+;;;
 ;;; FTP client.
 ;;;
 
@@ -815,9 +929,9 @@ pairs.  Example: (\"mit-scheme-9.0.1\" . \"/gnu/mit-scheme/stable.pkg/9.0.1\").
              (false-if-exception (delete-file sig))
              (system* "wget" sig-url)
              (if (file-exists? sig)
-                 (let ((ret (system* "gpg" "--verify" sig path)))
+                 (let ((ret (gnupg-verify* sig path)))
                    (false-if-exception (delete-file sig))
-                   (if (and ret (= 0 (status:exit-val ret)))
+                   (if ret
                        hash
                        (begin
                          (format (current-error-port)