From 81deef270ded7dabcc623d9522ae593ed02160af Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Mon, 31 Mar 2014 23:34:20 +0200
Subject: pki: Add 'signature-case' macro.

* guix/pki.scm (%signature-status): New procedure.
  (signature-case): New macro.
* tests/pki.scm (%secret-key, %alternate-secret-key): New variables.
  ("signature-case valid-signature", "signature-case invalid-signature",
  "signature-case hash-mismatch", "signature-case unauthorized-key",
  "signature-case corrupt-signature"): New tests.
---
 guix/pki.scm | 62 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 61 insertions(+), 1 deletion(-)

(limited to 'guix/pki.scm')

diff --git a/guix/pki.scm b/guix/pki.scm
index 4b90b65a13..609c03f8d8 100644
--- a/guix/pki.scm
+++ b/guix/pki.scm
@@ -34,7 +34,8 @@
             signature-sexp
             signature-subject
             signature-signed-data
-            valid-signature?))
+            valid-signature?
+            signature-case))
 
 ;;; Commentary:
 ;;;
@@ -157,4 +158,63 @@ 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.
+
+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-syntax signature-case
+  (syntax-rules (valid-signature invalid-signature
+                 hash-mismatch unauthorized-key corrupt-signature
+                 else)
+    "\
+Match the cases of the verification of SIGNATURE against HASH and ACL:
+
+  - the 'valid-signature' case if SIGNATURE is indeed a signature of HASH with
+    a key present in ACL;
+  - 'invalid-signature' if SIGNATURE is incorrect;
+  - 'hash-mismatch' if the hash in SIGNATURE does not match HASH;
+  - 'unauthorized-key' if the public key in SIGNATURE is not listed in ACL;
+  - 'corrupt-signature' if SIGNATURE is not a valid signature sexp.
+
+This macro guarantees at compile-time that all these cases are handled.
+
+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 ...)
+        (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"))))))
+
 ;;; pki.scm ends here
-- 
cgit v1.2.3