| 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 | #:autoload (gcrypt hash) (sha256) |
| 22 | #:use-module (guix base16) |
| 23 | #:autoload (guix base64) (base64-encode) |
| 24 | #:use-module ((guix git) |
| 25 | #:select (commit-difference false-if-git-not-found)) |
| 26 | #:use-module (guix i18n) |
| 27 | #:use-module ((guix diagnostics) #:select (formatted-message)) |
| 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)) |
| 33 | #:use-module (guix progress) |
| 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 |
| 50 | cache-authenticated-commit |
| 51 | |
| 52 | repository-cache-key |
| 53 | authenticate-repository |
| 54 | |
| 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)) |
| 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 | |
| 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 | |
| 96 | (define* (commit-signing-key repo commit-id keyring |
| 97 | #:key (disallowed-hash-algorithms '(sha1))) |
| 98 | "Return the OpenPGP key that signed COMMIT-ID (an OID). Raise an exception |
| 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 |
| 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 |
| 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))))) |
| 113 | |
| 114 | (let ((signature (string->openpgp-packet signature))) |
| 115 | (when (memq (openpgp-signature-hash-algorithm signature) |
| 116 | `(,@disallowed-hash-algorithms md5)) |
| 117 | (raise (make-compound-condition |
| 118 | (condition (&unsigned-commit-error (commit commit-id))) |
| 119 | (formatted-message (G_ "commit ~a has a ~a signature, \ |
| 120 | which is not permitted") |
| 121 | (oid->string commit-id) |
| 122 | (openpgp-signature-hash-algorithm |
| 123 | signature))))) |
| 124 | |
| 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. |
| 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 \ |
| 138 | for commit ~a") |
| 139 | (oid->string commit-id))))) |
| 140 | ('missing-key |
| 141 | (raise (make-compound-condition |
| 142 | (condition (&missing-key-error (commit commit-id) |
| 143 | (signature signature))) |
| 144 | (formatted-message (G_ "could not authenticate \ |
| 145 | commit ~a: key ~a is missing") |
| 146 | (oid->string commit-id) |
| 147 | (openpgp-format-fingerprint data))))) |
| 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." |
| 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) |
| 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 \ |
| 185 | to remove '.guix-authorizations' file") |
| 186 | (oid->string (commit-id commit))))))) |
| 187 | |
| 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) |
| 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) |
| 203 | (throw key error))))) |
| 204 | |
| 205 | (match (commit-parents commit) |
| 206 | (() default-authorizations) |
| 207 | (parents |
| 208 | (apply lset-intersection bytevector=? |
| 209 | (map commit-authorizations parents))))) |
| 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 | |
| 219 | (define recent-commit? |
| 220 | (false-if-git-not-found |
| 221 | (tree-entry-bypath (commit-tree commit) ".guix-authorizations"))) |
| 222 | |
| 223 | (define signing-key |
| 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) '()))) |
| 231 | |
| 232 | (unless (member (openpgp-public-key-fingerprint signing-key) |
| 233 | (commit-authorized-keys repository commit |
| 234 | default-authorizations)) |
| 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 \ |
| 240 | key: ~a") |
| 241 | (oid->string id) |
| 242 | (openpgp-format-fingerprint |
| 243 | (openpgp-public-key-fingerprint |
| 244 | signing-key)))))) |
| 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." |
| 261 | (let* ((reference (branch-lookup repository reference BRANCH-ALL)) |
| 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") |
| 279 | (keyring (load-keyring-from-reference |
| 280 | repository keyring-reference)) |
| 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. |
| 284 | If KEYRING is omitted, the OpenPGP keyring is loaded from KEYRING-REFERENCE in |
| 285 | REPOSITORY." |
| 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 | |
| 303 | (define (authenticated-commit-cache-file key) |
| 304 | "Return the name of the file that contains the cache of |
| 305 | previously-authenticated commits for KEY." |
| 306 | (string-append (cache-directory) "/authentication/" key)) |
| 307 | |
| 308 | (define (previously-authenticated-commits key) |
| 309 | "Return the previously-authenticated commits under KEY as a list of commit |
| 310 | IDs (hex strings)." |
| 311 | (catch 'system-error |
| 312 | (lambda () |
| 313 | (call-with-input-file (authenticated-commit-cache-file key) |
| 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 | '()))))) |
| 322 | (lambda args |
| 323 | (if (= ENOENT (system-error-errno args)) |
| 324 | '() |
| 325 | (apply throw args))))) |
| 326 | |
| 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)." |
| 330 | (define %max-cache-length |
| 331 | ;; Maximum number of commits in cache. |
| 332 | 200) |
| 333 | |
| 334 | (let ((lst (delete-duplicates |
| 335 | (cons commit-id (previously-authenticated-commits key)))) |
| 336 | (file (authenticated-commit-cache-file key))) |
| 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)))))) |
| 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) |
| 367 | (raise (formatted-message (G_ "initial commit ~a is signed by '~a' \ |
| 368 | instead of '~a'") |
| 369 | (oid->string (commit-id commit)) |
| 370 | (openpgp-format-fingerprint actual-signer) |
| 371 | (openpgp-format-fingerprint expected-signer))))) |
| 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))) |
| 379 | (historical-authorizations '()) |
| 380 | (make-reporter |
| 381 | (const progress-reporter/silent))) |
| 382 | "Authenticate REPOSITORY up to commit END, an OID. Authentication starts |
| 383 | with commit START, an OID, which must be signed by SIGNER; an exception is |
| 384 | raised if that is not the case. Return an alist mapping OpenPGP public keys |
| 385 | to the number of commits signed by that key that have been traversed. |
| 386 | |
| 387 | The OpenPGP keyring is loaded from KEYRING-REFERENCE in REPOSITORY, where |
| 388 | KEYRING-REFERENCE is the name of a branch. The list of authenticated commits |
| 389 | is cached in the authentication cache under CACHE-KEY. |
| 390 | |
| 391 | HISTORICAL-AUTHORIZATIONS must be a list of OpenPGP fingerprints (bytevectors) |
| 392 | denoting the authorized keys for commits whose parent lack the |
| 393 | '.guix-authorizations' file." |
| 394 | (define start-commit |
| 395 | (commit-lookup repository start)) |
| 396 | (define end-commit |
| 397 | (commit-lookup repository end)) |
| 398 | |
| 399 | (define keyring |
| 400 | (load-keyring-from-reference repository keyring-reference)) |
| 401 | |
| 402 | (define authenticated-commits |
| 403 | ;; Previously-authenticated commits that don't need to be checked again. |
| 404 | (filter-map (lambda (id) |
| 405 | (false-if-git-not-found |
| 406 | (commit-lookup repository (string->oid id)))) |
| 407 | (previously-authenticated-commits cache-key))) |
| 408 | |
| 409 | (define commits |
| 410 | ;; Commits to authenticate, excluding the closure of |
| 411 | ;; AUTHENTICATED-COMMITS. |
| 412 | (commit-difference end-commit start-commit |
| 413 | authenticated-commits)) |
| 414 | |
| 415 | ;; When COMMITS is empty, it's because END-COMMIT is in the closure of |
| 416 | ;; START-COMMIT and/or AUTHENTICATED-COMMITS, in which case it's known to |
| 417 | ;; be authentic already. |
| 418 | (if (null? commits) |
| 419 | '() |
| 420 | (let ((reporter (make-reporter start-commit end-commit commits))) |
| 421 | ;; If it's our first time, verify START-COMMIT's signature. |
| 422 | (when (null? authenticated-commits) |
| 423 | (verify-introductory-commit repository keyring |
| 424 | start-commit signer)) |
| 425 | |
| 426 | (let ((stats (call-with-progress-reporter reporter |
| 427 | (lambda (report) |
| 428 | (authenticate-commits repository commits |
| 429 | #:keyring keyring |
| 430 | #:default-authorizations |
| 431 | historical-authorizations |
| 432 | #:report-progress report))))) |
| 433 | (cache-authenticated-commit cache-key |
| 434 | (oid->string (commit-id end-commit))) |
| 435 | |
| 436 | stats)))) |