From e9c6c58418043f36862a798389f3a7f4253f74cc Mon Sep 17 00:00:00 2001 From: Nikita Karetnikov Date: Sat, 29 Mar 2014 00:06:41 +0100 Subject: substitute-binary: Support the Signature field of a narinfo file. * guix/scripts/substitute-binary.scm (): Add the 'signature' and 'contents' fields. (narinfo-signature->canonical-sexp): New function. (narinfo-maker): Add the 'signature' argument and use it. (assert-valid-signature): New function. (read-narinfo): Support the Signature field. (write-narinfo): Use 'narinfo-contents'. (%allow-unauthenticated-substitutes?): New variable. * guix/base64.scm, tests/base64.scm, tests/substitute-binary.scm: New files. * Makefile.am (SCM_TESTS): Add tests/base64.scm and tests/substitute-binary.scm. (MODULES): Add guix/base64.scm. * test-env.in: Set 'GUIX_ALLOW_UNAUTHENTICATED_SUBSTITUTES'. --- tests/base64.scm | 59 +++++++++++++ tests/substitute-binary.scm | 197 ++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 256 insertions(+) create mode 100644 tests/base64.scm create mode 100644 tests/substitute-binary.scm (limited to 'tests') diff --git a/tests/base64.scm b/tests/base64.scm new file mode 100644 index 0000000000..99c02b531e --- /dev/null +++ b/tests/base64.scm @@ -0,0 +1,59 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Nikita Karetnikov +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (test-base64) + #:use-module (guix base64) + #:use-module (rnrs bytevectors) + #:use-module (srfi srfi-64)) + +(define (string->base64 str) + (base64-encode (string->utf8 str))) + +;;; Test vectors from . + +(test-begin "base64") + +(test-equal "empty string" + (string->base64 "") + "") + +(test-equal "f" + (string->base64 "f") + "Zg==") + +(test-equal "fo" + (string->base64 "fo") + "Zm8=") + +(test-equal "foo" + (string->base64 "foo") + "Zm9v") + +(test-equal "foob" + (string->base64 "foob") + "Zm9vYg==") + +(test-equal "fooba" + (string->base64 "fooba") + "Zm9vYmE=") + +(test-equal "foobar" + (string->base64 "foobar") + "Zm9vYmFy") + +(test-end "base64") \ No newline at end of file diff --git a/tests/substitute-binary.scm b/tests/substitute-binary.scm new file mode 100644 index 0000000000..0903b202f2 --- /dev/null +++ b/tests/substitute-binary.scm @@ -0,0 +1,197 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Nikita Karetnikov +;;; Copyright © 2014 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (test-substitute-binary) + #:use-module (guix scripts substitute-binary) + #:use-module (guix base64) + #:use-module (guix hash) + #:use-module (guix nar) + #:use-module (guix pk-crypto) + #:use-module (guix pki) + #:use-module (rnrs bytevectors) + #:use-module (srfi srfi-34) + #:use-module ((srfi srfi-64) #:hide (test-error))) + +(define assert-valid-signature + ;; (guix scripts substitute-binary) does not export this function in order to + ;; avoid misuse. + (@@ (guix scripts substitute-binary) assert-valid-signature)) + +;;; XXX: Replace with 'test-error' from SRFI-64 as soon as it allow us to +;;; catch specific exceptions. +(define-syntax-rule (test-error* name exp) + (test-assert name + (catch 'quit + (lambda () + exp + #f) + (const #t)))) + +(define %keypair + ;; (display (canonical-sexp->string + ;; (generate-key "(genkey (rsa (nbits 4:1024)))"))) + (string->canonical-sexp + "(key-data + (public-key + (rsa + (n #00D74A00F16DD109A8E773291856A4EF9EE2C2D975E0BC207EA24245C9CFE39E32D8BA5442A2720A57E3A9D9E55E596A8B19CB2EF844E5E859362593914BD626433C887FB798AE87E1DA95D372DFC81E220B8802B04CEC818D9B6B4E2108817755AEBAC23D2FD2B0AB82A52FD785194F3C2D7B9327212588DB74D464EEE5DC9F5B#) + (e #010001#) + ) + ) + (private-key + (rsa + (n #00D74A00F16DD109A8E773291856A4EF9EE2C2D975E0BC207EA24245C9CFE39E32D8BA5442A2720A57E3A9D9E55E596A8B19CB2EF844E5E859362593914BD626433C887FB798AE87E1DA95D372DFC81E220B8802B04CEC818D9B6B4E2108817755AEBAC23D2FD2B0AB82A52FD785194F3C2D7B9327212588DB74D464EEE5DC9F5B#) + (e #010001#) + (d #40E6D963EF143E9241BC10DE7A785C988C89EB1EC33253A5796AFB38FCC804D015500EC8CBCA0F5E318EE9D660DC19E7774E2E89BFD38379297EA87EFBDAC24BA32EE5339215382B2C89F5A817FD9131CA8E8A0A70D58E26E847AD0C447053671A6B2D7746087DE058A02B17701752B8A36EB414435921615AE7CAA8AC48E451#) + (p #00EA88C0C19FE83C09285EF49FF88A1159357FD870031C20F15EF5103FBEB10925299BCA197F7143D6792A1BA7044EDA572EC94FA6B00889F9857216CF5B984403#) + (q #00EAFE541EE9E0531255A85CADBEF64D5F679766D7209F521ADD131CF4B7DA9DF5414901342A146EE84FAA1E35EE0D0F6CE3F5F25989C0D1E9FA5B678D78C113C9#) + (u #59C80FA2C48181F6855691C9D443619BA46C7648056E081697C370D8096E8EF165122D5E55F8FD6A2DCC404FA8BDCDC1FD20B4D76A433F25E8FD6901EC2DBDAD#) + ) + ) + )")) + +(define %public-key + (find-sexp-token %keypair 'public-key)) + +(define %private-key + (find-sexp-token %keypair 'private-key)) + +(define (signature-body str) + (base64-encode + (string->utf8 + (canonical-sexp->string + (signature-sexp (bytevector->hash-data (sha256 (string->utf8 str)) + #:key-type 'rsa) + %private-key + %public-key))))) + +(define %signature-body + (signature-body "secret")) + +(define %wrong-public-key + (string->canonical-sexp "(public-key + (rsa + (n #00E05873AC2B168760343145918E954EE9AB73C026355693B192E01EE835261AA689E9EF46642E895BCD65C648524059FC450E4BA77A68F4C52D0E39EF0CC9359709AB6AAB153B63782201871325B0FDA19CB401CD99FD0C31A91CA9000AA90A77E82B89E036FB63BC1D3961207469B3B12468977148D376F8012BB12A4B11A8F1#) + (e #010001#) + ) + )")) + +(define %wrong-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)) + (string-append str ";irrelevant;" body)) + +(define %signature + (signature "1" %signature-body)) + +(define %acl + (public-keys->acl (list %public-key))) + +(test-begin "substitute-binary") + +(test-error* "not a number" + (narinfo-signature->canonical-sexp (signature "not a number"))) + +(test-error* "wrong version number" + (narinfo-signature->canonical-sexp (signature "2"))) + +(test-assert "valid narinfo-signature->canonical-sexp" + (canonical-sexp? (narinfo-signature->canonical-sexp %signature))) + +(define-syntax-rule (test-error-condition name pred exp) + (test-assert name + (guard (condition ((pred condition) (pk 'true 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? + (assert-valid-signature "invalid sexp" "irrelevant" + (open-input-string "irrelevant") + %acl)) + +(test-error-condition "unauthorized public key" + nar-signature-error? + (assert-valid-signature (canonical-sexp->string + (narinfo-signature->canonical-sexp %signature)) + "irrelevant" + (open-input-string "irrelevant") + (public-keys->acl '()))) + +(test-error-condition "invalid signature" + nar-signature-error? + (assert-valid-signature (canonical-sexp->string + (narinfo-signature->canonical-sexp + %wrong-signature)) + (sha256 (string->utf8 "secret")) + (open-input-string "irrelevant") + (public-keys->acl (list %wrong-public-key)))) + +(define %narinfo + "StorePath: /nix/store/foo +URL: nar/foo +Compression: bzip2 +NarHash: sha256:7 +NarSize: 42 +References: bar baz +Deriver: foo.drv +System: mips64el-linux\n") + +(define (narinfo sig) + (format #f "~aSignature: ~a~%" %narinfo sig)) + +(define %signed-narinfo + (narinfo (signature "1" (signature-body %narinfo)))) + +(test-error-condition "invalid hash" + ;; The hash of '%signature' is computed over the word "secret", not + ;; '%narinfo'. + nar-invalid-hash-error? + (read-narinfo (open-input-string (narinfo %signature)) + "https://example.com" %acl)) + +(test-assert "valid read-narinfo" + (read-narinfo (open-input-string %signed-narinfo) + "https://example.com" %acl)) + +(test-equal "valid write-narinfo" + %signed-narinfo + (call-with-output-string + (lambda (port) + (write-narinfo (read-narinfo (open-input-string %signed-narinfo) + "https://example.com" %acl) + port)))) + +(test-end "substitute-binary") + + +(exit (= (test-runner-fail-count (test-runner-current)) 0)) -- cgit v1.2.3