Commit | Line | Data |
---|---|---|
41f443c9 LC |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> | |
3 | ;;; | |
4 | ;;; This file is part of GNU Guix. | |
5 | ;;; | |
6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
7 | ;;; under the terms of the GNU General Public License as published by | |
8 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
9 | ;;; your option) any later version. | |
10 | ;;; | |
11 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | ;;; GNU General Public License for more details. | |
15 | ;;; | |
16 | ;;; You should have received a copy of the GNU General Public License | |
17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
18 | ||
19 | (define-module (guix git-authenticate) | |
20 | #:use-module (git) | |
21 | #:use-module (guix base16) | |
e7827560 | 22 | #:use-module ((guix git) #:select (false-if-git-not-found)) |
41f443c9 LC |
23 | #:use-module (guix i18n) |
24 | #:use-module (guix openpgp) | |
25 | #:use-module ((guix utils) | |
26 | #:select (cache-directory with-atomic-file-output)) | |
27 | #:use-module ((guix build utils) | |
28 | #:select (mkdir-p)) | |
29 | #:use-module (srfi srfi-1) | |
30 | #:use-module (srfi srfi-11) | |
31 | #:use-module (srfi srfi-26) | |
32 | #:use-module (srfi srfi-34) | |
33 | #:use-module (srfi srfi-35) | |
34 | #:use-module (rnrs bytevectors) | |
35 | #:use-module (rnrs io ports) | |
36 | #:use-module (ice-9 match) | |
37 | #:autoload (ice-9 pretty-print) (pretty-print) | |
38 | #:export (read-authorizations | |
39 | commit-signing-key | |
40 | commit-authorized-keys | |
41 | authenticate-commit | |
42 | authenticate-commits | |
43 | load-keyring-from-reference | |
44 | previously-authenticated-commits | |
f8213f1b LC |
45 | cache-authenticated-commit |
46 | ||
47 | git-authentication-error? | |
48 | git-authentication-error-commit | |
49 | unsigned-commit-error? | |
50 | unauthorized-commit-error? | |
51 | unauthorized-commit-error-signing-key | |
52 | signature-verification-error? | |
53 | signature-verification-error-keyring | |
54 | signature-verification-error-signature | |
55 | missing-key-error? | |
56 | missing-key-error-signature)) | |
41f443c9 LC |
57 | |
58 | ;;; Commentary: | |
59 | ;;; | |
60 | ;;; This module provides tools to authenticate a range of Git commits. A | |
61 | ;;; commit is considered "authentic" if and only if it is signed by an | |
62 | ;;; authorized party. Parties authorized to sign a commit are listed in the | |
63 | ;;; '.guix-authorizations' file of the parent commit. | |
64 | ;;; | |
65 | ;;; Code: | |
66 | ||
f8213f1b LC |
67 | (define-condition-type &git-authentication-error &error |
68 | git-authentication-error? | |
69 | (commit git-authentication-error-commit)) | |
70 | ||
71 | (define-condition-type &unsigned-commit-error &git-authentication-error | |
72 | unsigned-commit-error?) | |
73 | ||
74 | (define-condition-type &unauthorized-commit-error &git-authentication-error | |
75 | unauthorized-commit-error? | |
76 | (signing-key unauthorized-commit-error-signing-key)) | |
77 | ||
78 | (define-condition-type &signature-verification-error &git-authentication-error | |
79 | signature-verification-error? | |
80 | (signature signature-verification-error-signature) | |
81 | (keyring signature-verification-error-keyring)) | |
82 | ||
83 | (define-condition-type &missing-key-error &git-authentication-error | |
84 | missing-key-error? | |
85 | (signature missing-key-error-signature)) | |
86 | ||
87 | ||
52c529ff LC |
88 | (define* (commit-signing-key repo commit-id keyring |
89 | #:key (disallowed-hash-algorithms '(sha1))) | |
41f443c9 | 90 | "Return the OpenPGP key that signed COMMIT-ID (an OID). Raise an exception |
52c529ff LC |
91 | if the commit is unsigned, has an invalid signature, has a signature using one |
92 | of the hash algorithms in DISALLOWED-HASH-ALGORITHMS, or if its signing key is | |
41f443c9 LC |
93 | not in KEYRING." |
94 | (let-values (((signature signed-data) | |
95 | (catch 'git-error | |
96 | (lambda () | |
97 | (commit-extract-signature repo commit-id)) | |
98 | (lambda _ | |
99 | (values #f #f))))) | |
100 | (unless signature | |
101 | (raise (condition | |
f8213f1b | 102 | (&unsigned-commit-error (commit commit-id)) |
41f443c9 LC |
103 | (&message |
104 | (message (format #f (G_ "commit ~a lacks a signature") | |
f8213f1b | 105 | (oid->string commit-id))))))) |
41f443c9 LC |
106 | |
107 | (let ((signature (string->openpgp-packet signature))) | |
52c529ff LC |
108 | (when (memq (openpgp-signature-hash-algorithm signature) |
109 | `(,@disallowed-hash-algorithms md5)) | |
110 | (raise (condition | |
111 | (&unsigned-commit-error (commit commit-id)) | |
112 | (&message | |
113 | (message (format #f (G_ "commit ~a has a ~a signature, \ | |
114 | which is not permitted") | |
115 | (oid->string commit-id) | |
116 | (openpgp-signature-hash-algorithm | |
117 | signature))))))) | |
118 | ||
41f443c9 LC |
119 | (with-fluids ((%default-port-encoding "UTF-8")) |
120 | (let-values (((status data) | |
121 | (verify-openpgp-signature signature keyring | |
122 | (open-input-string signed-data)))) | |
123 | (match status | |
124 | ('bad-signature | |
125 | ;; There's a signature but it's invalid. | |
126 | (raise (condition | |
f8213f1b LC |
127 | (&signature-verification-error (commit commit-id) |
128 | (signature signature) | |
129 | (keyring keyring)) | |
41f443c9 LC |
130 | (&message |
131 | (message (format #f (G_ "signature verification failed \ | |
132 | for commit ~a") | |
133 | (oid->string commit-id))))))) | |
134 | ('missing-key | |
135 | (raise (condition | |
f8213f1b LC |
136 | (&missing-key-error (commit commit-id) |
137 | (signature signature)) | |
41f443c9 LC |
138 | (&message |
139 | (message (format #f (G_ "could not authenticate \ | |
140 | commit ~a: key ~a is missing") | |
141 | (oid->string commit-id) | |
142 | data)))))) | |
143 | ('good-signature data))))))) | |
144 | ||
145 | (define (read-authorizations port) | |
146 | "Read authorizations in the '.guix-authorizations' format from PORT, and | |
147 | return a list of authorized fingerprints." | |
148 | (match (read port) | |
149 | (('authorizations ('version 0) | |
150 | (((? string? fingerprints) _ ...) ...) | |
151 | _ ...) | |
152 | (map (lambda (fingerprint) | |
153 | (base16-string->bytevector | |
154 | (string-downcase (string-filter char-set:graphic fingerprint)))) | |
155 | fingerprints)))) | |
156 | ||
157 | (define* (commit-authorized-keys repository commit | |
158 | #:optional (default-authorizations '())) | |
159 | "Return the list of OpenPGP fingerprints authorized to sign COMMIT, based on | |
160 | authorizations listed in its parent commits. If one of the parent commits | |
161 | does not specify anything, fall back to DEFAULT-AUTHORIZATIONS." | |
e7827560 LC |
162 | (define (parents-have-authorizations-file? commit) |
163 | ;; Return true if at least one of the parents of COMMIT has the | |
164 | ;; '.guix-authorizations' file. | |
165 | (find (lambda (commit) | |
166 | (false-if-git-not-found | |
167 | (tree-entry-bypath (commit-tree commit) | |
168 | ".guix-authorizations"))) | |
169 | (commit-parents commit))) | |
170 | ||
171 | (define (assert-parents-lack-authorizations commit) | |
172 | ;; If COMMIT removes the '.guix-authorizations' file found in one of its | |
173 | ;; parents, raise an error. | |
174 | (when (parents-have-authorizations-file? commit) | |
175 | (raise (condition | |
176 | (&unauthorized-commit-error (commit (commit-id commit)) | |
177 | (signing-key #f)) | |
178 | (&message | |
179 | (message (format #f (G_ "commit ~a attempts \ | |
180 | to remove '.guix-authorizations' file") | |
181 | (oid->string (commit-id commit))))))))) | |
182 | ||
41f443c9 LC |
183 | (define (commit-authorizations commit) |
184 | (catch 'git-error | |
185 | (lambda () | |
186 | (let* ((tree (commit-tree commit)) | |
187 | (entry (tree-entry-bypath tree ".guix-authorizations")) | |
188 | (blob (blob-lookup repository (tree-entry-id entry)))) | |
189 | (read-authorizations | |
190 | (open-bytevector-input-port (blob-content blob))))) | |
191 | (lambda (key error) | |
192 | (if (= (git-error-code error) GIT_ENOTFOUND) | |
e7827560 LC |
193 | (begin |
194 | ;; Prevent removal of '.guix-authorizations' since it would make | |
195 | ;; it trivial to force a fallback to DEFAULT-AUTHORIZATIONS. | |
196 | (assert-parents-lack-authorizations commit) | |
197 | default-authorizations) | |
41f443c9 LC |
198 | (throw key error))))) |
199 | ||
eef859e8 LC |
200 | (match (commit-parents commit) |
201 | (() default-authorizations) | |
202 | (parents | |
203 | (apply lset-intersection bytevector=? | |
204 | (map commit-authorizations parents))))) | |
41f443c9 LC |
205 | |
206 | (define* (authenticate-commit repository commit keyring | |
207 | #:key (default-authorizations '())) | |
208 | "Authenticate COMMIT from REPOSITORY and return the signing key fingerprint. | |
209 | Raise an error when authentication fails. If one of the parent commits does | |
210 | not specify anything, fall back to DEFAULT-AUTHORIZATIONS." | |
211 | (define id | |
212 | (commit-id commit)) | |
213 | ||
52c529ff LC |
214 | (define recent-commit? |
215 | (false-if-git-not-found | |
216 | (tree-entry-bypath (commit-tree commit) ".guix-authorizations"))) | |
217 | ||
41f443c9 | 218 | (define signing-key |
52c529ff LC |
219 | (commit-signing-key repository id keyring |
220 | ;; Reject SHA1 signatures unconditionally as suggested | |
221 | ;; by the authors of "SHA-1 is a Shambles" (2019). | |
222 | ;; Accept it for "historical" commits (there are such | |
223 | ;; signatures from April 2020 in the repository). | |
224 | #:disallowed-hash-algorithms | |
225 | (if recent-commit? '(sha1) '()))) | |
41f443c9 LC |
226 | |
227 | (unless (member (openpgp-public-key-fingerprint signing-key) | |
228 | (commit-authorized-keys repository commit | |
229 | default-authorizations)) | |
230 | (raise (condition | |
f8213f1b LC |
231 | (&unauthorized-commit-error (commit id) |
232 | (signing-key signing-key)) | |
41f443c9 LC |
233 | (&message |
234 | (message (format #f (G_ "commit ~a not signed by an authorized \ | |
235 | key: ~a") | |
236 | (oid->string id) | |
237 | (openpgp-format-fingerprint | |
238 | (openpgp-public-key-fingerprint | |
239 | signing-key)))))))) | |
240 | ||
241 | signing-key) | |
242 | ||
243 | (define (load-keyring-from-blob repository oid keyring) | |
244 | "Augment KEYRING with the keyring available in the blob at OID, which may or | |
245 | may not be ASCII-armored." | |
246 | (let* ((blob (blob-lookup repository oid)) | |
247 | (port (open-bytevector-input-port (blob-content blob)))) | |
248 | (get-openpgp-keyring (if (port-ascii-armored? port) | |
249 | (open-bytevector-input-port (read-radix-64 port)) | |
250 | port) | |
251 | keyring))) | |
252 | ||
253 | (define (load-keyring-from-reference repository reference) | |
254 | "Load the '.key' files from the tree at REFERENCE in REPOSITORY and return | |
255 | an OpenPGP keyring." | |
512b9e2d | 256 | (let* ((reference (branch-lookup repository reference BRANCH-ALL)) |
41f443c9 LC |
257 | (target (reference-target reference)) |
258 | (commit (commit-lookup repository target)) | |
259 | (tree (commit-tree commit))) | |
260 | (fold (lambda (name keyring) | |
261 | (if (string-suffix? ".key" name) | |
262 | (let ((entry (tree-entry-bypath tree name))) | |
263 | (load-keyring-from-blob repository | |
264 | (tree-entry-id entry) | |
265 | keyring)) | |
266 | keyring)) | |
267 | %empty-keyring | |
268 | (tree-list tree)))) | |
269 | ||
270 | (define* (authenticate-commits repository commits | |
271 | #:key | |
272 | (default-authorizations '()) | |
273 | (keyring-reference "keyring") | |
41946b79 LC |
274 | (keyring (load-keyring-from-reference |
275 | repository keyring-reference)) | |
41f443c9 LC |
276 | (report-progress (const #t))) |
277 | "Authenticate COMMITS, a list of commit objects, calling REPORT-PROGRESS for | |
278 | each of them. Return an alist showing the number of occurrences of each key. | |
41946b79 LC |
279 | If KEYRING is omitted, the OpenPGP keyring is loaded from KEYRING-REFERENCE in |
280 | REPOSITORY." | |
41f443c9 LC |
281 | (fold (lambda (commit stats) |
282 | (report-progress) | |
283 | (let ((signer (authenticate-commit repository commit keyring | |
284 | #:default-authorizations | |
285 | default-authorizations))) | |
286 | (match (assq signer stats) | |
287 | (#f (cons `(,signer . 1) stats)) | |
288 | ((_ . count) (cons `(,signer . ,(+ count 1)) | |
289 | (alist-delete signer stats)))))) | |
290 | '() | |
291 | commits)) | |
292 | ||
293 | \f | |
294 | ;;; | |
295 | ;;; Caching. | |
296 | ;;; | |
297 | ||
a450b434 | 298 | (define (authenticated-commit-cache-file key) |
41f443c9 | 299 | "Return the name of the file that contains the cache of |
a450b434 LC |
300 | previously-authenticated commits for KEY." |
301 | (string-append (cache-directory) "/authentication/" key)) | |
41f443c9 | 302 | |
a450b434 LC |
303 | (define (previously-authenticated-commits key) |
304 | "Return the previously-authenticated commits under KEY as a list of commit | |
305 | IDs (hex strings)." | |
41f443c9 LC |
306 | (catch 'system-error |
307 | (lambda () | |
a450b434 | 308 | (call-with-input-file (authenticated-commit-cache-file key) |
41939c37 LC |
309 | (lambda (port) |
310 | ;; If PORT has the wrong permissions, it might have been tampered | |
311 | ;; with by another user so ignore its contents. | |
312 | (if (= #o600 (stat:perms (stat port))) | |
313 | (read port) | |
314 | (begin | |
315 | (chmod port #o600) | |
316 | '()))))) | |
41f443c9 LC |
317 | (lambda args |
318 | (if (= ENOENT (system-error-errno args)) | |
319 | '() | |
320 | (apply throw args))))) | |
321 | ||
a450b434 LC |
322 | (define (cache-authenticated-commit key commit-id) |
323 | "Record in ~/.cache, under KEY, COMMIT-ID and its closure as | |
324 | authenticated (only COMMIT-ID is written to cache, though)." | |
41f443c9 LC |
325 | (define %max-cache-length |
326 | ;; Maximum number of commits in cache. | |
327 | 200) | |
328 | ||
329 | (let ((lst (delete-duplicates | |
a450b434 LC |
330 | (cons commit-id (previously-authenticated-commits key)))) |
331 | (file (authenticated-commit-cache-file key))) | |
41f443c9 LC |
332 | (mkdir-p (dirname file)) |
333 | (with-atomic-file-output file | |
334 | (lambda (port) | |
335 | (let ((lst (if (> (length lst) %max-cache-length) | |
336 | (take lst %max-cache-length) ;truncate | |
337 | lst))) | |
338 | (chmod port #o600) | |
339 | (display ";; List of previously-authenticated commits.\n\n" | |
340 | port) | |
341 | (pretty-print lst port)))))) |