diff options
| -rw-r--r-- | Makefile.am | 3 | ||||
| -rw-r--r-- | build-aux/git-authenticate.scm | 203 | ||||
| -rw-r--r-- | guix/git-authenticate.scm | 244 |
3 files changed, 253 insertions, 197 deletions
diff --git a/Makefile.am b/Makefile.am index 5b64386b53..db30004b1b 100644 --- a/Makefile.am +++ b/Makefile.am @@ -104,6 +104,7 @@ MODULES = \ guix/lint.scm \ guix/glob.scm \ guix/git.scm \ + guix/git-authenticate.scm \ guix/graph.scm \ guix/cache.scm \ guix/cve.scm \ @@ -632,7 +633,7 @@ commit_v1_0_1 = d68de958b60426798ed62797ff7c96c327a672ac # Authenticate the current Git checkout by checking signatures on every commit # starting from $(commit_v1_0_1). -authenticate: guix/openpgp.go guix/git.go +authenticate: guix/openpgp.go guix/git-authenticate.go guix/git.go $(AM_V_at)echo "Authenticating Git checkout..." ; \ "$(top_builddir)/pre-inst-env" $(GUILE) \ --no-auto-compile -e git-authenticate \ diff --git a/build-aux/git-authenticate.scm b/build-aux/git-authenticate.scm index 8e679fd5e5..5e1fdaaa24 100644 --- a/build-aux/git-authenticate.scm +++ b/build-aux/git-authenticate.scm @@ -22,21 +22,16 @@ ;;; (use-modules (git) - (guix git) - (guix openpgp) (guix base16) - ((guix utils) - #:select (cache-directory with-atomic-file-output)) - ((guix build utils) #:select (mkdir-p)) + (guix git) + (guix git-authenticate) (guix i18n) + ((guix openpgp) + #:select (openpgp-public-key-fingerprint + openpgp-format-fingerprint)) (guix progress) (srfi srfi-1) - (srfi srfi-11) (srfi srfi-26) - (srfi srfi-34) - (srfi srfi-35) - (rnrs bytevectors) - (rnrs io ports) (ice-9 match) (ice-9 format) (ice-9 pretty-print)) @@ -231,197 +226,11 @@ ;; Commits lacking a signature. '()) -(define (commit-signing-key repo commit-id keyring) - "Return the OpenPGP key that signed COMMIT-ID (an OID). Raise an exception -if the commit is unsigned, has an invalid signature, or if its signing key is -not in KEYRING." - (let-values (((signature signed-data) - (catch 'git-error - (lambda () - (commit-extract-signature repo commit-id)) - (lambda _ - (values #f #f))))) - (unless signature - (raise (condition - (&message - (message (format #f (G_ "commit ~a lacks a signature") - commit-id)))))) - - (let ((signature (string->openpgp-packet signature))) - (with-fluids ((%default-port-encoding "UTF-8")) - (let-values (((status data) - (verify-openpgp-signature signature keyring - (open-input-string signed-data)))) - (match status - ('bad-signature - ;; There's a signature but it's invalid. - (raise (condition - (&message - (message (format #f (G_ "signature verification failed \ -for commit ~a") - (oid->string commit-id))))))) - ('missing-key - (raise (condition - (&message - (message (format #f (G_ "could not authenticate \ -commit ~a: key ~a is missing") - (oid->string commit-id) - data)))))) - ('good-signature data))))))) - -(define (read-authorizations port) - "Read authorizations in the '.guix-authorizations' format from PORT, and -return a list of authorized fingerprints." - (match (read port) - (('authorizations ('version 0) - (((? string? fingerprints) _ ...) ...) - _ ...) - (map (lambda (fingerprint) - (base16-string->bytevector - (string-downcase (string-filter char-set:graphic fingerprint)))) - fingerprints)))) - -(define* (commit-authorized-keys repository commit - #:optional (default-authorizations '())) - "Return the list of OpenPGP fingerprints authorized to sign COMMIT, based on -authorizations listed in its parent commits. If one of the parent commits -does not specify anything, fall back to DEFAULT-AUTHORIZATIONS." - (define (commit-authorizations commit) - (catch 'git-error - (lambda () - (let* ((tree (commit-tree commit)) - (entry (tree-entry-bypath tree ".guix-authorizations")) - (blob (blob-lookup repository (tree-entry-id entry)))) - (read-authorizations - (open-bytevector-input-port (blob-content blob))))) - (lambda (key error) - (if (= (git-error-code error) GIT_ENOTFOUND) - default-authorizations - (throw key error))))) - - (apply lset-intersection bytevector=? - (map commit-authorizations (commit-parents commit)))) - -(define (authenticate-commit repository commit keyring) - "Authenticate COMMIT from REPOSITORY and return the signing key fingerprint. -Raise an error when authentication fails." - (define id - (commit-id commit)) - - (define signing-key - (commit-signing-key repository id keyring)) - - (unless (member (openpgp-public-key-fingerprint signing-key) - (commit-authorized-keys repository commit - %historical-authorized-signing-keys)) - (raise (condition - (&message - (message (format #f (G_ "commit ~a not signed by an authorized \ -key: ~a") - (oid->string id) - (openpgp-format-fingerprint - (openpgp-public-key-fingerprint - signing-key)))))))) - - signing-key) - -(define (load-keyring-from-blob repository oid keyring) - "Augment KEYRING with the keyring available in the blob at OID, which may or -may not be ASCII-armored." - (let* ((blob (blob-lookup repository oid)) - (port (open-bytevector-input-port (blob-content blob)))) - (get-openpgp-keyring (if (port-ascii-armored? port) - (open-bytevector-input-port (read-radix-64 port)) - port) - keyring))) - -(define (load-keyring-from-reference repository reference) - "Load the '.key' files from the tree at REFERENCE in REPOSITORY and return -an OpenPGP keyring." - (let* ((reference (branch-lookup repository - (string-append "origin/" reference) - BRANCH-REMOTE)) - (target (reference-target reference)) - (commit (commit-lookup repository target)) - (tree (commit-tree commit))) - (fold (lambda (name keyring) - (if (string-suffix? ".key" name) - (let ((entry (tree-entry-bypath tree name))) - (load-keyring-from-blob repository - (tree-entry-id entry) - keyring)) - keyring)) - %empty-keyring - (tree-list tree)))) - -(define* (authenticate-commits repository commits - #:key - (keyring-reference "keyring") - (report-progress (const #t))) - "Authenticate COMMITS, a list of commit objects, calling REPORT-PROGRESS for -each of them. Return an alist showing the number of occurrences of each key. -The OpenPGP keyring is loaded from KEYRING-REFERENCE in REPOSITORY." - (define keyring - (load-keyring-from-reference repository keyring-reference)) - - (fold (lambda (commit stats) - (report-progress) - (let ((signer (authenticate-commit repository commit keyring))) - (match (assq signer stats) - (#f (cons `(,signer . 1) stats)) - ((_ . count) (cons `(,signer . ,(+ count 1)) - (alist-delete signer stats)))))) - '() - commits)) - (define commit-short-id (compose (cut string-take <> 7) oid->string commit-id)) ;;; -;;; Caching. -;;; - -(define (authenticated-commit-cache-file) - "Return the name of the file that contains the cache of -previously-authenticated commits." - (string-append (cache-directory) "/authentication/channels/guix")) - -(define (previously-authenticated-commits) - "Return the previously-authenticated commits as a list of commit IDs (hex -strings)." - (catch 'system-error - (lambda () - (call-with-input-file (authenticated-commit-cache-file) - read)) - (lambda args - (if (= ENOENT (system-error-errno args)) - '() - (apply throw args))))) - -(define (cache-authenticated-commit commit-id) - "Record in ~/.cache COMMIT-ID and its closure as authenticated (only -COMMIT-ID is written to cache, though)." - (define %max-cache-length - ;; Maximum number of commits in cache. - 200) - - (let ((lst (delete-duplicates - (cons commit-id (previously-authenticated-commits)))) - (file (authenticated-commit-cache-file))) - (mkdir-p (dirname file)) - (with-atomic-file-output file - (lambda (port) - (let ((lst (if (> (length lst) %max-cache-length) - (take lst %max-cache-length) ;truncate - lst))) - (chmod port #o600) - (display ";; List of previously-authenticated commits.\n\n" - port) - (pretty-print lst port)))))) - - -;;; ;;; Entry point. ;;; @@ -462,6 +271,8 @@ COMMIT-ID is written to cache, though)." (let ((stats (call-with-progress-reporter reporter (lambda (report) (authenticate-commits repository commits + #:default-authorizations + %historical-authorized-signing-keys #:report-progress report))))) (cache-authenticated-commit (oid->string (commit-id end-commit))) diff --git a/guix/git-authenticate.scm b/guix/git-authenticate.scm new file mode 100644 index 0000000000..4df56fab59 --- /dev/null +++ b/guix/git-authenticate.scm @@ -0,0 +1,244 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (guix git-authenticate) + #:use-module (git) + #:use-module (guix base16) + #:use-module (guix i18n) + #:use-module (guix openpgp) + #:use-module ((guix utils) + #:select (cache-directory with-atomic-file-output)) + #:use-module ((guix build utils) + #:select (mkdir-p)) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:use-module (rnrs bytevectors) + #:use-module (rnrs io ports) + #:use-module (ice-9 match) + #:autoload (ice-9 pretty-print) (pretty-print) + #:export (read-authorizations + commit-signing-key + commit-authorized-keys + authenticate-commit + authenticate-commits + load-keyring-from-reference + previously-authenticated-commits + cache-authenticated-commit)) + +;;; Commentary: +;;; +;;; This module provides tools to authenticate a range of Git commits. A +;;; commit is considered "authentic" if and only if it is signed by an +;;; authorized party. Parties authorized to sign a commit are listed in the +;;; '.guix-authorizations' file of the parent commit. +;;; +;;; Code: + +(define (commit-signing-key repo commit-id keyring) + "Return the OpenPGP key that signed COMMIT-ID (an OID). Raise an exception +if the commit is unsigned, has an invalid signature, or if its signing key is +not in KEYRING." + (let-values (((signature signed-data) + (catch 'git-error + (lambda () + (commit-extract-signature repo commit-id)) + (lambda _ + (values #f #f))))) + (unless signature + (raise (condition + (&message + (message (format #f (G_ "commit ~a lacks a signature") + commit-id)))))) + + (let ((signature (string->openpgp-packet signature))) + (with-fluids ((%default-port-encoding "UTF-8")) + (let-values (((status data) + (verify-openpgp-signature signature keyring + (open-input-string signed-data)))) + (match status + ('bad-signature + ;; There's a signature but it's invalid. + (raise (condition + (&message + (message (format #f (G_ "signature verification failed \ +for commit ~a") + (oid->string commit-id))))))) + ('missing-key + (raise (condition + (&message + (message (format #f (G_ "could not authenticate \ +commit ~a: key ~a is missing") + (oid->string commit-id) + data)))))) + ('good-signature data))))))) + +(define (read-authorizations port) + "Read authorizations in the '.guix-authorizations' format from PORT, and +return a list of authorized fingerprints." + (match (read port) + (('authorizations ('version 0) + (((? string? fingerprints) _ ...) ...) + _ ...) + (map (lambda (fingerprint) + (base16-string->bytevector + (string-downcase (string-filter char-set:graphic fingerprint)))) + fingerprints)))) + +(define* (commit-authorized-keys repository commit + #:optional (default-authorizations '())) + "Return the list of OpenPGP fingerprints authorized to sign COMMIT, based on +authorizations listed in its parent commits. If one of the parent commits +does not specify anything, fall back to DEFAULT-AUTHORIZATIONS." + (define (commit-authorizations commit) + (catch 'git-error + (lambda () + (let* ((tree (commit-tree commit)) + (entry (tree-entry-bypath tree ".guix-authorizations")) + (blob (blob-lookup repository (tree-entry-id entry)))) + (read-authorizations + (open-bytevector-input-port (blob-content blob))))) + (lambda (key error) + (if (= (git-error-code error) GIT_ENOTFOUND) + default-authorizations + (throw key error))))) + + (apply lset-intersection bytevector=? + (map commit-authorizations (commit-parents commit)))) + +(define* (authenticate-commit repository commit keyring + #:key (default-authorizations '())) + "Authenticate COMMIT from REPOSITORY and return the signing key fingerprint. +Raise an error when authentication fails. If one of the parent commits does +not specify anything, fall back to DEFAULT-AUTHORIZATIONS." + (define id + (commit-id commit)) + + (define signing-key + (commit-signing-key repository id keyring)) + + (unless (member (openpgp-public-key-fingerprint signing-key) + (commit-authorized-keys repository commit + default-authorizations)) + (raise (condition + (&message + (message (format #f (G_ "commit ~a not signed by an authorized \ +key: ~a") + (oid->string id) + (openpgp-format-fingerprint + (openpgp-public-key-fingerprint + signing-key)))))))) + + signing-key) + +(define (load-keyring-from-blob repository oid keyring) + "Augment KEYRING with the keyring available in the blob at OID, which may or +may not be ASCII-armored." + (let* ((blob (blob-lookup repository oid)) + (port (open-bytevector-input-port (blob-content blob)))) + (get-openpgp-keyring (if (port-ascii-armored? port) + (open-bytevector-input-port (read-radix-64 port)) + port) + keyring))) + +(define (load-keyring-from-reference repository reference) + "Load the '.key' files from the tree at REFERENCE in REPOSITORY and return +an OpenPGP keyring." + (let* ((reference (branch-lookup repository + (string-append "origin/" reference) + BRANCH-REMOTE)) + (target (reference-target reference)) + (commit (commit-lookup repository target)) + (tree (commit-tree commit))) + (fold (lambda (name keyring) + (if (string-suffix? ".key" name) + (let ((entry (tree-entry-bypath tree name))) + (load-keyring-from-blob repository + (tree-entry-id entry) + keyring)) + keyring)) + %empty-keyring + (tree-list tree)))) + +(define* (authenticate-commits repository commits + #:key + (default-authorizations '()) + (keyring-reference "keyring") + (report-progress (const #t))) + "Authenticate COMMITS, a list of commit objects, calling REPORT-PROGRESS for +each of them. Return an alist showing the number of occurrences of each key. +The OpenPGP keyring is loaded from KEYRING-REFERENCE in REPOSITORY." + (define keyring + (load-keyring-from-reference repository keyring-reference)) + + (fold (lambda (commit stats) + (report-progress) + (let ((signer (authenticate-commit repository commit keyring + #:default-authorizations + default-authorizations))) + (match (assq signer stats) + (#f (cons `(,signer . 1) stats)) + ((_ . count) (cons `(,signer . ,(+ count 1)) + (alist-delete signer stats)))))) + '() + commits)) + + +;;; +;;; Caching. +;;; + +(define (authenticated-commit-cache-file) + "Return the name of the file that contains the cache of +previously-authenticated commits." + (string-append (cache-directory) "/authentication/channels/guix")) + +(define (previously-authenticated-commits) + "Return the previously-authenticated commits as a list of commit IDs (hex +strings)." + (catch 'system-error + (lambda () + (call-with-input-file (authenticated-commit-cache-file) + read)) + (lambda args + (if (= ENOENT (system-error-errno args)) + '() + (apply throw args))))) + +(define (cache-authenticated-commit commit-id) + "Record in ~/.cache COMMIT-ID and its closure as authenticated (only +COMMIT-ID is written to cache, though)." + (define %max-cache-length + ;; Maximum number of commits in cache. + 200) + + (let ((lst (delete-duplicates + (cons commit-id (previously-authenticated-commits)))) + (file (authenticated-commit-cache-file))) + (mkdir-p (dirname file)) + (with-atomic-file-output file + (lambda (port) + (let ((lst (if (> (length lst) %max-cache-length) + (take lst %max-cache-length) ;truncate + lst))) + (chmod port #o600) + (display ";; List of previously-authenticated commits.\n\n" + port) + (pretty-print lst port)))))) |