M guix/nar.scm => guix/nar.scm +34 -33
@@ 372,40 372,41 @@ while the locks are held."
;; Bail out if SIGNATURE, which must be a string as produced by
;; 'canonical-sexp->string', doesn't match HASH, a bytevector containing
;; the expected hash for FILE.
- (let* ((signature (catch 'gcry-error
- (lambda ()
- (string->canonical-sexp signature))
- (lambda (err . _)
- (raise (condition
- (&message
- (message "signature is not a valid \
+ (let ((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)
- (if (authorized-key? subject)
- (if (equal? (hash-data->bytevector data) hash)
- (unless (valid-signature? signature)
- (raise (condition
- (&message (message "invalid signature"))
- (&nar-signature-error
- (file file) (signature signature) (port port)))))
- (raise (condition (&message (message "invalid hash"))
- (&nar-invalid-hash-error
- (port port) (file file)
- (signature signature)
- (expected (hash-data->bytevector data))
- (actual hash)))))
- (raise (condition (&message (message "unauthorized public key"))
- (&nar-signature-error
- (signature signature) (file file) (port port)))))
- (raise (condition
- (&message (message "corrupt signature data"))
- (&nar-signature-error
- (signature signature) (file file) (port port)))))))
+ (&nar-signature-error
+ (file file)
+ (signature signature) (port port))))))))
+ (signature-case (signature hash (current-acl))
+ (valid-signature #t)
+ (invalid-signature
+ (raise (condition
+ (&message (message "invalid signature"))
+ (&nar-signature-error
+ (file file) (signature signature) (port port)))))
+ (hash-mismatch
+ (raise (condition (&message (message "invalid hash"))
+ (&nar-invalid-hash-error
+ (port port) (file file)
+ (signature signature)
+ (expected (hash-data->bytevector
+ (signature-signed-data signature)))
+ (actual hash)))))
+ (unauthorized-key
+ (raise (condition (&message (message "unauthorized public key"))
+ (&nar-signature-error
+ (signature signature) (file file) (port port)))))
+ (corrupt-signature
+ (raise (condition
+ (&message (message "corrupt signature data"))
+ (&nar-signature-error
+ (signature signature) (file file) (port port))))))))
(let loop ((n (read-long-long port))
(files '()))
M guix/scripts/substitute-binary.scm => guix/scripts/substitute-binary.scm +41 -57
@@ 252,14 252,10 @@ failure."
(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)))))))))))
+ (lambda (err . rest)
+ (leave (_ "signature is not a valid \
+s-expression: ~s~%")
+ signature))))))))
(x
(leave (_ "invalid format of the signature field: ~a~%") x))))
@@ 288,43 284,21 @@ must contain the original contents of a narinfo file."
(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
+(define* (assert-valid-signature narinfo signature hash
#:optional (acl (current-acl)))
- "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)
- (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)
- (unless (valid-signature? signature)
- (raise (condition
- (&message (message "invalid signature"))
- (&nar-signature-error
- (file file) (signature signature) (port port)))))
- (raise (condition (&message (message "invalid hash"))
- (&nar-invalid-hash-error
- (port port) (file file)
- (signature signature)
- (expected (hash-data->bytevector data))
- (actual hash)))))
- (raise (condition (&message (message "unauthorized public key"))
- (&nar-signature-error
- (signature signature) (file file) (port port)))))
- (raise (condition
- (&message (message "corrupt signature data"))
- (&nar-signature-error
- (signature signature) (file file) (port port)))))))
+ "Bail out if SIGNATURE, a canonical sexp representing the signature of
+NARINFO, doesn't match HASH, a bytevector containing the hash of NARINFO."
+ (let ((uri (uri->string (narinfo-uri narinfo))))
+ (signature-case (signature hash acl)
+ (valid-signature #t)
+ (invalid-signature
+ (leave (_ "invalid signature for '~a'~%") uri))
+ (hash-mismatch
+ (leave (_ "hash mismatch for '~a'~%") uri))
+ (unauthorized-key
+ (leave (_ "'~a' is signed with an unauthorized key~%") uri))
+ (corrupt-signature
+ (leave (_ "signature on '~a' is corrupt~%") uri)))))
(define* (read-narinfo port #:optional url)
"Read a narinfo from PORT. If URL is true, it must be a string used to
@@ 343,22 317,29 @@ No authentication and authorization checks are performed here!"
;; Regexp matching a signature line in a narinfo.
(make-regexp "(.+)^[[:blank:]]*Signature:[[:blank:]].+$"))
+(define (narinfo-sha256 narinfo)
+ "Return the sha256 hash of NARINFO as a bytevector, or #f if NARINFO lacks a
+'Signature' field."
+ (let ((contents (narinfo-contents narinfo)))
+ (match (regexp-exec %signature-line-rx contents)
+ (#f #f)
+ ((= (cut match:substring <> 1) above-signature)
+ (sha256 (string->utf8 above-signature))))))
+
(define* (assert-valid-narinfo narinfo
#:optional (acl (current-acl))
#:key (verbose? #t))
"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)
+ (let ((hash (narinfo-sha256 narinfo)))
+ (if (not hash)
(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)))
+ (leave (_ "narinfo for '~a' lacks a signature~%")
+ (uri->string (narinfo-uri narinfo))))
+ (let ((signature (narinfo-signature narinfo)))
(unless %allow-unauthenticated-substitutes?
- (assert-valid-signature signature hash #f acl)
+ (assert-valid-signature narinfo signature hash acl)
(when verbose?
(format (current-error-port)
"found valid signature for '~a', from '~a'~%"
@@ 366,12 347,15 @@ or is signed by an unauthorized key."
(uri->string (narinfo-uri narinfo)))))
narinfo))))
-(define (valid-narinfo? narinfo)
+(define* (valid-narinfo? narinfo #:optional (acl (current-acl)))
"Return #t if NARINFO's signature is not valid."
- (false-if-exception
- (begin
- (assert-valid-narinfo narinfo #:verbose? #f)
- #t)))
+ (or %allow-unauthenticated-substitutes?
+ (let ((hash (narinfo-sha256 narinfo))
+ (signature (narinfo-signature narinfo)))
+ (and hash signature
+ (signature-case (signature hash acl)
+ (valid-signature #t)
+ (else #f))))))
(define (write-narinfo narinfo port)
"Write NARINFO to PORT."
M tests/substitute-binary.scm => tests/substitute-binary.scm +0 -41
@@ 38,13 38,6 @@
#:use-module (srfi srfi-35)
#: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-quit name error-rx exp)
"Emit a test that passes when EXP throws to 'quit' with value 1, and when
it writes to GUIX-WARNING-PORT a messages that matches ERROR-RX."
@@ 117,39 110,6 @@ version identifier.."
(test-assert "valid narinfo-signature->canonical-sexp"
(canonical-sexp? (narinfo-signature->canonical-sexp (signature-field "foo"))))
-(define-syntax-rule (test-error-condition name pred message-rx exp)
- (test-assert name
- (guard (condition ((pred condition)
- (and (string-match message-rx
- (condition-message condition))
- #t))
- (else #f))
- exp
- #f)))
-
-(test-error-condition "corrupt signature data"
- nar-signature-error? "corrupt"
- (assert-valid-signature (string->canonical-sexp "(foo bar baz)") "irrelevant"
- (open-input-string "irrelevant")
- (public-keys->acl (list %public-key))))
-
-(test-error-condition "unauthorized public key"
- 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? "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
@@ 317,6 277,5 @@ 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-quit 'scheme-indent-function 2)
;;; End: