summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-07-05 16:47:32 +0200
committerLudovic Courtès <ludo@gnu.org>2020-07-11 11:51:52 +0200
commit838f2bdfa862c5017ee93156cf0d42a16d0290e2 (patch)
treedd4734c6085f4364f9df28a676602ec3f4c2ca04
parent876d022c03fb9e961c0e199b9b7c7e4edcec491c (diff)
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'.
-rw-r--r--guix/channels.scm118
-rw-r--r--guix/git-authenticate.scm101
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 @@ result is unspecified."
(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 @@
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 @@ authenticated (only COMMIT-ID is written to cache, though)."
(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))))