From 838f2bdfa862c5017ee93156cf0d42a16d0290e2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 5 Jul 2020 16:47:32 +0200 Subject: [PATCH] git-authenticate: Factorize 'authenticate-repository'. * guix/git-authenticate.scm (repository-cache-key) (verify-introductory-commit, authenticate-repository): New procedures. * guix/channels.scm (verify-introductory-commit): Remove. (authenticate-channel): Rewrite in terms of 'authenticate-repository'. --- guix/channels.scm | 118 ++++++++++---------------------------- guix/git-authenticate.scm | 101 +++++++++++++++++++++++++++++++- 2 files changed, 131 insertions(+), 88 deletions(-) diff --git a/guix/channels.scm b/guix/channels.scm index 500c956f0f..bbabf654a9 100644 --- a/guix/channels.scm +++ b/guix/channels.scm @@ -315,100 +315,44 @@ (define (apply-patches checkout commit patches) (define commit-short-id (compose (cut string-take <> 7) oid->string commit-id)) -(define (verify-introductory-commit repository introduction keyring) - "Raise an exception if the first commit described in INTRODUCTION doesn't -have the expected signer." - (define commit-id - (channel-introduction-first-signed-commit introduction)) - - (define actual-signer - (openpgp-public-key-fingerprint - (commit-signing-key repository (string->oid commit-id) - keyring))) - - (define expected-signer - (channel-introduction-first-commit-signer introduction)) - - (unless (bytevector=? expected-signer actual-signer) - (raise (condition - (&message - (message (format #f (G_ "initial commit ~a is signed by '~a' \ -instead of '~a'") - commit-id - (openpgp-format-fingerprint actual-signer) - (openpgp-format-fingerprint expected-signer)))))))) - (define* (authenticate-channel channel checkout commit #:key (keyring-reference-prefix "origin/")) "Authenticate the given COMMIT of CHANNEL, available at CHECKOUT, a directory containing a CHANNEL checkout. Raise an error if authentication fails." + (define intro + (channel-introduction channel)) + + (define cache-key + (string-append "channels/" (symbol->string (channel-name channel)))) + + (define keyring-reference + (channel-metadata-keyring-reference + (read-channel-metadata-from-source checkout))) + + (define (make-reporter start-commit end-commit commits) + (format (current-error-port) + (G_ "Authenticating channel '~a', commits ~a to ~a (~h new \ +commits)...~%") + (channel-name channel) + (commit-short-id start-commit) + (commit-short-id end-commit) + (length commits)) + + (progress-reporter/bar (length commits))) + ;; XXX: Too bad we need to re-open CHECKOUT. (with-repository checkout repository - (define start-commit - (commit-lookup repository - (string->oid - (channel-introduction-first-signed-commit - (channel-introduction channel))))) - - (define end-commit - (commit-lookup repository (string->oid commit))) - - (define cache-key - (string-append "channels/" (symbol->string (channel-name channel)))) - - (define keyring-reference - (channel-metadata-keyring-reference - (read-channel-metadata-from-source checkout))) - - (define keyring - (load-keyring-from-reference repository - (string-append keyring-reference-prefix - keyring-reference))) - - (define authenticated-commits - ;; Previously-authenticated commits that don't need to be checked again. - (filter-map (lambda (id) - (false-if-exception - (commit-lookup repository (string->oid id)))) - (previously-authenticated-commits cache-key))) - - (define commits - ;; Commits to authenticate, excluding the closure of - ;; AUTHENTICATED-COMMITS. - (commit-difference end-commit start-commit - authenticated-commits)) - - (define reporter - (progress-reporter/bar (length commits))) - - ;; When COMMITS is empty, it's because END-COMMIT is in the closure of - ;; START-COMMIT and/or AUTHENTICATED-COMMITS, in which case it's known to - ;; be authentic already. - (unless (null? commits) - (format (current-error-port) - (G_ "Authenticating channel '~a', \ -commits ~a to ~a (~h new commits)...~%") - (channel-name channel) - (commit-short-id start-commit) - (commit-short-id end-commit) - (length commits)) - - ;; If it's our first time, verify CHANNEL's introductory commit. - (when (null? authenticated-commits) - (verify-introductory-commit repository - (channel-introduction channel) - keyring)) - - (call-with-progress-reporter reporter - (lambda (report) - (authenticate-commits repository commits - #:keyring keyring - #:report-progress report))) - - (cache-authenticated-commit cache-key - (oid->string - (commit-id end-commit)))))) + (authenticate-repository repository + (string->oid + (channel-introduction-first-signed-commit intro)) + (channel-introduction-first-commit-signer intro) + #:end (string->oid commit) + #:keyring-reference + (string-append keyring-reference-prefix + keyring-reference) + #:make-reporter make-reporter + #:cache-key cache-key))) (define* (latest-channel-instance store channel #:key (patches %patches) diff --git a/guix/git-authenticate.scm b/guix/git-authenticate.scm index 082c44ee06..99fd9c3594 100644 --- a/guix/git-authenticate.scm +++ b/guix/git-authenticate.scm @@ -18,14 +18,18 @@ (define-module (guix git-authenticate) #:use-module (git) + #:autoload (gcrypt hash) (sha256) #:use-module (guix base16) - #:use-module ((guix git) #:select (false-if-git-not-found)) + #:autoload (guix base64) (base64-encode) + #:use-module ((guix git) + #:select (commit-difference false-if-git-not-found)) #: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 (guix progress) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) @@ -44,6 +48,9 @@ (define-module (guix git-authenticate) previously-authenticated-commits cache-authenticated-commit + repository-cache-key + authenticate-repository + git-authentication-error? git-authentication-error-commit unsigned-commit-error? @@ -339,3 +346,95 @@ (define %max-cache-length (display ";; List of previously-authenticated commits.\n\n" port) (pretty-print lst port)))))) + + +;;; +;;; High-level interface. +;;; + +(define (repository-cache-key repository) + "Return a unique key to store the authenticate commit cache for REPOSITORY." + (string-append "checkouts/" + (base64-encode + (sha256 (string->utf8 (repository-directory repository)))))) + +(define (verify-introductory-commit repository keyring commit expected-signer) + "Look up COMMIT in REPOSITORY, and raise an exception if it is not signed by +EXPECTED-SIGNER." + (define actual-signer + (openpgp-public-key-fingerprint + (commit-signing-key repository (commit-id commit) keyring))) + + (unless (bytevector=? expected-signer actual-signer) + (raise (condition + (&message + (message (format #f (G_ "initial commit ~a is signed by '~a' \ +instead of '~a'") + (oid->string (commit-id commit)) + (openpgp-format-fingerprint actual-signer) + (openpgp-format-fingerprint expected-signer)))))))) + +(define* (authenticate-repository repository start signer + #:key + (keyring-reference "keyring") + (cache-key (repository-cache-key repository)) + (end (reference-target + (repository-head repository))) + (historical-authorizations '()) + (make-reporter + (const progress-reporter/silent))) + "Authenticate REPOSITORY up to commit END, an OID. Authentication starts +with commit START, an OID, which must be signed by SIGNER; an exception is +raised if that is not the case. Return an alist mapping OpenPGP public keys +to the number of commits signed by that key that have been traversed. + +The OpenPGP keyring is loaded from KEYRING-REFERENCE in REPOSITORY, where +KEYRING-REFERENCE is the name of a branch. The list of authenticated commits +is cached in the authentication cache under CACHE-KEY. + +HISTORICAL-AUTHORIZATIONS must be a list of OpenPGP fingerprints (bytevectors) +denoting the authorized keys for commits whose parent lack the +'.guix-authorizations' file." + (define start-commit + (commit-lookup repository start)) + (define end-commit + (commit-lookup repository end)) + + (define keyring + (load-keyring-from-reference repository keyring-reference)) + + (define authenticated-commits + ;; Previously-authenticated commits that don't need to be checked again. + (filter-map (lambda (id) + (false-if-git-not-found + (commit-lookup repository (string->oid id)))) + (previously-authenticated-commits cache-key))) + + (define commits + ;; Commits to authenticate, excluding the closure of + ;; AUTHENTICATED-COMMITS. + (commit-difference end-commit start-commit + authenticated-commits)) + + ;; When COMMITS is empty, it's because END-COMMIT is in the closure of + ;; START-COMMIT and/or AUTHENTICATED-COMMITS, in which case it's known to + ;; be authentic already. + (if (null? commits) + '() + (let ((reporter (make-reporter start-commit end-commit commits))) + ;; If it's our first time, verify START-COMMIT's signature. + (when (null? authenticated-commits) + (verify-introductory-commit repository keyring + start-commit signer)) + + (let ((stats (call-with-progress-reporter reporter + (lambda (report) + (authenticate-commits repository commits + #:keyring keyring + #:default-authorizations + historical-authorizations + #:report-progress report))))) + (cache-authenticated-commit cache-key + (oid->string (commit-id end-commit))) + + stats))))