diff options
| -rw-r--r-- | tests/substitute-binary.scm | 132 |
1 files changed, 62 insertions, 70 deletions
diff --git a/tests/substitute-binary.scm b/tests/substitute-binary.scm index eecc34bb71..d3e94b563c 100644 --- a/tests/substitute-binary.scm +++ b/tests/substitute-binary.scm @@ -30,8 +30,10 @@ #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) #:use-module (web uri) + #:use-module (ice-9 regex) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:use-module ((srfi srfi-64) #:hide (test-error))) (define assert-valid-signature @@ -60,21 +62,17 @@ (call-with-input-file (string-append %config-directory "/signing-key.sec") (compose string->canonical-sexp get-string-all))) -(define* (signature-body str #:key (public-key %public-key)) - "Return the signature of STR as the base64-encoded body of a narinfo's +(define* (signature-body bv #:key (public-key %public-key)) + "Return the signature of BV as the base64-encoded body of a narinfo's 'Signature' field." (base64-encode (string->utf8 (canonical-sexp->string - (signature-sexp (bytevector->hash-data (sha256 (string->utf8 str)) + (signature-sexp (bytevector->hash-data (sha256 bv) #:key-type 'rsa) %private-key public-key))))) -(define %signature-body - ;; Body of the signature of the word "secret". - (signature-body "secret")) - (define %wrong-public-key (string->canonical-sexp "(public-key (rsa @@ -83,76 +81,69 @@ ) )")) -(define %wrong-signature - ;; 'Signature' field where the public key doesn't match the private key used - ;; to make the signature. - (let* ((body (string->canonical-sexp - (utf8->string - (base64-decode %signature-body)))) - (data (canonical-sexp->string (find-sexp-token body 'data))) - (sig-val (canonical-sexp->string (find-sexp-token body 'sig-val))) - (public-key (canonical-sexp->string %wrong-public-key)) - (body* (base64-encode - (string->utf8 - (string-append "(signature \n" data sig-val - public-key " )\n"))))) - (string-append "1;irrelevant;" body*))) - -(define* (signature str #:optional (body %signature-body)) - "Return the 'Signature' field value with STR as the version part and BODY as -the actual base64-encoded signature part." - (string-append str ";irrelevant;" body)) - -(define %signature - ;; Signature computed over the word "secret". - (signature "1" %signature-body)) - -(define %acl - (public-keys->acl (list %public-key))) +(define* (signature-field bv-or-str + #:key (version "1") (public-key %public-key)) + "Return the 'Signature' field value of bytevector/string BV-OR-STR, using +PUBLIC-KEY as the signature's principal, and using VERSION as the signature +version identifier.." + (string-append version ";example.gnu.org;" + (signature-body (if (string? bv-or-str) + (string->utf8 bv-or-str) + bv-or-str) + #:public-key public-key))) + (test-begin "substitute-binary") (test-error* "not a number" - (narinfo-signature->canonical-sexp (signature "not a number"))) + (narinfo-signature->canonical-sexp + (signature-field "foo" #:version "not a number"))) (test-error* "wrong version number" - (narinfo-signature->canonical-sexp (signature "2"))) + (narinfo-signature->canonical-sexp + (signature-field "foo" #:version "2"))) (test-assert "valid narinfo-signature->canonical-sexp" - (canonical-sexp? (narinfo-signature->canonical-sexp %signature))) + (canonical-sexp? (narinfo-signature->canonical-sexp (signature-field "foo")))) -(define-syntax-rule (test-error-condition name pred exp) +(define-syntax-rule (test-error-condition name pred message-rx exp) (test-assert name - (guard (condition ((pred condition) #t) + (guard (condition ((pred condition) + (and (string-match message-rx + (condition-message condition)) + #t)) (else #f)) exp #f))) -;;; XXX: Do we need a better predicate hierarchy for these tests? (test-error-condition "corrupt signature data" - nar-signature-error? + nar-signature-error? "corrupt" (assert-valid-signature (string->canonical-sexp "(foo bar baz)") "irrelevant" (open-input-string "irrelevant") - %acl)) + (public-keys->acl (list %public-key)))) (test-error-condition "unauthorized public key" - nar-signature-error? - (assert-valid-signature (narinfo-signature->canonical-sexp %signature) + nar-signature-error? "unauthorized" + (assert-valid-signature (narinfo-signature->canonical-sexp + (signature-field "foo")) "irrelevant" (open-input-string "irrelevant") (public-keys->acl '()))) (test-error-condition "invalid signature" - nar-signature-error? - (assert-valid-signature (narinfo-signature->canonical-sexp - %wrong-signature) - (sha256 (string->utf8 "secret")) - (open-input-string "irrelevant") - (public-keys->acl (list %wrong-public-key)))) + nar-signature-error? "invalid signature" + (let ((message "this is the message that we sign")) + (assert-valid-signature (narinfo-signature->canonical-sexp + (signature-field message + #:public-key %wrong-public-key)) + (sha256 (string->utf8 message)) + (open-input-string "irrelevant") + (public-keys->acl (list %wrong-public-key))))) (define %narinfo + ;; Skeleton of the narinfo used below. (string-append "StorePath: " (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo URL: nar/foo @@ -163,14 +154,6 @@ References: bar baz Deriver: " (%store-prefix) "/foo.drv System: mips64el-linux\n")) -(define (narinfo sig) - "Return a narinfo with SIG as its 'Signature' field." - (format #f "~aSignature: ~a~%" %narinfo sig)) - -(define %signed-narinfo - ;; Narinfo with a valid signature. - (narinfo (signature "1" (signature-body %narinfo)))) - (define (call-with-narinfo narinfo thunk) "Call THUNK in a context where $GUIX_BINARY_SUBSTITUTE_URL is populated with a file for NARINFO." @@ -205,11 +188,12 @@ a file for NARINFO." (test-equal "query narinfo with invalid hash" - ;; The hash of '%signature' is computed over the word "secret", not - ;; '%narinfo'. + ;; The hash in the signature differs from the hash of %NARINFO. "" - (with-narinfo (narinfo %signature) + (with-narinfo (string-append %narinfo "Signature: " + (signature-field "different body") + "\n") (string-trim-both (with-output-to-string (lambda () @@ -221,7 +205,9 @@ a file for NARINFO." (test-equal "query narinfo signed with authorized key" (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") - (with-narinfo %signed-narinfo + (with-narinfo (string-append %narinfo "Signature: " + (signature-field %narinfo) + "\n") (string-trim-both (with-output-to-string (lambda () @@ -233,9 +219,11 @@ a file for NARINFO." (test-equal "query narinfo signed with unauthorized key" "" ; not substitutable - (with-narinfo (narinfo (signature "1" - (signature-body %narinfo - #:public-key %wrong-public-key))) + (with-narinfo (string-append %narinfo "Signature: " + (signature-field + %narinfo + #:public-key %wrong-public-key) + "\n") (string-trim-both (with-output-to-string (lambda () @@ -245,18 +233,21 @@ a file for NARINFO." (guix-substitute-binary "--query")))))))) (test-error* "substitute, invalid hash" - ;; The hash of '%signature' is computed over the word "secret", not - ;; '%narinfo'. - (with-narinfo (narinfo %signature) + ;; The hash in the signature differs from the hash of %NARINFO. + (with-narinfo (string-append %narinfo "Signature: " + (signature-field "different body") + "\n") (guix-substitute-binary "--substitute" (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") "foo"))) (test-error* "substitute, unauthorized key" - (with-narinfo (narinfo (signature "1" - (signature-body %narinfo - #:public-key %wrong-public-key))) + (with-narinfo (string-append %narinfo "Signature: " + (signature-field + %narinfo + #:public-key %wrong-public-key) + "\n") (guix-substitute-binary "--substitute" (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") @@ -269,5 +260,6 @@ a file for NARINFO." ;;; Local Variables: ;;; eval: (put 'with-narinfo 'scheme-indent-function 1) +;;; eval: (put 'test-error-condition 'scheme-indent-function 3) ;;; eval: (put 'test-error* 'scheme-indent-function 1) ;;; End: |