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