@@ 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 <https://lists.gnu.org/archive/html/guix-devel/2014-03/msg00097.html>).
;;; 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))
-
- (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)))))
+ (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)))
+
+ (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)
+
+ ;; 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:
@@ 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))
-
-(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))))
+ ""
+
+ (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 "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: