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) | |
838f2bdf | 21 | #:autoload (gcrypt hash) (sha256) |
41f443c9 | 22 | #:use-module (guix base16) |
838f2bdf LC |
23 | #:autoload (guix base64) (base64-encode) |
24 | #:use-module ((guix git) | |
25 | #:select (commit-difference false-if-git-not-found)) | |
41f443c9 LC |
26 | #:use-module (guix i18n) |
27 | #:use-module (guix openpgp) | |
28 | #:use-module ((guix utils) | |
29 | #:select (cache-directory with-atomic-file-output)) | |
30 | #:use-module ((guix build utils) | |
31 | #:select (mkdir-p)) | |
838f2bdf | 32 | #:use-module (guix progress) |
41f443c9 LC |
33 | #:use-module (srfi srfi-1) |
34 | #:use-module (srfi srfi-11) | |
35 | #:use-module (srfi srfi-26) | |
36 | #:use-module (srfi srfi-34) | |
37 | #:use-module (srfi srfi-35) | |
38 | #:use-module (rnrs bytevectors) | |
39 | #:use-module (rnrs io ports) | |
40 | #:use-module (ice-9 match) | |
41 | #:autoload (ice-9 pretty-print) (pretty-print) | |
42 | #:export (read-authorizations | |
43 | commit-signing-key | |
44 | commit-authorized-keys | |
45 | authenticate-commit | |
46 | authenticate-commits | |
47 | load-keyring-from-reference | |
48 | previously-authenticated-commits | |
f8213f1b LC |
49 | cache-authenticated-commit |
50 | ||
838f2bdf LC |
51 | repository-cache-key |
52 | authenticate-repository | |
53 | ||
f8213f1b LC |
54 | git-authentication-error? |
55 | git-authentication-error-commit | |
56 | unsigned-commit-error? | |
57 | unauthorized-commit-error? | |
58 | unauthorized-commit-error-signing-key | |
59 | signature-verification-error? | |
60 | signature-verification-error-keyring | |
61 | signature-verification-error-signature | |
62 | missing-key-error? | |
63 | missing-key-error-signature)) | |
41f443c9 LC |
64 | |
65 | ;;; Commentary: | |
66 | ;;; | |
67 | ;;; This module provides tools to authenticate a range of Git commits. A | |
68 | ;;; commit is considered "authentic" if and only if it is signed by an | |
69 | ;;; authorized party. Parties authorized to sign a commit are listed in the | |
70 | ;;; '.guix-authorizations' file of the parent commit. | |
71 | ;;; | |
72 | ;;; Code: | |
73 | ||
f8213f1b LC |
74 | (define-condition-type &git-authentication-error &error |
75 | git-authentication-error? | |
76 | (commit git-authentication-error-commit)) | |
77 | ||
78 | (define-condition-type &unsigned-commit-error &git-authentication-error | |
79 | unsigned-commit-error?) | |
80 | ||
81 | (define-condition-type &unauthorized-commit-error &git-authentication-error | |
82 | unauthorized-commit-error? | |
83 | (signing-key unauthorized-commit-error-signing-key)) | |
84 | ||
85 | (define-condition-type &signature-verification-error &git-authentication-error | |
86 | signature-verification-error? | |
87 | (signature signature-verification-error-signature) | |
88 | (keyring signature-verification-error-keyring)) | |
89 | ||
90 | (define-condition-type &missing-key-error &git-authentication-error | |
91 | missing-key-error? | |
92 | (signature missing-key-error-signature)) | |
93 | ||
94 | ||
52c529ff LC |
95 | (define* (commit-signing-key repo commit-id keyring |
96 | #:key (disallowed-hash-algorithms '(sha1))) | |
41f443c9 | 97 | "Return the OpenPGP key that signed COMMIT-ID (an OID). Raise an exception |
52c529ff LC |
98 | if the commit is unsigned, has an invalid signature, has a signature using one |
99 | of the hash algorithms in DISALLOWED-HASH-ALGORITHMS, or if its signing key is | |
41f443c9 LC |
100 | not in KEYRING." |
101 | (let-values (((signature signed-data) | |
102 | (catch 'git-error | |
103 | (lambda () | |
104 | (commit-extract-signature repo commit-id)) | |
105 | (lambda _ | |
106 | (values #f #f))))) | |
107 | (unless signature | |
108 | (raise (condition | |
f8213f1b | 109 | (&unsigned-commit-error (commit commit-id)) |
41f443c9 LC |
110 | (&message |
111 | (message (format #f (G_ "commit ~a lacks a signature") | |
f8213f1b | 112 | (oid->string commit-id))))))) |
41f443c9 LC |
113 | |
114 | (let ((signature (string->openpgp-packet signature))) | |
52c529ff LC |
115 | (when (memq (openpgp-signature-hash-algorithm signature) |
116 | `(,@disallowed-hash-algorithms md5)) | |
117 | (raise (condition | |
118 | (&unsigned-commit-error (commit commit-id)) | |
119 | (&message | |
120 | (message (format #f (G_ "commit ~a has a ~a signature, \ | |
121 | which is not permitted") | |
122 | (oid->string commit-id) | |
123 | (openpgp-signature-hash-algorithm | |
124 | signature))))))) | |
125 | ||
41f443c9 LC |
126 | (with-fluids ((%default-port-encoding "UTF-8")) |
127 | (let-values (((status data) | |
128 | (verify-openpgp-signature signature keyring | |
129 | (open-input-string signed-data)))) | |
130 | (match status | |
131 | ('bad-signature | |
132 | ;; There's a signature but it's invalid. | |
133 | (raise (condition | |
f8213f1b LC |
134 | (&signature-verification-error (commit commit-id) |
135 | (signature signature) | |
136 | (keyring keyring)) | |
41f443c9 LC |
137 | (&message |
138 | (message (format #f (G_ "signature verification failed \ | |
139 | for commit ~a") | |
140 | (oid->string commit-id))))))) | |
141 | ('missing-key | |
142 | (raise (condition | |
f8213f1b LC |
143 | (&missing-key-error (commit commit-id) |
144 | (signature signature)) | |
41f443c9 LC |
145 | (&message |
146 | (message (format #f (G_ "could not authenticate \ | |
147 | commit ~a: key ~a is missing") | |
148 | (oid->string commit-id) | |
b3679394 | 149 | (openpgp-format-fingerprint data))))))) |
41f443c9 LC |
150 | ('good-signature data))))))) |
151 | ||
152 | (define (read-authorizations port) | |
153 | "Read authorizations in the '.guix-authorizations' format from PORT, and | |
154 | return a list of authorized fingerprints." | |
155 | (match (read port) | |
156 | (('authorizations ('version 0) | |
157 | (((? string? fingerprints) _ ...) ...) | |
158 | _ ...) | |
159 | (map (lambda (fingerprint) | |
160 | (base16-string->bytevector | |
161 | (string-downcase (string-filter char-set:graphic fingerprint)))) | |
162 | fingerprints)))) | |
163 | ||
164 | (define* (commit-authorized-keys repository commit | |
165 | #:optional (default-authorizations '())) | |
166 | "Return the list of OpenPGP fingerprints authorized to sign COMMIT, based on | |
167 | authorizations listed in its parent commits. If one of the parent commits | |
168 | does not specify anything, fall back to DEFAULT-AUTHORIZATIONS." | |
e7827560 LC |
169 | (define (parents-have-authorizations-file? commit) |
170 | ;; Return true if at least one of the parents of COMMIT has the | |
171 | ;; '.guix-authorizations' file. | |
172 | (find (lambda (commit) | |
173 | (false-if-git-not-found | |
174 | (tree-entry-bypath (commit-tree commit) | |
175 | ".guix-authorizations"))) | |
176 | (commit-parents commit))) | |
177 | ||
178 | (define (assert-parents-lack-authorizations commit) | |
179 | ;; If COMMIT removes the '.guix-authorizations' file found in one of its | |
180 | ;; parents, raise an error. | |
181 | (when (parents-have-authorizations-file? commit) | |
182 | (raise (condition | |
183 | (&unauthorized-commit-error (commit (commit-id commit)) | |
184 | (signing-key #f)) | |
185 | (&message | |
186 | (message (format #f (G_ "commit ~a attempts \ | |
187 | to remove '.guix-authorizations' file") | |
188 | (oid->string (commit-id commit))))))))) | |
189 | ||
41f443c9 LC |
190 | (define (commit-authorizations commit) |
191 | (catch 'git-error | |
192 | (lambda () | |
193 | (let* ((tree (commit-tree commit)) | |
194 | (entry (tree-entry-bypath tree ".guix-authorizations")) | |
195 | (blob (blob-lookup repository (tree-entry-id entry)))) | |
196 | (read-authorizations | |
197 | (open-bytevector-input-port (blob-content blob))))) | |
198 | (lambda (key error) | |
199 | (if (= (git-error-code error) GIT_ENOTFOUND) | |
e7827560 LC |
200 | (begin |
201 | ;; Prevent removal of '.guix-authorizations' since it would make | |
202 | ;; it trivial to force a fallback to DEFAULT-AUTHORIZATIONS. | |
203 | (assert-parents-lack-authorizations commit) | |
204 | default-authorizations) | |
41f443c9 LC |
205 | (throw key error))))) |
206 | ||
eef859e8 LC |
207 | (match (commit-parents commit) |
208 | (() default-authorizations) | |
209 | (parents | |
210 | (apply lset-intersection bytevector=? | |
211 | (map commit-authorizations parents))))) | |
41f443c9 LC |
212 | |
213 | (define* (authenticate-commit repository commit keyring | |
214 | #:key (default-authorizations '())) | |
215 | "Authenticate COMMIT from REPOSITORY and return the signing key fingerprint. | |
216 | Raise an error when authentication fails. If one of the parent commits does | |
217 | not specify anything, fall back to DEFAULT-AUTHORIZATIONS." | |
218 | (define id | |
219 | (commit-id commit)) | |
220 | ||
52c529ff LC |
221 | (define recent-commit? |
222 | (false-if-git-not-found | |
223 | (tree-entry-bypath (commit-tree commit) ".guix-authorizations"))) | |
224 | ||
41f443c9 | 225 | (define signing-key |
52c529ff LC |
226 | (commit-signing-key repository id keyring |
227 | ;; Reject SHA1 signatures unconditionally as suggested | |
228 | ;; by the authors of "SHA-1 is a Shambles" (2019). | |
229 | ;; Accept it for "historical" commits (there are such | |
230 | ;; signatures from April 2020 in the repository). | |
231 | #:disallowed-hash-algorithms | |
232 | (if recent-commit? '(sha1) '()))) | |
41f443c9 LC |
233 | |
234 | (unless (member (openpgp-public-key-fingerprint signing-key) | |
235 | (commit-authorized-keys repository commit | |
236 | default-authorizations)) | |
237 | (raise (condition | |
f8213f1b LC |
238 | (&unauthorized-commit-error (commit id) |
239 | (signing-key signing-key)) | |
41f443c9 LC |
240 | (&message |
241 | (message (format #f (G_ "commit ~a not signed by an authorized \ | |
242 | key: ~a") | |
243 | (oid->string id) | |
244 | (openpgp-format-fingerprint | |
245 | (openpgp-public-key-fingerprint | |
246 | signing-key)))))))) | |
247 | ||
248 | signing-key) | |
249 | ||
250 | (define (load-keyring-from-blob repository oid keyring) | |
251 | "Augment KEYRING with the keyring available in the blob at OID, which may or | |
252 | may not be ASCII-armored." | |
253 | (let* ((blob (blob-lookup repository oid)) | |
254 | (port (open-bytevector-input-port (blob-content blob)))) | |
255 | (get-openpgp-keyring (if (port-ascii-armored? port) | |
256 | (open-bytevector-input-port (read-radix-64 port)) | |
257 | port) | |
258 | keyring))) | |
259 | ||
260 | (define (load-keyring-from-reference repository reference) | |
261 | "Load the '.key' files from the tree at REFERENCE in REPOSITORY and return | |
262 | an OpenPGP keyring." | |
512b9e2d | 263 | (let* ((reference (branch-lookup repository reference BRANCH-ALL)) |
41f443c9 LC |
264 | (target (reference-target reference)) |
265 | (commit (commit-lookup repository target)) | |
266 | (tree (commit-tree commit))) | |
267 | (fold (lambda (name keyring) | |
268 | (if (string-suffix? ".key" name) | |
269 | (let ((entry (tree-entry-bypath tree name))) | |
270 | (load-keyring-from-blob repository | |
271 | (tree-entry-id entry) | |
272 | keyring)) | |
273 | keyring)) | |
274 | %empty-keyring | |
275 | (tree-list tree)))) | |
276 | ||
277 | (define* (authenticate-commits repository commits | |
278 | #:key | |
279 | (default-authorizations '()) | |
280 | (keyring-reference "keyring") | |
41946b79 LC |
281 | (keyring (load-keyring-from-reference |
282 | repository keyring-reference)) | |
41f443c9 LC |
283 | (report-progress (const #t))) |
284 | "Authenticate COMMITS, a list of commit objects, calling REPORT-PROGRESS for | |
285 | each of them. Return an alist showing the number of occurrences of each key. | |
41946b79 LC |
286 | If KEYRING is omitted, the OpenPGP keyring is loaded from KEYRING-REFERENCE in |
287 | REPOSITORY." | |
41f443c9 LC |
288 | (fold (lambda (commit stats) |
289 | (report-progress) | |
290 | (let ((signer (authenticate-commit repository commit keyring | |
291 | #:default-authorizations | |
292 | default-authorizations))) | |
293 | (match (assq signer stats) | |
294 | (#f (cons `(,signer . 1) stats)) | |
295 | ((_ . count) (cons `(,signer . ,(+ count 1)) | |
296 | (alist-delete signer stats)))))) | |
297 | '() | |
298 | commits)) | |
299 | ||
300 | \f | |
301 | ;;; | |
302 | ;;; Caching. | |
303 | ;;; | |
304 | ||
a450b434 | 305 | (define (authenticated-commit-cache-file key) |
41f443c9 | 306 | "Return the name of the file that contains the cache of |
a450b434 LC |
307 | previously-authenticated commits for KEY." |
308 | (string-append (cache-directory) "/authentication/" key)) | |
41f443c9 | 309 | |
a450b434 LC |
310 | (define (previously-authenticated-commits key) |
311 | "Return the previously-authenticated commits under KEY as a list of commit | |
312 | IDs (hex strings)." | |
41f443c9 LC |
313 | (catch 'system-error |
314 | (lambda () | |
a450b434 | 315 | (call-with-input-file (authenticated-commit-cache-file key) |
41939c37 LC |
316 | (lambda (port) |
317 | ;; If PORT has the wrong permissions, it might have been tampered | |
318 | ;; with by another user so ignore its contents. | |
319 | (if (= #o600 (stat:perms (stat port))) | |
320 | (read port) | |
321 | (begin | |
322 | (chmod port #o600) | |
323 | '()))))) | |
41f443c9 LC |
324 | (lambda args |
325 | (if (= ENOENT (system-error-errno args)) | |
326 | '() | |
327 | (apply throw args))))) | |
328 | ||
a450b434 LC |
329 | (define (cache-authenticated-commit key commit-id) |
330 | "Record in ~/.cache, under KEY, COMMIT-ID and its closure as | |
331 | authenticated (only COMMIT-ID is written to cache, though)." | |
41f443c9 LC |
332 | (define %max-cache-length |
333 | ;; Maximum number of commits in cache. | |
334 | 200) | |
335 | ||
336 | (let ((lst (delete-duplicates | |
a450b434 LC |
337 | (cons commit-id (previously-authenticated-commits key)))) |
338 | (file (authenticated-commit-cache-file key))) | |
41f443c9 LC |
339 | (mkdir-p (dirname file)) |
340 | (with-atomic-file-output file | |
341 | (lambda (port) | |
342 | (let ((lst (if (> (length lst) %max-cache-length) | |
343 | (take lst %max-cache-length) ;truncate | |
344 | lst))) | |
345 | (chmod port #o600) | |
346 | (display ";; List of previously-authenticated commits.\n\n" | |
347 | port) | |
348 | (pretty-print lst port)))))) | |
838f2bdf LC |
349 | |
350 | \f | |
351 | ;;; | |
352 | ;;; High-level interface. | |
353 | ;;; | |
354 | ||
355 | (define (repository-cache-key repository) | |
356 | "Return a unique key to store the authenticate commit cache for REPOSITORY." | |
357 | (string-append "checkouts/" | |
358 | (base64-encode | |
359 | (sha256 (string->utf8 (repository-directory repository)))))) | |
360 | ||
361 | (define (verify-introductory-commit repository keyring commit expected-signer) | |
362 | "Look up COMMIT in REPOSITORY, and raise an exception if it is not signed by | |
363 | EXPECTED-SIGNER." | |
364 | (define actual-signer | |
365 | (openpgp-public-key-fingerprint | |
366 | (commit-signing-key repository (commit-id commit) keyring))) | |
367 | ||
368 | (unless (bytevector=? expected-signer actual-signer) | |
369 | (raise (condition | |
370 | (&message | |
371 | (message (format #f (G_ "initial commit ~a is signed by '~a' \ | |
372 | instead of '~a'") | |
373 | (oid->string (commit-id commit)) | |
374 | (openpgp-format-fingerprint actual-signer) | |
375 | (openpgp-format-fingerprint expected-signer)))))))) | |
376 | ||
377 | (define* (authenticate-repository repository start signer | |
378 | #:key | |
379 | (keyring-reference "keyring") | |
380 | (cache-key (repository-cache-key repository)) | |
381 | (end (reference-target | |
382 | (repository-head repository))) | |
383 | (historical-authorizations '()) | |
384 | (make-reporter | |
385 | (const progress-reporter/silent))) | |
386 | "Authenticate REPOSITORY up to commit END, an OID. Authentication starts | |
387 | with commit START, an OID, which must be signed by SIGNER; an exception is | |
388 | raised if that is not the case. Return an alist mapping OpenPGP public keys | |
389 | to the number of commits signed by that key that have been traversed. | |
390 | ||
391 | The OpenPGP keyring is loaded from KEYRING-REFERENCE in REPOSITORY, where | |
392 | KEYRING-REFERENCE is the name of a branch. The list of authenticated commits | |
393 | is cached in the authentication cache under CACHE-KEY. | |
394 | ||
395 | HISTORICAL-AUTHORIZATIONS must be a list of OpenPGP fingerprints (bytevectors) | |
396 | denoting the authorized keys for commits whose parent lack the | |
397 | '.guix-authorizations' file." | |
398 | (define start-commit | |
399 | (commit-lookup repository start)) | |
400 | (define end-commit | |
401 | (commit-lookup repository end)) | |
402 | ||
403 | (define keyring | |
404 | (load-keyring-from-reference repository keyring-reference)) | |
405 | ||
406 | (define authenticated-commits | |
407 | ;; Previously-authenticated commits that don't need to be checked again. | |
408 | (filter-map (lambda (id) | |
409 | (false-if-git-not-found | |
410 | (commit-lookup repository (string->oid id)))) | |
411 | (previously-authenticated-commits cache-key))) | |
412 | ||
413 | (define commits | |
414 | ;; Commits to authenticate, excluding the closure of | |
415 | ;; AUTHENTICATED-COMMITS. | |
416 | (commit-difference end-commit start-commit | |
417 | authenticated-commits)) | |
418 | ||
419 | ;; When COMMITS is empty, it's because END-COMMIT is in the closure of | |
420 | ;; START-COMMIT and/or AUTHENTICATED-COMMITS, in which case it's known to | |
421 | ;; be authentic already. | |
422 | (if (null? commits) | |
423 | '() | |
424 | (let ((reporter (make-reporter start-commit end-commit commits))) | |
425 | ;; If it's our first time, verify START-COMMIT's signature. | |
426 | (when (null? authenticated-commits) | |
427 | (verify-introductory-commit repository keyring | |
428 | start-commit signer)) | |
429 | ||
430 | (let ((stats (call-with-progress-reporter reporter | |
431 | (lambda (report) | |
432 | (authenticate-commits repository commits | |
433 | #:keyring keyring | |
434 | #:default-authorizations | |
435 | historical-authorizations | |
436 | #:report-progress report))))) | |
437 | (cache-authenticated-commit cache-key | |
438 | (oid->string (commit-id end-commit))) | |
439 | ||
440 | stats)))) |