aboutsummaryrefslogtreecommitdiff
path: root/build-aux/git-authenticate.scm
diff options
context:
space:
mode:
Diffstat (limited to 'build-aux/git-authenticate.scm')
-rw-r--r--build-aux/git-authenticate.scm198
1 files changed, 127 insertions, 71 deletions
diff --git a/build-aux/git-authenticate.scm b/build-aux/git-authenticate.scm
index bb48dddc59..7bb3af6ecb 100644
--- a/build-aux/git-authenticate.scm
+++ b/build-aux/git-authenticate.scm
@@ -23,8 +23,10 @@
(use-modules (git)
(guix git)
- (guix gnupg)
- (guix utils)
+ (guix openpgp)
+ (guix base16)
+ ((guix utils)
+ #:select (cache-directory with-atomic-file-output))
((guix build utils) #:select (mkdir-p))
(guix i18n)
(guix progress)
@@ -33,6 +35,7 @@
(srfi srfi-26)
(srfi srfi-34)
(srfi srfi-35)
+ (rnrs bytevectors)
(rnrs io ports)
(ice-9 match)
(ice-9 format)
@@ -215,7 +218,8 @@
;; Fingerprint of authorized signing keys.
(map (match-lambda
((name fingerprint)
- (string-filter char-set:graphic fingerprint)))
+ (base16-string->bytevector
+ (string-downcase (string-filter char-set:graphic fingerprint)))))
%committers))
(define %commits-with-bad-signature
@@ -226,93 +230,146 @@
;; Commits lacking a signature.
'())
-(define-syntax-rule (with-temporary-files file1 file2 exp ...)
- (call-with-temporary-output-file
- (lambda (file1 port1)
- (call-with-temporary-output-file
- (lambda (file2 port2)
- exp ...)))))
-
-(define (commit-signing-key repo commit-id)
- "Return the OpenPGP key ID that signed COMMIT-ID (an OID). Raise an
-exception if the commit is unsigned or has an invalid 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)))))
- (if (not signature)
- (raise (condition
- (&message
- (message (format #f (G_ "commit ~a lacks a signature")
- commit-id)))))
- (begin
- (with-fluids ((%default-port-encoding "UTF-8"))
- (with-temporary-files data-file signature-file
- (call-with-output-file data-file
- (cut display signed-data <>))
- (call-with-output-file signature-file
- (cut display signature <>))
-
- (let-values (((status data)
- (with-error-to-port (%make-void-port "w")
- (lambda ()
- (gnupg-verify* signature-file data-file
- #:key-download 'always)))))
- (match status
- ('invalid-signature
- ;; There's a signature but it's invalid.
- (raise (condition
- (&message
- (message (format #f (G_ "signature verification failed \
+ (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 \
+ (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))))))
- ('valid-signature
- (match data
- ((fingerprint . user)
- fingerprint)))))))))))
-
-(define (authenticate-commit repository commit)
+ (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))
+ (commit-signing-key repository id keyring))
- (unless (member signing-key %authorized-signing-keys)
+ (unless (member (openpgp-public-key-fingerprint signing-key)
+ (commit-authorized-keys repository commit
+ %authorized-signing-keys))
(raise (condition
(&message
(message (format #f (G_ "commit ~a not signed by an authorized \
key: ~a")
- (oid->string id) signing-key))))))
+ (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 (reference-lookup repository reference))
+ (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 (report-progress (const #t)))
+ #:key
+ (keyring-reference "refs/heads/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."
- (parameterize ((current-keyring (string-append (config-directory)
- "/keyrings/channels/guix.kbx")))
- (fold (lambda (commit stats)
- (report-progress)
- (let ((signer (authenticate-commit repository commit)))
- (match (assoc signer stats)
- (#f (cons `(,signer . 1) stats))
- ((_ . count) (cons `(,signer . ,(+ count 1))
- (alist-delete signer stats))))))
- '()
- commits)))
+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))
@@ -409,7 +466,10 @@ COMMIT-ID is written to cache, though)."
(format #t (G_ "Signing statistics:~%"))
(for-each (match-lambda
((signer . count)
- (format #t " ~a ~10d~%" signer count)))
+ (format #t " ~a ~10d~%"
+ (openpgp-format-fingerprint
+ (openpgp-public-key-fingerprint signer))
+ count)))
(sort stats
(match-lambda*
(((_ . count1) (_ . count2))
@@ -423,7 +483,3 @@ COMMIT-ID is written to cache, though)."
(G_ "Usage: git-authenticate START [END]
Authenticate commits START to END or the current head.\n"))))))
-
-;;; Local Variables:
-;;; eval: (put 'with-temporary-files 'scheme-indent-function 2)
-;;; End: