Handle non-bytevector hashes from guile-gcrypthandle-non-bytevector-hashes-from-gcrypt

The bytevector->hash-data from (gcrypt pk-crypto) returns a bytevector, symbol
or #f and currently when checking narinfo signatures Guix only handles the
bytevector case.

If the hash value represented as a string happens to contain only characters
that Guile recognises as letters, digits or some symbols,
bytevector->hash-data will return a symbol, and this would be treated as a
hash mismatch since the symbol doesn't equal? the computed hash
bytevector. This seems to be quite unlikely for real life narinfos, but can
happen.

To handle this, detect when a symbol is returned, and convert the symbol to
the equivalent bytevector before making the comparision. This can be fixed
upstream in guile-gcrypt by always returning a bytevector from
bytevector->hash-data.

This commit also adds a test which demonstrates this behaviour using the hash
value I was initially investigating when debugging substituting [1] from
data.guix.gnu.org.

1: /gnu/store/4rc8c5mzfj4j13yb002zd21s10z7yxgb-cl-spatial-trees-0-1.81fdad0-builder

* guix/pki.scm (%signature-status): Handle when hash-data->bytevector returns
a symbol.
* tests/pki.scm ("signature-case valid-signature for non bytevector hash
data"): New test case.

Change-Id: Ie1de05efa20b33128dbb7ab098fb9fb8e22ea407

2 files changed, 37 insertions, 5 deletions

diff --git a/guix/pki.scm b/guix/pki.scm
index 91c1be531a..378f63b4f9 100644
--- a/guix/pki.scm
+++ b/guix/pki.scm
@@ -22,7 +22,9 @@
   #:use-module ((guix utils) #:select (with-atomic-file-output))
   #:use-module ((guix build utils) #:select (mkdir-p))
   #:autoload   (srfi srfi-1) (delete-duplicates)
+  #:use-module (rnrs bytevectors)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 iconv)
   #:use-module (ice-9 rdelim)
   #:export (%public-key-file
             %private-key-file
@@ -171,11 +173,24 @@ forget some of the cases."
         (data    (signature-signed-data signature)))
     (if (and data subject)
         (if (authorized-key? subject acl)
-            (if (equal? (hash-data->bytevector data) hash)
-                (if (valid-signature? signature)
-                    'valid-signature
-                    'invalid-signature)
-                'hash-mismatch)
+            (let* ((hash-data-bytevector
+                    ;; hash-data->bytevector from (gcrypt pk-crypto)
+                    ;; unfortunately doesn't just return a bytevector, it can
+                    ;; return a symbol, bytevector or #f. The returned
+                    ;; bytevector or symbol can represent the hash data, so
+                    ;; convert the symbol here to a bytevector so the
+                    ;; comparison can be made.
+                    (match (hash-data->bytevector data)
+                      ((? bytevector? bv) bv)
+                      ((? symbol? s)
+                       (string->bytevector
+                        (symbol->string s)
+                        "ISO-8859-1")))))
+              (if (equal? hash-data-bytevector hash)
+                  (if (valid-signature? signature)
+                      'valid-signature
+                      'invalid-signature)
+                  'hash-mismatch))
             'unauthorized-key)
         'corrupt-signature)))
 
diff --git a/tests/pki.scm b/tests/pki.scm
index 86daff8ddf..5043dc5f64 100644
--- a/tests/pki.scm
+++ b/tests/pki.scm
@@ -18,9 +18,11 @@
 
 (define-module (test-pki)
   #:use-module (guix pki)
+  #:use-module (gcrypt base16)
   #:use-module (gcrypt pk-crypto)
   #:use-module (gcrypt hash)
   #:use-module (rnrs io ports)
+  #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-64))
 
 ;; Test the (guix pki) module.
@@ -78,6 +80,21 @@
      (valid-signature #t)
      (else #f))))
 
+(test-assert "signature-case valid-signature for non bytevector hash data"
+  (let* ((hash (base16-string->bytevector
+                ;; This hash was observed in the wild producing this behaviour
+                "56efb5d0e5cffb3a6fef4750f94651f2d1e25351e32b49f2ffcafa6bfe4de4e2"))
+         (data (bytevector->hash-data hash #:key-type (key-type %public-key)))
+         (sig  (signature-sexp data %secret-key %public-key)))
+    (and
+     ;; This test could become irrelevant with changes in guile-gcrypt, so
+     ;; check that hash-data->bytevector is not returning a bytevector in this
+     ;; case
+     (not (bytevector? (hash-data->bytevector data)))
+     (signature-case (sig hash (public-keys->acl (list %public-key)))
+       (valid-signature #t)
+       (else #f)))))
+
 (test-eq "signature-case invalid-signature" 'i
   (let* ((hash (sha256 #vu8(1 2 3)))
          (data (bytevector->hash-data hash #:key-type (key-type %public-key)))