Skip to content
Snippets Groups Projects
Unverified Commit 838f2bdf authored by Ludovic Courtès's avatar Ludovic Courtès
Browse files

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'.
parent 876d022c
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
guix/channels.scm
+ 31
− 87
View file @ 838f2bdf
...@@ -315,100 +315,44 @@ (define (apply-patches checkout commit patches) ...@@ -315,100 +315,44 @@ (define (apply-patches checkout commit patches)
(define commit-short-id (define commit-short-id
(compose (cut string-take <> 7) oid->string commit-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 (define* (authenticate-channel channel checkout commit
#:key (keyring-reference-prefix "origin/")) #:key (keyring-reference-prefix "origin/"))
"Authenticate the given COMMIT of CHANNEL, available at CHECKOUT, a "Authenticate the given COMMIT of CHANNEL, available at CHECKOUT, a
directory containing a CHANNEL checkout. Raise an error if authentication directory containing a CHANNEL checkout. Raise an error if authentication
fails." 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. ;; XXX: Too bad we need to re-open CHECKOUT.
(with-repository checkout repository (with-repository checkout repository
(define start-commit (authenticate-repository repository
(commit-lookup repository (string->oid
(string->oid (channel-introduction-first-signed-commit intro))
(channel-introduction-first-signed-commit (channel-introduction-first-commit-signer intro)
(channel-introduction channel))))) #:end (string->oid commit)
#:keyring-reference
(define end-commit (string-append keyring-reference-prefix
(commit-lookup repository (string->oid commit))) keyring-reference)
#:make-reporter make-reporter
(define cache-key #:cache-key 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))))))
(define* (latest-channel-instance store channel (define* (latest-channel-instance store channel
#:key (patches %patches) #:key (patches %patches)
......
guix/git-authenticate.scm
+ 100
− 1
View file @ 838f2bdf
...@@ -18,14 +18,18 @@ ...@@ -18,14 +18,18 @@
(define-module (guix git-authenticate) (define-module (guix git-authenticate)
#:use-module (git) #:use-module (git)
#:autoload (gcrypt hash) (sha256)
#:use-module (guix base16) #: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 i18n)
#:use-module (guix openpgp) #:use-module (guix openpgp)
#:use-module ((guix utils) #:use-module ((guix utils)
#:select (cache-directory with-atomic-file-output)) #:select (cache-directory with-atomic-file-output))
#:use-module ((guix build utils) #:use-module ((guix build utils)
#:select (mkdir-p)) #:select (mkdir-p))
#:use-module (guix progress)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
...@@ -44,6 +48,9 @@ (define-module (guix git-authenticate) ...@@ -44,6 +48,9 @@ (define-module (guix git-authenticate)
previously-authenticated-commits previously-authenticated-commits
cache-authenticated-commit cache-authenticated-commit
repository-cache-key
authenticate-repository
git-authentication-error? git-authentication-error?
git-authentication-error-commit git-authentication-error-commit
unsigned-commit-error? unsigned-commit-error?
...@@ -339,3 +346,95 @@ (define %max-cache-length ...@@ -339,3 +346,95 @@ (define %max-cache-length
(display ";; List of previously-authenticated commits.\n\n" (display ";; List of previously-authenticated commits.\n\n"
port) port)
(pretty-print lst 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))))
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment