1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2010, 2011, 2013, 2014, 2016, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
3 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
5 ;;; This file is part of GNU Guix.
7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
8 ;;; under the terms of the GNU General Public License as published by
9 ;;; the Free Software Foundation; either version 3 of the License, or (at
10 ;;; your option) any later version.
12 ;;; GNU Guix is distributed in the hope that it will be useful, but
13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;;; GNU General Public License for more details.
17 ;;; You should have received a copy of the GNU General Public License
18 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
20 (define-module (guix gnupg)
21 #:use-module (ice-9 popen)
22 #:use-module (ice-9 match)
23 #:use-module (ice-9 regex)
24 #:use-module (ice-9 rdelim)
25 #:use-module (ice-9 i18n)
26 #:use-module (srfi srfi-1)
27 #:use-module (guix i18n)
28 #:use-module ((guix utils) #:select (config-directory))
29 #:use-module ((guix build utils) #:select (mkdir-p))
30 #:export (%gpg-command
35 gnupg-status-good-signature?
36 gnupg-status-missing-key?))
45 ;; The GnuPG 2.x command-line program name.
46 (make-parameter (or (getenv "GUIX_GPG_COMMAND") "gpg")))
49 ;; The 'gpgv' program.
50 (make-parameter (or (getenv "GUIX_GPGV_COMMAND") "gpgv")))
52 (define current-keyring
53 ;; The default keyring of "trusted keys".
54 (make-parameter (string-append (config-directory #:ensure? #f)
55 "/gpg/trustedkeys.kbx")))
57 (define %openpgp-key-server
58 ;; The default key server. Note that keys.gnupg.net appears to be
60 (make-parameter "pool.sks-keyservers.net"))
62 ;; Regexps for status lines. See file `doc/DETAILS' in GnuPG.
66 "^\\[GNUPG:\\] SIG_ID ([A-Za-z0-9+/]+) ([[:digit:]]{4}-[[:digit:]]{2}-[[:digit:]]{2}) ([[:digit:]]+)"))
68 (make-regexp "^\\[GNUPG:\\] GOODSIG ([[:xdigit:]]+) (.+)$"))
71 "^\\[GNUPG:\\] VALIDSIG ([[:xdigit:]]+) ([[:digit:]]{4}-[[:digit:]]{2}-[[:digit:]]{2}) ([[:digit:]]+) .*$"))
72 (define expkeysig-rx ; good signature, but expired key
73 (make-regexp "^\\[GNUPG:\\] EXPKEYSIG ([[:xdigit:]]+) (.*)$"))
75 ;; Note: The fingeprint part (the last element of the line) appeared in
76 ;; GnuPG 2.2.7 according to 'doc/DETAILS', and it may be missing.
78 "^\\[GNUPG:\\] ERRSIG ([[:xdigit:]]+) ([^ ]+) ([^ ]+) ([^ ]+) ([[:digit:]]+) ([[:digit:]]+)(.*)"))
81 (define* (gnupg-verify sig file
82 #:optional (keyring (current-keyring)))
83 "Verify signature SIG for FILE against the keys in KEYRING. All the keys in
84 KEYRING as assumed to be \"trusted\", whether or not they expired or were
85 revoked. Return a status s-exp if GnuPG failed."
87 (define (maybe-fingerprint str)
88 (match (string-trim-both str)
92 (define (status-line->sexp line)
93 (cond ((regexp-exec sigid-rx line)
96 `(signature-id ,(match:substring match 1) ; sig id
97 ,(match:substring match 2) ; date
98 ,(string->number ; timestamp
99 (match:substring match 3)))))
100 ((regexp-exec goodsig-rx line)
103 `(good-signature ,(match:substring match 1) ; key id
104 ,(match:substring match 2)))) ; user name
105 ((regexp-exec validsig-rx line)
108 `(valid-signature ,(match:substring match 1) ; fingerprint
109 ,(match:substring match 2) ; sig creation date
110 ,(string->number ; timestamp
111 (match:substring match 3)))))
112 ((regexp-exec expkeysig-rx line)
115 `(expired-key-signature ,(match:substring match 1) ; fingerprint
116 ,(match:substring match 2)))) ; user name
117 ((regexp-exec errsig-rx line)
120 `(signature-error ,(match:substring match 1) ; key id
121 ,(match:substring match 2) ; pubkey algo
122 ,(match:substring match 3) ; hash algo
123 ,(match:substring match 4) ; sig class
124 ,(string->number ; timestamp
125 (match:substring match 5))
127 (string->number ; return code
128 (match:substring match 6))))
131 ((4) 'unknown-algorithm)
133 ,(maybe-fingerprint ; fingerprint or #f
134 (match:substring match 7)))))
136 `(unparsed-line ,line))))
138 (define (parse-status input)
139 (let loop ((line (read-line input))
141 (if (eof-object? line)
143 (loop (read-line input)
144 (cons (status-line->sexp line) result)))))
146 (let* ((pipe (open-pipe* OPEN_READ (%gpgv-command) "--status-fd=1"
147 "--keyring" keyring sig file))
148 (status (parse-status pipe)))
149 ;; Ignore PIPE's exit status since STATUS above should contain all the
154 (define (gnupg-status-good-signature? status)
155 "If STATUS, as returned by `gnupg-verify', denotes a good signature, return
156 a fingerprint/user pair; return #f otherwise."
157 (match (assq 'valid-signature status)
158 (('valid-signature fingerprint date timestamp)
159 (match (or (assq 'good-signature status)
160 (assq 'expired-key-signature status))
161 ((_ key-id user) (cons fingerprint user))
166 (define (gnupg-status-missing-key? status)
167 "If STATUS denotes a missing-key error, then return the fingerprint of the
168 missing key or its key id if the fingerprint is unavailable."
171 (('signature-error key-id _ ... 'missing-key fingerprint)
172 (or fingerprint key-id))
176 (define* (gnupg-receive-keys fingerprint/key-id server
177 #:optional (keyring (current-keyring)))
178 "Download FINGERPRINT/KEY-ID from SERVER, a key server, and add it to
180 (unless (file-exists? keyring)
181 (mkdir-p (dirname keyring))
182 (call-with-output-file keyring (const #t))) ;create an empty keybox
184 (zero? (system* (%gpg-command) "--keyserver" server
185 "--no-default-keyring" "--keyring" keyring
186 "--recv-keys" fingerprint/key-id)))
188 (define* (gnupg-verify* sig file
190 (key-download 'interactive)
191 (server (%openpgp-key-server))
192 (keyring (current-keyring)))
193 "Like `gnupg-verify', but try downloading the public key if it's missing.
194 Return two values: 'valid-signature and a fingerprint/name pair upon success,
195 'missing-key and a fingerprint if the key could not be found, and
196 'invalid-signature with a fingerprint if the signature is invalid.
198 KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed
199 values: 'always', 'never', and 'interactive' (default). Return a
200 fingerprint/user name pair on success and #f otherwise."
201 (let ((status (gnupg-verify sig file)))
202 (match (gnupg-status-good-signature? status)
203 ((fingerprint . user)
204 (values 'valid-signature (cons fingerprint user)))
206 (let ((missing (gnupg-status-missing-key? status)))
207 (define (download-and-try-again)
208 ;; Download the missing key and try again.
209 (if (gnupg-receive-keys missing server keyring)
210 (match (gnupg-status-good-signature?
211 (gnupg-verify sig file keyring))
213 (values 'invalid-signature missing))
214 ((fingerprint . user)
215 (values 'valid-signature
216 (cons fingerprint user))))
217 (values 'missing-key missing)))
222 (format #t (G_ "Would you like to add this key \
226 (string-match (locale-yes-regexp) answer)))
230 (values 'missing-key missing))
232 (download-and-try-again))
235 (download-and-try-again)
236 (values 'missing-key missing)))))))))
238 ;;; gnupg.scm ends here