diff options
| -rw-r--r-- | .dir-locals.el | 2 | ||||
| -rw-r--r-- | guix/pki.scm | 62 | ||||
| -rw-r--r-- | tests/pki.scm | 79 |
3 files changed, 139 insertions, 4 deletions
diff --git a/.dir-locals.el b/.dir-locals.el index 22ade9f8a5..49380fe4ba 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -8,6 +8,7 @@ ((indent-tabs-mode . nil) (eval . (put 'test-assert 'scheme-indent-function 1)) (eval . (put 'test-equal 'scheme-indent-function 1)) + (eval . (put 'test-eq 'scheme-indent-function 1)) (eval . (put 'call-with-input-string 'scheme-indent-function 1)) (eval . (put 'guard 'scheme-indent-function 1)) (eval . (put 'lambda* 'scheme-indent-function 1)) @@ -24,6 +25,7 @@ (eval . (put 'with-atomic-file-output 'scheme-indent-function 1)) (eval . (put 'call-with-compressed-output-port 'scheme-indent-function 2)) (eval . (put 'call-with-decompressed-port 'scheme-indent-function 2)) + (eval . (put 'signature-case 'scheme-indent-function 1)) (eval . (put 'syntax-parameterize 'scheme-indent-function 1)) (eval . (put 'with-monad 'scheme-indent-function 1)) 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 diff --git a/tests/pki.scm b/tests/pki.scm index 04d5a5311b..51f2119466 100644 --- a/tests/pki.scm +++ b/tests/pki.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,6 +19,7 @@ (define-module (test-pki) #:use-module (guix pki) #:use-module (guix pk-crypto) + #:use-module (guix hash) #:use-module (rnrs io ports) #:use-module (srfi srfi-64)) @@ -26,8 +27,28 @@ (define %public-key (call-with-input-file %public-key-file - (compose string->canonical-sexp - get-string-all))) + (compose string->canonical-sexp get-string-all))) + +(define %secret-key + (call-with-input-file %private-key-file + (compose string->canonical-sexp get-string-all))) + +(define %alternate-secret-key + (string->canonical-sexp + " + (key-data + (public-key + (rsa + (n #00FDBF170366AC43B7D95CF9085565C566FB1F21B17C0A36E68F35ABB500E7851E00B40D7B04C8CD25903371F38E4C298FACEFFC4C97E913B536A0672BAF99D04515AE98A1A56627CD7EB02502FCFBEEA21AF13CC1A853192AD6409B9EFBD9F549BDE32BD890AE01F9A221E81FEE1C407090550647790E0D60775B855E181C2FB5#) + (e #010001#))) + (private-key + (rsa + (n #00FDBF170366AC43B7D95CF9085565C566FB1F21B17C0A36E68F35ABB500E7851E00B40D7B04C8CD25903371F38E4C298FACEFFC4C97E913B536A0672BAF99D04515AE98A1A56627CD7EB02502FCFBEEA21AF13CC1A853192AD6409B9EFBD9F549BDE32BD890AE01F9A221E81FEE1C407090550647790E0D60775B855E181C2FB5#) + (e #010001#) + (d #2790250C2E74C2FD361A99288BBA19B878048F5A0F333F829CC71B3DD64582DB9DF3F4DB1EB0994DD7493225EDA4A1E1492F44D903617FA5643E47BFC7BA157EF48B492AB51229916B02DDBDA0E7DBC7B35A6B8332AB463DC61951CA694551A9760F5A836A375D39E3EA8F2C502A3B5D89CB8777A809B75D603BE7511CEB74E9#) + (p #00FE15B1751E1C31125B724FF37462F9476239A2AFF4192FAB1550F76928C8D02407F4F5EFC83F7A0AF51BD93399DDC06A4B54DFA60A7079F160A9F618C0148AD9#) + (q #00FFA8BE7005AAB7401B0926CD9D6AC30BC9BE7D12C8737C9438498A999F56BE9F5EA98B4D7F5364BEB6D550A5AEDDE34C1EC152C9DAF61A97FDE71740C73BAA3D#) + (u #00FD4050EF4F31B41EC81C28E18D205DFFB3C188F15D8BBA300E30AD8B5C4D3E392EFE10269FC115A538B19F4025973AB09B6650A7FF97DA833FB726F3D8819319#))))")) (test-begin "pki") @@ -45,6 +66,58 @@ (test-assert "authorized-key? public-key singleton" (authorized-key? %public-key (public-keys->acl (list %public-key)))) +(test-assert "signature-case valid-signature" + (let* ((hash (sha256 #vu8(1 2 3))) + (data (bytevector->hash-data hash #:key-type (key-type %public-key))) + (sig (signature-sexp data %secret-key %public-key))) + (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))) + (sig (signature-sexp data %alternate-secret-key %public-key))) + (signature-case (sig hash (public-keys->acl (list %public-key))) + (valid-signature 'v) + (invalid-signature 'i) + (hash-mismatch 'm) + (unauthorized-key 'u) + (corrupt-signature 'c)))) + +(test-eq "signature-case hash-mismatch" 'm + (let* ((hash (sha256 #vu8(1 2 3))) + (data (bytevector->hash-data hash #:key-type (key-type %public-key))) + (sig (signature-sexp data %secret-key %public-key))) + (signature-case (sig (sha256 #vu8()) + (public-keys->acl (list %public-key))) + (valid-signature 'v) + (invalid-signature 'i) + (hash-mismatch 'm) + (unauthorized-key 'u) + (corrupt-signature 'c)))) + +(test-eq "signature-case unauthorized-key" 'u + (let* ((hash (sha256 #vu8(1 2 3))) + (data (bytevector->hash-data hash #:key-type (key-type %public-key))) + (sig (signature-sexp data %secret-key %public-key))) + (signature-case (sig hash (public-keys->acl '())) + (valid-signature 'v) + (invalid-signature 'i) + (hash-mismatch 'm) + (unauthorized-key 'u) + (corrupt-signature 'c)))) + +(test-eq "signature-case corrupt-signature" 'c + (let* ((hash (sha256 #vu8(1 2 3))) + (sig (string->canonical-sexp "(w tf)"))) + (signature-case (sig hash (public-keys->acl (list %public-key))) + (valid-signature 'v) + (invalid-signature 'i) + (hash-mismatch 'm) + (unauthorized-key 'u) + (corrupt-signature 'c)))) + (test-end) |