summaryrefslogtreecommitdiff
path: root/guix/gnupg.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-04-24 23:48:36 +0200
committerLudovic Courtès <ludo@gnu.org>2013-04-25 00:13:56 +0200
commit0fdd3bea58a872f2734c7d8747d7dbdd108d97d8 (patch)
tree368a1a86567c24d201c312efa2198b9d9246b9aa /guix/gnupg.scm
parentf903dc056a5176033daca7a69d5b2c8376ff0677 (diff)
Add `guix refresh' and related auto-update tools.
* guix/gnu-maintenance.scm (ftp-server/directory)[quirks]: Add glib. (package-update-path, download-tarball, package-update, update-package-source): New procedures. * guix/gnupg.scm, guix/scripts/refresh.scm: New files. * Makefile.am (MODULES): Add them. * guix/utils.scm (file-extension): New procedure.
Diffstat (limited to 'guix/gnupg.scm')
-rw-r--r--guix/gnupg.scm152
1 files changed, 152 insertions, 0 deletions
diff --git a/guix/gnupg.scm b/guix/gnupg.scm
new file mode 100644
index 0000000000..ee67bea91b
--- /dev/null
+++ b/guix/gnupg.scm
@@ -0,0 +1,152 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2010, 2011, 2013 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix gnupg)
+ #:use-module (ice-9 popen)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 regex)
+ #:use-module (ice-9 rdelim)
+ #:use-module (srfi srfi-1)
+ #:export (gnupg-verify
+ gnupg-verify*
+ gnupg-status-good-signature?
+ gnupg-status-missing-key?))
+
+;;; Commentary:
+;;;
+;;; GnuPG interface.
+;;;
+;;; Code:
+
+(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 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 expkeysig-rx ; good signature, but expired key
+ (make-regexp "^\\[GNUPG:\\] EXPKEYSIG ([[:xdigit:]]+) (.*)$"))
+ (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 expkeysig-rx line)
+ =>
+ (lambda (match)
+ `(expired-key-signature ,(match:substring match 1) ; fingerprint
+ ,(match:substring match 2)))) ; user name
+ ((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)))
+ ;; Ignore PIPE's exit status since STATUS above should contain all the
+ ;; info we need.
+ (close-pipe pipe)
+ 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
+ (((or 'good-signature 'expired-key-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 server)
+ (system* %gpg-command "--keyserver" server "--recv-keys" key-id))
+
+(define* (gnupg-verify* sig file #:optional (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."
+ (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))))))))
+
+;;; gnupg.scm ends here