amaharaneko/guix-mirrors
1
1
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2025-10-02 02:15:12 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

git-authenticate: Print a clear error message for malformed keys.

Browse source 
Fixes guix/guix#1141.

* guix/git-authenticate.scm (load-keyring-from-blob): Change ‘oid’ to
‘entry’ and adjust accordingly.  Raise a ‘&formatted-message’ error when
‘read-radix-64’ returns #f or EOF.
(load-keyring-from-reference): Adjust accordingly.

Change-Id: Ib88c94dac543caf6b1e0855242ba50063c944765
This commit is contained in:
Ludovic Courtès 2025-07-13 12:43:13 +02:00
parent a138cdb39f
commit df763d6a2d
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 15 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

23
guix/git-authenticate.scm
View file

@ -246,13 +246,22 @@ key: ~a")
signing-key) signing-key)
(define (load-keyring-from-blob repository oid keyring) (define (load-keyring-from-blob repository entry keyring)
"Augment KEYRING with the keyring available in the blob at OID, which may or "Augment KEYRING with the keyring available in ENTRY (a tree entry), which
may not be ASCII-armored." may or may not be ASCII-armored."
(let* ((blob (blob-lookup repository oid)) (let* ((oid (tree-entry-id entry))
(blob (blob-lookup repository oid))
(port (open-bytevector-input-port (blob-content blob)))) (port (open-bytevector-input-port (blob-content blob))))
(get-openpgp-keyring (if (port-ascii-armored? port) (get-openpgp-keyring (if (port-ascii-armored? port)
(open-bytevector-input-port (read-radix-64 port)) (match (read-radix-64 port)
((? bytevector? radix)
(open-bytevector-input-port radix))
(_
(raise
(formatted-message (G_ "malformed \
ASCII-armored key in ~a (blob ~a)")
(tree-entry-name entry)
(oid->string oid)))))
port) port)
keyring))) keyring)))
@ -266,9 +275,7 @@ an OpenPGP keyring."
(fold (lambda (name keyring) (fold (lambda (name keyring)
(if (string-suffix? ".key" name) (if (string-suffix? ".key" name)
(let ((entry (tree-entry-bypath tree name))) (let ((entry (tree-entry-bypath tree name)))
(load-keyring-from-blob repository (load-keyring-from-blob repository entry keyring))
(tree-entry-id entry)
keyring))
keyring)) keyring))
%empty-keyring %empty-keyring
(tree-list tree)))) (tree-list tree))))