From cdea30e061490a521f1e9c66ff870ca98ae5d7e5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 30 Mar 2014 22:29:35 +0200 Subject: [PATCH] substitute-binary: Defer narinfo authentication and authorization checks. * guix/scripts/substitute-binary.scm (narinfo-signature->canonical-sexp): Catch 'gcry-error' around 'string->canonical-sexp' call, and re-raise as a SRFI-35 &message and &nar-signature-error. (narinfo-maker): Handle when SIGNATURE is #f or an invalid canonical sexp. (&nar-signature-error, &nar-invalid-hash-error): New variables. (assert-valid-signature): Use them. Expect 'signature' to be a canonical sexp. (read-narinfo): Remove authentication and authorization checks. (%signature-line-rx): New variable. (assert-valid-narinfo, valid-narinfo?): New procedures. (guix-substitute-binary): Wrap body in 'with-error-handling'. [valid?]: New procedure. <--query>: Show only store items of narinfos that match 'valid-narinfo?'. <--substitute>: Call 'assert-valid-narinfo'. * tests/substitute-binary.scm (test-error*): Use 'test-equal'. (%keypair): Remove. (%public-key, %private-key): Load from signing-key.{pub,sec}. (signature-body): Add #:public-key parameter. (call-with-narinfo): New procedure. (with-narinfo): New macro. ("corrupt signature data", "unauthorized public key", "invalid signature"): Make the first argument to 'assert-valid-signature' a canonical sexp. ("invalid hash", "valid read-narinfo", "valid write-narinfo"): Remove. ("query narinfo with invalid hash", "query narinfo signed with authorized key", "query narinfo signed with unauthorized key", "substitute, invalid hash", "substitute, unauthorized key"): New tests. --- guix/scripts/substitute-binary.scm | 301 ++++++++++++++++------------- tests/substitute-binary.scm | 188 ++++++++++++------ 2 files changed, 303 insertions(+), 186 deletions(-) diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm index 8903add90b..d97aeaaee7 100755 --- a/guix/scripts/substitute-binary.scm +++ b/guix/scripts/substitute-binary.scm @@ -247,8 +247,19 @@ failure." ((not (= 1 maybe-number)) (leave (_ "unsupported signature version: ~a~%") maybe-number)) - (else (string->canonical-sexp - (utf8->string (base64-decode sig))))))) + (else + (let ((signature (utf8->string (base64-decode sig)))) + (catch 'gcry-error + (lambda () + (string->canonical-sexp signature)) + (lambda (err . _) + (raise (condition + (&message + (message "signature is not a valid \ +s-expression")) + (&nar-signature-error + (file #f) + (signature signature) (port #f))))))))))) (x (leave (_ "invalid format of the signature field: ~a~%") x)))) @@ -273,33 +284,24 @@ must contain the original contents of a narinfo file." ((or #f "") #f) (_ deriver)) system - (narinfo-signature->canonical-sexp signature) + (false-if-exception + (and=> signature narinfo-signature->canonical-sexp)) str))) +(define &nar-signature-error (@@ (guix nar) &nar-signature-error)) +(define &nar-invalid-hash-error (@@ (guix nar) &nar-invalid-hash-error)) + ;;; XXX: The following function is nearly an exact copy of the one from ;;; 'guix/nar.scm'. Factorize as soon as we know how to make the latter ;;; public (see ). ;;; Keep this one private to avoid confusion. (define* (assert-valid-signature signature hash port #:optional (acl (current-acl))) - "Bail out if SIGNATURE, a string (as produced by 'canonical-sexp->string'), -doesn't match HASH, a bytevector containing the expected hash for FILE." - (let* ((&nar-signature-error (@@ (guix nar) &nar-signature-error)) - (&nar-invalid-hash-error (@@ (guix nar) &nar-invalid-hash-error)) - ;; XXX: This is just to keep the errors happy; get a sensible - ;; filename. + "Bail out if SIGNATURE, a canonical sexp, doesn't match HASH, a bytevector +containing the expected hash for FILE." + (let* (;; XXX: This is just to keep the errors happy; get a sensible + ;; file name. (file #f) - (signature (catch 'gcry-error - (lambda () - (string->canonical-sexp signature)) - (lambda (err . _) - (raise (condition - (&message - (message "signature is not a valid \ -s-expression")) - (&nar-signature-error - (file file) - (signature signature) (port port))))))) (subject (signature-subject signature)) (data (signature-signed-data signature))) (if (and data subject) @@ -324,25 +326,42 @@ s-expression")) (&nar-signature-error (signature signature) (file file) (port port))))))) -(define* (read-narinfo port #:optional url (acl (current-acl))) +(define* (read-narinfo port #:optional url) "Read a narinfo from PORT. If URL is true, it must be a string used to -build full URIs from relative URIs found while reading PORT." - (let* ((str (utf8->string (get-bytevector-all port))) - (rx (make-regexp "(.+)^[[:blank:]]*Signature:[[:blank:]].+$")) - (res (or (regexp-exec rx str) - (leave (_ "cannot find the Signature line: ~a~%") - str))) - (hash (sha256 (string->utf8 (match:substring res 1)))) - (narinfo (alist->record (fields->alist (open-input-string str)) - (narinfo-maker str url) - '("StorePath" "URL" "Compression" - "FileHash" "FileSize" "NarHash" "NarSize" - "References" "Deriver" "System" - "Signature"))) - (signature (canonical-sexp->string (narinfo-signature narinfo)))) - (unless %allow-unauthenticated-substitutes? - (assert-valid-signature signature hash port acl)) - narinfo)) +build full URIs from relative URIs found while reading PORT. + +No authentication and authorization checks are performed here!" + (let ((str (utf8->string (get-bytevector-all port)))) + (alist->record (call-with-input-string str fields->alist) + (narinfo-maker str url) + '("StorePath" "URL" "Compression" + "FileHash" "FileSize" "NarHash" "NarSize" + "References" "Deriver" "System" + "Signature")))) + +(define %signature-line-rx + ;; Regexp matching a signature line in a narinfo. + (make-regexp "(.+)^[[:blank:]]*Signature:[[:blank:]].+$")) + +(define* (assert-valid-narinfo narinfo #:optional (acl (current-acl))) + "Raise an exception if NARINFO lacks a signature, has an invalid signature, +or is signed by an unauthorized key." + (let* ((contents (narinfo-contents narinfo)) + (res (regexp-exec %signature-line-rx contents))) + (if (not res) + (if %allow-unauthenticated-substitutes? + narinfo + (leave (_ "narinfo lacks a signature: ~s~%") + contents)) + (let ((hash (sha256 (string->utf8 (match:substring res 1)))) + (signature (narinfo-signature narinfo))) + (unless %allow-unauthenticated-substitutes? + (assert-valid-signature signature hash #f acl)) + narinfo)))) + +(define (valid-narinfo? narinfo) + "Return #t if NARINFO's signature is not valid." + (false-if-exception (begin (assert-valid-narinfo narinfo) #t))) (define (write-narinfo narinfo port) "Write NARINFO to PORT." @@ -353,7 +372,8 @@ build full URIs from relative URIs found while reading PORT." (call-with-output-string (cut write-narinfo narinfo <>))) (define (string->narinfo str cache-uri) - "Return the narinfo represented by STR." + "Return the narinfo represented by STR. Assume CACHE-URI as the base URI of +the cache STR originates form." (call-with-input-string str (cut read-narinfo <> cache-uri))) (define (fetch-narinfo cache path) @@ -391,9 +411,9 @@ check what it has." (string-append %narinfo-cache-directory "/" (store-path-hash-part path))) - (define (cache-entry narinfo) + (define (cache-entry cache-uri narinfo) `(narinfo (version 1) - (cache-uri ,(narinfo-uri-base narinfo)) + (cache-uri ,cache-uri) (date ,(time-second now)) (value ,(and=> narinfo narinfo->string)))) @@ -432,7 +452,7 @@ check what it has." (when cache (with-atomic-file-output cache-file (lambda (out) - (write (cache-entry narinfo) out)))) + (write (cache-entry (cache-url cache) narinfo) out)))) narinfo)))) (define (remove-expired-cached-narinfos) @@ -570,6 +590,21 @@ Internal tool to substitute a pre-built binary to a local build.\n")) (lambda (n proc lst) (par-map proc lst)))) +(define (check-acl-initialized) + "Warn if the ACL is uninitialized." + (define (singleton? acl) + ;; True if ACL contains just the user's public key. + (and (file-exists? %public-key-file) + (let ((key (call-with-input-file %public-key-file + (compose string->canonical-sexp + get-string-all)))) + (equal? (acl->public-keys acl) (list key))))) + + (let ((acl (current-acl))) + (when (or (null? acl) (singleton? acl)) + (warning (_ "ACL for archive imports seems to be uninitialized, \ +substitutes may be unavailable\n"))))) + (define (guix-substitute-binary . args) "Implement the build daemon's substituter protocol." (mkdir-p %narinfo-cache-directory) @@ -598,96 +633,102 @@ substituter disabled~%") (force-output (current-output-port)) (with-networking - (match args - (("--query") - (let ((cache (delay (open-cache %cache-url)))) - (let loop ((command (read-line))) - (or (eof-object? command) - (begin - (match (string-tokenize command) - (("have" paths ..1) - ;; Return the subset of PATHS available in CACHE. - (let ((substitutable - (if cache - (n-par-map* %lookup-threads - (cut lookup-narinfo cache <>) - paths) - '()))) - (for-each (lambda (narinfo) - (when narinfo - (format #t "~a~%" (narinfo-path narinfo)))) - (filter narinfo? substitutable)) - (newline))) - (("info" paths ..1) - ;; Reply info about PATHS if it's in CACHE. - (let ((substitutable - (if cache - (n-par-map* %lookup-threads - (cut lookup-narinfo cache <>) - paths) - '()))) - (for-each (lambda (narinfo) - (format #t "~a\n~a\n~a\n" - (narinfo-path narinfo) - (or (and=> (narinfo-deriver narinfo) - (cute string-append - (%store-prefix) "/" - <>)) - "") - (length (narinfo-references narinfo))) - (for-each (cute format #t "~a/~a~%" - (%store-prefix) <>) - (narinfo-references narinfo)) - (format #t "~a\n~a\n" - (or (narinfo-file-size narinfo) 0) - (or (narinfo-size narinfo) 0))) - (filter narinfo? substitutable)) - (newline))) - (wtf - (error "unknown `--query' command" wtf))) - (loop (read-line))))))) - (("--substitute" store-path destination) - ;; Download STORE-PATH and add store it as a Nar in file DESTINATION. - (let* ((cache (delay (open-cache %cache-url))) - (narinfo (lookup-narinfo cache store-path)) - (uri (narinfo-uri narinfo))) - ;; Tell the daemon what the expected hash of the Nar itself is. - (format #t "~a~%" (narinfo-hash narinfo)) + (with-error-handling ; for signature errors + (match args + (("--query") + (let ((cache (delay (open-cache %cache-url)))) + (define (valid? obj) + (and (narinfo? obj) (valid-narinfo? obj))) - (format (current-error-port) "downloading `~a' from `~a'~:[~*~; (~,1f MiB installed)~]...~%" - store-path (uri->string uri) + (let loop ((command (read-line))) + (or (eof-object? command) + (begin + (match (string-tokenize command) + (("have" paths ..1) + ;; Return the subset of PATHS available in CACHE. + (let ((substitutable + (if cache + (n-par-map* %lookup-threads + (cut lookup-narinfo cache <>) + paths) + '()))) + (for-each (lambda (narinfo) + (format #t "~a~%" (narinfo-path narinfo))) + (filter valid? substitutable)) + (newline))) + (("info" paths ..1) + ;; Reply info about PATHS if it's in CACHE. + (let ((substitutable + (if cache + (n-par-map* %lookup-threads + (cut lookup-narinfo cache <>) + paths) + '()))) + (for-each (lambda (narinfo) + (format #t "~a\n~a\n~a\n" + (narinfo-path narinfo) + (or (and=> (narinfo-deriver narinfo) + (cute string-append + (%store-prefix) "/" + <>)) + "") + (length (narinfo-references narinfo))) + (for-each (cute format #t "~a/~a~%" + (%store-prefix) <>) + (narinfo-references narinfo)) + (format #t "~a\n~a\n" + (or (narinfo-file-size narinfo) 0) + (or (narinfo-size narinfo) 0))) + (filter valid? substitutable)) + (newline))) + (wtf + (error "unknown `--query' command" wtf))) + (loop (read-line))))))) + (("--substitute" store-path destination) + ;; Download STORE-PATH and add store it as a Nar in file DESTINATION. + (let* ((cache (delay (open-cache %cache-url))) + (narinfo (lookup-narinfo cache store-path)) + (uri (narinfo-uri narinfo))) + ;; Make sure it is signed and everything. + (assert-valid-narinfo narinfo) - ;; Use the Nar size as an estimate of the installed size. - (narinfo-size narinfo) - (and=> (narinfo-size narinfo) - (cute / <> (expt 2. 20)))) - (let*-values (((raw download-size) - ;; Note that Hydra currently generates Nars on the fly - ;; and doesn't specify a Content-Length, so - ;; DOWNLOAD-SIZE is #f in practice. - (fetch uri #:buffered? #f #:timeout? #f)) - ((progress) - (let* ((comp (narinfo-compression narinfo)) - (dl-size (or download-size - (and (equal? comp "none") - (narinfo-size narinfo)))) - (progress (progress-proc (uri-abbreviation uri) - dl-size - (current-error-port)))) - (progress-report-port progress raw))) - ((input pids) - (decompressed-port (and=> (narinfo-compression narinfo) - string->symbol) - progress))) - ;; Unpack the Nar at INPUT into DESTINATION. - (restore-file input destination) - (every (compose zero? cdr waitpid) pids)))) - (("--version") - (show-version-and-exit "guix substitute-binary")) - (("--help") - (show-help)) - (opts - (leave (_ "~a: unrecognized options~%") opts))))) + ;; Tell the daemon what the expected hash of the Nar itself is. + (format #t "~a~%" (narinfo-hash narinfo)) + + (format (current-error-port) "downloading `~a' from `~a'~:[~*~; (~,1f MiB installed)~]...~%" + store-path (uri->string uri) + + ;; Use the Nar size as an estimate of the installed size. + (narinfo-size narinfo) + (and=> (narinfo-size narinfo) + (cute / <> (expt 2. 20)))) + (let*-values (((raw download-size) + ;; Note that Hydra currently generates Nars on the fly + ;; and doesn't specify a Content-Length, so + ;; DOWNLOAD-SIZE is #f in practice. + (fetch uri #:buffered? #f #:timeout? #f)) + ((progress) + (let* ((comp (narinfo-compression narinfo)) + (dl-size (or download-size + (and (equal? comp "none") + (narinfo-size narinfo)))) + (progress (progress-proc (uri-abbreviation uri) + dl-size + (current-error-port)))) + (progress-report-port progress raw))) + ((input pids) + (decompressed-port (and=> (narinfo-compression narinfo) + string->symbol) + progress))) + ;; Unpack the Nar at INPUT into DESTINATION. + (restore-file input destination) + (every (compose zero? cdr waitpid) pids)))) + (("--version") + (show-version-and-exit "guix substitute-binary")) + (("--help") + (show-help)) + (opts + (leave (_ "~a: unrecognized options~%") opts)))))) ;;; Local Variables: diff --git a/tests/substitute-binary.scm b/tests/substitute-binary.scm index 0903b202f2..eecc34bb71 100644 --- a/tests/substitute-binary.scm +++ b/tests/substitute-binary.scm @@ -24,7 +24,13 @@ #:use-module (guix nar) #:use-module (guix pk-crypto) #:use-module (guix pki) + #:use-module (guix config) + #:use-module ((guix store) #:select (%store-prefix)) + #:use-module ((guix build utils) #:select (delete-file-recursively)) #:use-module (rnrs bytevectors) + #:use-module (rnrs io ports) + #:use-module (web uri) + #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module ((srfi srfi-64) #:hide (test-error))) @@ -36,52 +42,37 @@ ;;; 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 + (test-equal name + 1 (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#) - ) - ) - )")) + (lambda (key value) + value)))) (define %public-key - (find-sexp-token %keypair 'public-key)) + ;; This key is known to be in the ACL by default. + (call-with-input-file (string-append %config-directory "/signing-key.pub") + (compose string->canonical-sexp get-string-all))) (define %private-key - (find-sexp-token %keypair 'private-key)) + (call-with-input-file (string-append %config-directory "/signing-key.sec") + (compose string->canonical-sexp get-string-all))) -(define (signature-body str) +(define* (signature-body str #:key (public-key %public-key)) + "Return the signature of STR 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)) #:key-type 'rsa) %private-key - %public-key))))) + public-key))))) (define %signature-body + ;; Body of the signature of the word "secret". (signature-body "secret")) (define %wrong-public-key @@ -93,9 +84,11 @@ )")) (define %wrong-signature - (let* ((body (string->canonical-sexp - (utf8->string - (base64-decode %signature-body)))) + ;; '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)) @@ -106,14 +99,18 @@ (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))) + (test-begin "substitute-binary") (test-error* "not a number" @@ -127,7 +124,7 @@ (define-syntax-rule (test-error-condition name pred exp) (test-assert name - (guard (condition ((pred condition) (pk 'true condition #t)) + (guard (condition ((pred condition) #t) (else #f)) exp #f))) @@ -135,63 +132,142 @@ ;;; 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" + (assert-valid-signature (string->canonical-sexp "(foo bar baz)") "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)) + (assert-valid-signature (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)) + (assert-valid-signature (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 + (string-append "StorePath: " (%store-prefix) + "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo URL: nar/foo Compression: bzip2 NarHash: sha256:7 NarSize: 42 References: bar baz -Deriver: foo.drv -System: mips64el-linux\n") +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)))) -(test-error-condition "invalid hash" +(define (call-with-narinfo narinfo thunk) + "Call THUNK in a context where $GUIX_BINARY_SUBSTITUTE_URL is populated with +a file for NARINFO." + (let ((narinfo-directory (and=> (string->uri (getenv + "GUIX_BINARY_SUBSTITUTE_URL")) + uri-path)) + (cache-directory (string-append (getenv "XDG_CACHE_HOME") + "/guix/substitute-binary/"))) + (dynamic-wind + (lambda () + (when (file-exists? cache-directory) + (delete-file-recursively cache-directory)) + (call-with-output-file (string-append narinfo-directory + "/nix-cache-info") + (lambda (port) + (format port "StoreDir: ~a\nWantMassQuery: 0\n" + (%store-prefix)))) + (call-with-output-file (string-append narinfo-directory "/" + "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + ".narinfo") + (cut display narinfo <>)) + + (set! (@@ (guix scripts substitute-binary) + %allow-unauthenticated-substitutes?) + #f)) + thunk + (lambda () + (delete-file-recursively cache-directory))))) + +(define-syntax-rule (with-narinfo narinfo body ...) + (call-with-narinfo narinfo (lambda () body ...))) + + +(test-equal "query narinfo with 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)) + (with-narinfo (narinfo %signature) + (string-trim-both + (with-output-to-string + (lambda () + (with-input-from-string (string-append "have " (%store-prefix) + "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") + (lambda () + (guix-substitute-binary "--query")))))))) -(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-equal "query narinfo signed with authorized key" + (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") + + (with-narinfo %signed-narinfo + (string-trim-both + (with-output-to-string + (lambda () + (with-input-from-string (string-append "have " (%store-prefix) + "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") + (lambda () + (guix-substitute-binary "--query")))))))) + +(test-equal "query narinfo signed with unauthorized key" + "" ; not substitutable + + (with-narinfo (narinfo (signature "1" + (signature-body %narinfo + #:public-key %wrong-public-key))) + (string-trim-both + (with-output-to-string + (lambda () + (with-input-from-string (string-append "have " (%store-prefix) + "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") + (lambda () + (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) + (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))) + (guix-substitute-binary "--substitute" + (string-append (%store-prefix) + "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") + "foo"))) (test-end "substitute-binary") (exit (= (test-runner-fail-count (test-runner-current)) 0)) + +;;; Local Variables: +;;; eval: (put 'with-narinfo 'scheme-indent-function 1) +;;; eval: (put 'test-error* 'scheme-indent-function 1) +;;; End: