1 files changed, 33 insertions, 49 deletions

diff --git a/guix/pki.scm b/guix/pki.scm
index 6326e065e9..e231518f31 100644
--- a/guix/pki.scm
+++ b/guix/pki.scm
@@ -30,7 +30,6 @@
             current-acl
             public-keys->acl
             acl->public-keys
-            authorized-key?
             write-acl
 
             signature-sexp
@@ -115,22 +114,6 @@ import)' tag."
     (_
      (error "invalid access-control list" acl))))
 
-(define* (authorized-key? key #:optional (acl (current-acl)))
-  "Return #t if KEY (a canonical sexp) is an authorized public key for archive
-imports according to ACL."
-  ;; Note: ACL is kept in native sexp form to make 'authorized-key?' faster,
-  ;; by not having to convert it with 'canonical-sexp->sexp' on each call.
-  ;; TODO: We could use a better data type for ACLs.
-  (let ((key (canonical-sexp->sexp key)))
-    (match acl
-      (('acl
-        ('entry subject-keys
-                ('tag ('guix 'import)))
-        ...)
-       (not (not (member key subject-keys))))
-      (_
-       (error "invalid access-control list" acl)))))
-
 (define (signature-sexp data secret-key public-key)
   "Return a SPKI-style sexp for the signature of DATA with SECRET-KEY that
 includes DATA, the actual signature value (with a 'sig-val' tag), and
@@ -159,23 +142,39 @@ PUBLIC-KEY (see <http://theworld.com/~cme/spki.txt> for examples.)"
     (and data signature
          (verify signature data public-key))))
 
-(define* (%signature-status signature hash
-                            #:optional (acl (current-acl)))
-  "Return a symbol denoting the status of SIGNATURE vs. HASH vs. ACL.
+(define* (%signatures-status signatures hash
+                             #:optional (acl (current-acl)))
+  "Return a symbol denoting the status of SIGNATURES vs. HASH vs. ACL.
 
 This procedure must only be used internally, because it would be easy to
 forget some of the cases."
-  (let ((subject (signature-subject signature))
-        (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)
-            'unauthorized-key)
-        'corrupt-signature)))
+
+  (define guix-import-acl-entries
+    (match acl
+      (('acl entries ...)
+       (filter
+        (match-lambda
+          (('entry parts ...)
+           (member '(tag (guix import)) parts)))
+        entries))
+      (_
+       (error "invalid access-control list" acl))))
+
+  (let loop ((entries guix-import-acl-entries))
+    (match entries
+      (() 'no-matching-acl-entry)
+      ((('entry subject-obj entry-rest ...) other-entries ...)
+       (if (any (lambda (signature)
+                  (let ((subject (signature-subject signature))
+                        (data    (signature-signed-data signature)))
+                    (if (and data subject)
+                        (equal? subject-obj
+                                `(public-key ,(canonical-sexp->sexp subject)))
+                        ;; corrupt signature
+                        #f)))
+                signatures)
+           'matching-acl-entry
+           (loop other-entries))))))
 
 (define-syntax signature-case
   (syntax-rules (valid-signature invalid-signature
@@ -197,25 +196,10 @@ SIGNATURE, and ACL must be canonical sexps; HASH must be a bytevector."
 
     ;; Simple case: we only care about valid signatures.
     ((_ (signature hash acl)
-        (valid-signature valid-exp ...)
+        (matching-acl-entry valid-exp ...)
         (else else-exp ...))
      (case (%signature-status signature hash acl)
-       ((valid-signature) valid-exp ...)
-       (else else-exp ...)))
-
-    ;; Full case.
-    ((_ (signature hash acl)
-        (valid-signature valid-exp ...)
-        (invalid-signature invalid-exp ...)
-        (hash-mismatch mismatch-exp ...)
-        (unauthorized-key unauthorized-exp ...)
-        (corrupt-signature corrupt-exp ...))
-     (case (%signature-status signature hash acl)
-       ((valid-signature) valid-exp ...)
-       ((invalid-signature) invalid-exp ...)
-       ((hash-mismatch) mismatch-exp ...)
-       ((unauthorized-key) unauthorized-exp ...)
-       ((corrupt-signature) corrupt-exp ...)
-       (else (error "bogus signature status"))))))
+       ((matching-acl-entry) valid-exp ...)
+       (else else-exp ...)))))
 
 ;;; pki.scm ends here