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>
4 ;;; Copyright © 2020 Tobias Geerinckx-Rice <me@tobias.gr>
6 ;;; This file is part of GNU Guix.
8 ;;; GNU Guix is free software; you can redistribute it and/or modify it
9 ;;; under the terms of the GNU General Public License as published by
10 ;;; the Free Software Foundation; either version 3 of the License, or (at
11 ;;; your option) any later version.
13 ;;; GNU Guix is distributed in the hope that it will be useful, but
14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;;; GNU General Public License for more details.
18 ;;; You should have received a copy of the GNU General Public License
19 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
21 (define-module (guix gnupg)
22 #:use-module (ice-9 popen)
23 #:use-module (ice-9 match)
24 #:use-module (ice-9 regex)
25 #:use-module (ice-9 rdelim)
26 #:use-module (ice-9 i18n)
27 #:use-module (srfi srfi-1)
28 #:use-module (guix i18n)
29 #:use-module ((guix utils) #:select (config-directory))
30 #:use-module ((guix build utils) #:select (mkdir-p))
31 #:export (%gpg-command
36 gnupg-status-good-signature?
37 gnupg-status-missing-key?))
46 ;; The GnuPG 2.x command-line program name.
47 (make-parameter (or (getenv "GUIX_GPG_COMMAND") "gpg")))
50 ;; The 'gpgv' program.
51 (make-parameter (or (getenv "GUIX_GPGV_COMMAND") "gpgv")))
53 (define current-keyring
54 ;; The default keyring of "trusted keys".
55 (make-parameter (string-append (config-directory #:ensure? #f)
56 "/gpg/trustedkeys.kbx")))
58 (define %openpgp-key-server
59 ;; The default key server. Note that keys.gnupg.net appears to be
61 (make-parameter "pool.sks-keyservers.net"))
63 ;; Regexps for status lines. See file `doc/DETAILS' in GnuPG.
67 "^\\[GNUPG:\\] SIG_ID ([A-Za-z0-9+/]+) ([[:digit:]]{4}-[[:digit:]]{2}-[[:digit:]]{2}) ([[:digit:]]+)"))
69 (make-regexp "^\\[GNUPG:\\] GOODSIG ([[:xdigit:]]+) (.+)$"))
72 "^\\[GNUPG:\\] VALIDSIG ([[:xdigit:]]+) ([[:digit:]]{4}-[[:digit:]]{2}-[[:digit:]]{2}) ([[:digit:]]+) .*$"))
73 (define expkeysig-rx ; good signature, but expired key
74 (make-regexp "^\\[GNUPG:\\] EXPKEYSIG ([[:xdigit:]]+) (.*)$"))
75 (define revkeysig-rx ; good signature, but revoked key
76 (make-regexp "^\\[GNUPG:\\] REVKEYSIG ([[:xdigit:]]+) (.*)$"))
78 ;; Note: The fingeprint part (the last element of the line) appeared in
79 ;; GnuPG 2.2.7 according to 'doc/DETAILS', and it may be missing.
81 "^\\[GNUPG:\\] ERRSIG ([[:xdigit:]]+) ([^ ]+) ([^ ]+) ([^ ]+) ([[:digit:]]+) ([[:digit:]]+)(.*)"))
84 (define* (gnupg-verify sig file
85 #:optional (keyring (current-keyring)))
86 "Verify signature SIG for FILE against the keys in KEYRING. All the keys in
87 KEYRING as assumed to be \"trusted\", whether or not they expired or were
88 revoked. Return a status s-exp if GnuPG failed."
90 (define (maybe-fingerprint str)
91 (match (string-trim-both str)
95 (define (status-line->sexp line)
96 (cond ((regexp-exec sigid-rx line)
99 `(signature-id ,(match:substring match 1) ; sig id
100 ,(match:substring match 2) ; date
101 ,(string->number ; timestamp
102 (match:substring match 3)))))
103 ((regexp-exec goodsig-rx line)
106 `(good-signature ,(match:substring match 1) ; key id
107 ,(match:substring match 2)))) ; user name
108 ((regexp-exec validsig-rx line)
111 `(valid-signature ,(match:substring match 1) ; fingerprint
112 ,(match:substring match 2) ; sig creation date
113 ,(string->number ; timestamp
114 (match:substring match 3)))))
115 ((regexp-exec expkeysig-rx line)
118 `(expired-key-signature ,(match:substring match 1) ; fingerprint
119 ,(match:substring match 2)))) ; user name
120 ((regexp-exec revkeysig-rx line)
123 `(revoked-key-signature ,(match:substring match 1) ; fingerprint
124 ,(match:substring match 2)))) ; user name
125 ((regexp-exec errsig-rx line)
128 `(signature-error ,(match:substring match 1) ; key id
129 ,(match:substring match 2) ; pubkey algo
130 ,(match:substring match 3) ; hash algo
131 ,(match:substring match 4) ; sig class
132 ,(string->number ; timestamp
133 (match:substring match 5))
135 (string->number ; return code
136 (match:substring match 6))))
139 ((4) 'unknown-algorithm)
141 ,(maybe-fingerprint ; fingerprint or #f
142 (match:substring match 7)))))
144 `(unparsed-line ,line))))
146 (define (parse-status input)
147 (let loop ((line (read-line input))
149 (if (eof-object? line)
151 (loop (read-line input)
152 (cons (status-line->sexp line) result)))))
154 (let* ((pipe (open-pipe* OPEN_READ (%gpgv-command) "--status-fd=1"
155 "--keyring" keyring sig file))
156 (status (parse-status pipe)))
157 ;; Ignore PIPE's exit status since STATUS above should contain all the
162 (define (gnupg-status-good-signature? status)
163 "If STATUS, as returned by `gnupg-verify', denotes a good signature, return
164 a fingerprint/user pair; return #f otherwise."
165 (match (assq 'valid-signature status)
166 (('valid-signature fingerprint date timestamp)
167 (match (or (assq 'good-signature status)
168 (assq 'expired-key-signature status)
169 (assq 'revoked-key-signature status))
170 ((_ key-id user) (cons fingerprint user))
175 (define (gnupg-status-missing-key? status)
176 "If STATUS denotes a missing-key error, then return the fingerprint of the
177 missing key or its key id if the fingerprint is unavailable."
180 (('signature-error key-id _ ... 'missing-key fingerprint)
181 (or fingerprint key-id))
185 (define* (gnupg-receive-keys fingerprint/key-id server
186 #:optional (keyring (current-keyring)))
187 "Download FINGERPRINT/KEY-ID from SERVER, a key server, and add it to
189 (unless (file-exists? keyring)
190 (mkdir-p (dirname keyring))
191 (call-with-output-file keyring (const #t))) ;create an empty keybox
193 (zero? (system* (%gpg-command) "--keyserver" server
194 "--no-default-keyring" "--keyring" keyring
195 "--recv-keys" fingerprint/key-id)))
197 (define* (gnupg-verify* sig file
199 (key-download 'interactive)
200 (server (%openpgp-key-server))
201 (keyring (current-keyring)))
202 "Like `gnupg-verify', but try downloading the public key if it's missing.
203 Return two values: 'valid-signature and a fingerprint/name pair upon success,
204 'missing-key and a fingerprint if the key could not be found, and
205 'invalid-signature with a fingerprint if the signature is invalid.
207 KEY-DOWNLOAD specifies a download policy for missing OpenPGP keys; allowed
208 values: 'always', 'never', and 'interactive' (default). Return a
209 fingerprint/user name pair on success and #f otherwise."
210 (let ((status (gnupg-verify sig file)))
211 (match (gnupg-status-good-signature? status)
212 ((fingerprint . user)
213 (values 'valid-signature (cons fingerprint user)))
215 (let ((missing (gnupg-status-missing-key? status)))
216 (define (download-and-try-again)
217 ;; Download the missing key and try again.
218 (if (gnupg-receive-keys missing server keyring)
219 (match (gnupg-status-good-signature?
220 (gnupg-verify sig file keyring))
222 (values 'invalid-signature missing))
223 ((fingerprint . user)
224 (values 'valid-signature
225 (cons fingerprint user))))
226 (values 'missing-key missing)))
231 (format #t (G_ "Would you like to add this key \
235 (string-match (locale-yes-regexp) answer)))
239 (values 'missing-key missing))
241 (download-and-try-again))
244 (download-and-try-again)
245 (values 'missing-key missing)))))))))
247 ;;; gnupg.scm ends here