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'.
This commit is contained in:
Ludovic Courtès
parent
876d022c03
commit
838f2bdfa8
@ -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)
|
||||
|
||||
@ -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))))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user