;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
#:use-module ((guix git)
#:select (commit-difference false-if-git-not-found))
#:use-module (guix i18n)
+ #:use-module ((guix diagnostics) #:select (formatted-message))
#:use-module (guix openpgp)
#:use-module ((guix utils)
#:select (cache-directory with-atomic-file-output))
(lambda _
(values #f #f)))))
(unless signature
- (raise (condition
- (&unsigned-commit-error (commit commit-id))
- (&message
- (message (format #f (G_ "commit ~a lacks a signature")
- (oid->string commit-id)))))))
+ (raise (make-compound-condition
+ (condition (&unsigned-commit-error (commit commit-id)))
+ (formatted-message (G_ "commit ~a lacks a signature")
+ (oid->string commit-id)))))
(let ((signature (string->openpgp-packet signature)))
(when (memq (openpgp-signature-hash-algorithm signature)
`(,@disallowed-hash-algorithms md5))
- (raise (condition
- (&unsigned-commit-error (commit commit-id))
- (&message
- (message (format #f (G_ "commit ~a has a ~a signature, \
+ (raise (make-compound-condition
+ (condition (&unsigned-commit-error (commit commit-id)))
+ (formatted-message (G_ "commit ~a has a ~a signature, \
which is not permitted")
- (oid->string commit-id)
- (openpgp-signature-hash-algorithm
- signature)))))))
+ (oid->string commit-id)
+ (openpgp-signature-hash-algorithm
+ signature)))))
(with-fluids ((%default-port-encoding "UTF-8"))
(let-values (((status data)
(match status
('bad-signature
;; There's a signature but it's invalid.
- (raise (condition
- (&signature-verification-error (commit commit-id)
- (signature signature)
- (keyring keyring))
- (&message
- (message (format #f (G_ "signature verification failed \
+ (raise (make-compound-condition
+ (condition
+ (&signature-verification-error (commit commit-id)
+ (signature signature)
+ (keyring keyring)))
+ (formatted-message (G_ "signature verification failed \
for commit ~a")
- (oid->string commit-id)))))))
+ (oid->string commit-id)))))
('missing-key
- (raise (condition
- (&missing-key-error (commit commit-id)
- (signature signature))
- (&message
- (message (format #f (G_ "could not authenticate \
+ (raise (make-compound-condition
+ (condition (&missing-key-error (commit commit-id)
+ (signature signature)))
+ (formatted-message (G_ "could not authenticate \
commit ~a: key ~a is missing")
- (oid->string commit-id)
- data))))))
+ (oid->string commit-id)
+ (openpgp-format-fingerprint data)))))
('good-signature data)))))))
(define (read-authorizations port)
;; If COMMIT removes the '.guix-authorizations' file found in one of its
;; parents, raise an error.
(when (parents-have-authorizations-file? commit)
- (raise (condition
- (&unauthorized-commit-error (commit (commit-id commit))
- (signing-key #f))
- (&message
- (message (format #f (G_ "commit ~a attempts \
+ (raise (make-compound-condition
+ (condition
+ (&unauthorized-commit-error (commit (commit-id commit))
+ (signing-key #f)))
+ (formatted-message (G_ "commit ~a attempts \
to remove '.guix-authorizations' file")
- (oid->string (commit-id commit)))))))))
+ (oid->string (commit-id commit)))))))
(define (commit-authorizations commit)
(catch 'git-error
(unless (member (openpgp-public-key-fingerprint signing-key)
(commit-authorized-keys repository commit
default-authorizations))
- (raise (condition
- (&unauthorized-commit-error (commit id)
- (signing-key signing-key))
- (&message
- (message (format #f (G_ "commit ~a not signed by an authorized \
+ (raise (make-compound-condition
+ (condition
+ (&unauthorized-commit-error (commit id)
+ (signing-key signing-key)))
+ (formatted-message (G_ "commit ~a not signed by an authorized \
key: ~a")
- (oid->string id)
- (openpgp-format-fingerprint
- (openpgp-public-key-fingerprint
- signing-key))))))))
+ (oid->string id)
+ (openpgp-format-fingerprint
+ (openpgp-public-key-fingerprint
+ signing-key))))))
signing-key)
(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' \
+ (raise (formatted-message (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))))))))
+ (openpgp-format-fingerprint expected-signer)))))
(define* (authenticate-repository repository start signer
#:key
(cache-key (repository-cache-key repository))
(end (reference-target
(repository-head repository)))
+ (authentic-commits '())
(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
+raised if that is not the case. Commits listed in AUTHENTIC-COMMITS and their
+closure are considered authentic. 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
(filter-map (lambda (id)
(false-if-git-not-found
(commit-lookup repository (string->oid id))))
- (previously-authenticated-commits cache-key)))
+ (append (previously-authenticated-commits cache-key)
+ authentic-commits)))
(define commits
;; Commits to authenticate, excluding the closure of
HCoop / jackhill / guix / guix.git / blobdiff