From 52c529ff20b389eb64ac033586e6b1a5c5d82cb5 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 10 Jun 2020 14:54:13 +0200
Subject: git-authenticate: Disallow SHA1 (and MD5) signatures.

* guix/git-authenticate.scm (commit-signing-key): Add
 #:disallowed-hash-algorithms and honor it.
(authenticate-commit)[recent-commit?]: New variable.
Pass #:disallowed-hash-algorithms to 'commit-signing-key'.
* tests/git-authenticate.scm ("signed commits, SHA1 signature"): New test.
---
 guix/git-authenticate.scm  | 29 ++++++++++++++++++++++++++---
 tests/git-authenticate.scm | 29 +++++++++++++++++++++++++++++
 2 files changed, 55 insertions(+), 3 deletions(-)

diff --git a/guix/git-authenticate.scm b/guix/git-authenticate.scm
index c333717136..0d6f696a0b 100644
--- a/guix/git-authenticate.scm
+++ b/guix/git-authenticate.scm
@@ -85,9 +85,11 @@
   (signature missing-key-error-signature))
 
 
-(define (commit-signing-key repo commit-id keyring)
+(define* (commit-signing-key repo commit-id keyring
+                             #:key (disallowed-hash-algorithms '(sha1)))
   "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
+if the commit is unsigned, has an invalid signature, has a signature using one
+of the hash algorithms in DISALLOWED-HASH-ALGORITHMS, or if its signing key is
 not in KEYRING."
   (let-values (((signature signed-data)
                 (catch 'git-error
@@ -103,6 +105,17 @@ not in KEYRING."
                                 (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, \
+which is not permitted")
+                                  (oid->string commit-id)
+                                  (openpgp-signature-hash-algorithm
+                                   signature)))))))
+
       (with-fluids ((%default-port-encoding "UTF-8"))
         (let-values (((status data)
                       (verify-openpgp-signature signature keyring
@@ -198,8 +211,18 @@ not specify anything, fall back to DEFAULT-AUTHORIZATIONS."
   (define id
     (commit-id commit))
 
+  (define recent-commit?
+    (false-if-git-not-found
+     (tree-entry-bypath (commit-tree commit) ".guix-authorizations")))
+
   (define signing-key
-    (commit-signing-key repository id keyring))
+    (commit-signing-key repository id keyring
+                        ;; Reject SHA1 signatures unconditionally as suggested
+                        ;; by the authors of "SHA-1 is a Shambles" (2019).
+                        ;; Accept it for "historical" commits (there are such
+                        ;; signatures from April 2020 in the repository).
+                        #:disallowed-hash-algorithms
+                        (if recent-commit? '(sha1) '())))
 
   (unless (member (openpgp-public-key-fingerprint signing-key)
                   (commit-authorized-keys repository commit
diff --git a/tests/git-authenticate.scm b/tests/git-authenticate.scm
index 84689d628e..97990acaea 100644
--- a/tests/git-authenticate.scm
+++ b/tests/git-authenticate.scm
@@ -81,6 +81,35 @@
                                 #:keyring-reference "master")
           'failed)))))
 
+(unless (which (git-command)) (test-skip 1))
+(test-assert "signed commits, SHA1 signature"
+  (with-fresh-gnupg-setup (list %ed25519-public-key-file
+                                %ed25519-secret-key-file)
+    ;; Force use of SHA1 for signatures.
+    (call-with-output-file (string-append (getenv "GNUPGHOME") "/gpg.conf")
+      (lambda (port)
+        (display "digest-algo sha1" port)))
+
+    (with-temporary-git-repository directory
+        `((add "a.txt" "A")
+          (add "signer.key" ,(call-with-input-file %ed25519-public-key-file
+                               get-string-all))
+          (add ".guix-authorizations"
+               ,(object->string
+                 `(authorizations (version 0)
+                                  ((,(key-fingerprint %ed25519-public-key-file)
+                                    (name "Charlie"))))))
+          (commit "first commit"
+                  (signer ,(key-fingerprint %ed25519-public-key-file))))
+      (with-repository directory repository
+        (let ((commit (find-commit repository "first")))
+          (guard (c ((unsigned-commit-error? c)
+                     (oid=? (git-authentication-error-commit c)
+                            (commit-id commit))))
+            (authenticate-commits repository (list commit)
+                                  #:keyring-reference "master")
+            'failed))))))
+
 (unless (gpg+git-available?) (test-skip 1))
 (test-assert "signed commits, default authorizations"
   (with-fresh-gnupg-setup (list %ed25519-public-key-file
-- 
cgit v1.2.3