nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Use 'signature-case' in (guix nar) and 'substitute-binary'. 

* guix/nar.scm (restore-file-set)[assert-valid-signature]: Rewrite in
  terms of 'signature-case'.
* guix/scripts/substitute-binary.scm (narinfo-signature->canonical-sexp):
  Call 'leave' instead of 'raise' when SIGNATURE is invalid.
  (&nar-signature-error, &nar-invalid-hash-error): Remove.
  (assert-valid-signature): Add 'narinfo' parameter; remove 'port'.
  Rewrite in terms of 'signature-case' and 'leave'.  Mention NARINFO's
  URI in error messages.  Adjust caller.
  (narinfo-sha256): New procedure.
  (assert-valid-narinfo): Use it.
  (valid-narinfo?): Rewrite using 'narinfo-sha256' and
  'signature-case'.
* tests/substitute-binary.scm (assert-valid-signature,
  test-error-condition): Remove.
  ("corrupt signature data", "unauthorized public key", "invalid
  signature"): Remove.
This commit is contained in:
Ludovic Courtès 2014-03-31 23:47:02 +02:00
parent 81deef270d
commit e4687a5e68
3 changed files with 75 additions and 131 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
guix/nar.scm
View File

@ -372,40 +372,41 @@ while the locks are held."
;; Bail out if SIGNATURE, which must be a string as produced by ;; Bail out if SIGNATURE, which must be a string as produced by
;; 'canonical-sexp->string', doesn't match HASH, a bytevector containing ;; 'canonical-sexp->string', doesn't match HASH, a bytevector containing
;; the expected hash for FILE. ;; the expected hash for FILE.
(let* ((signature (catch 'gcry-error (let ((signature (catch 'gcry-error
(lambda () (lambda ()
(string->canonical-sexp signature)) (string->canonical-sexp signature))
(lambda (err . _) (lambda (err . _)
(raise (condition (raise (condition
(&message (&message
(message "signature is not a valid \ (message "signature is not a valid \
s-expression")) s-expression"))
(&nar-signature-error (&nar-signature-error
(file file) (file file)
(signature signature) (port port))))))) (signature signature) (port port))))))))
(subject (signature-subject signature)) (signature-case (signature hash (current-acl))
(data (signature-signed-data signature))) (valid-signature #t)
(if (and data subject) (invalid-signature
(if (authorized-key? subject) (raise (condition
(if (equal? (hash-data->bytevector data) hash) (&message (message "invalid signature"))
(unless (valid-signature? signature) (&nar-signature-error
(raise (condition (file file) (signature signature) (port port)))))
(&message (message "invalid signature")) (hash-mismatch
(&nar-signature-error (raise (condition (&message (message "invalid hash"))
(file file) (signature signature) (port port))))) (&nar-invalid-hash-error
(raise (condition (&message (message "invalid hash")) (port port) (file file)
(&nar-invalid-hash-error (signature signature)
(port port) (file file) (expected (hash-data->bytevector
(signature signature) (signature-signed-data signature)))
(expected (hash-data->bytevector data)) (actual hash)))))
(actual hash))))) (unauthorized-key
(raise (condition (&message (message "unauthorized public key")) (raise (condition (&message (message "unauthorized public key"))
(&nar-signature-error (&nar-signature-error
(signature signature) (file file) (port port))))) (signature signature) (file file) (port port)))))
(raise (condition (corrupt-signature
(&message (message "corrupt signature data")) (raise (condition
(&nar-signature-error (&message (message "corrupt signature data"))
(signature signature) (file file) (port port))))))) (&nar-signature-error
(signature signature) (file file) (port port))))))))
(let loop ((n (read-long-long port)) (let loop ((n (read-long-long port))
(files '())) (files '()))

98
guix/scripts/substitute-binary.scm
View File

@ -252,14 +252,10 @@ failure."
(catch 'gcry-error (catch 'gcry-error
(lambda () (lambda ()
(string->canonical-sexp signature)) (string->canonical-sexp signature))
(lambda (err . _) (lambda (err . rest)
(raise (condition (leave (_ "signature is not a valid \
(&message s-expression: ~s~%")
(message "signature is not a valid \ signature))))))))
s-expression"))
(&nar-signature-error
(file #f)
(signature signature) (port #f)))))))))))
(x (x
(leave (_ "invalid format of the signature field: ~a~%") 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)) (and=> signature narinfo-signature->canonical-sexp))
str))) str)))
(define &nar-signature-error (@@ (guix nar) &nar-signature-error)) (define* (assert-valid-signature narinfo signature hash
(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))) #:optional (acl (current-acl)))
"Bail out if SIGNATURE, a canonical sexp, doesn't match HASH, a bytevector "Bail out if SIGNATURE, a canonical sexp representing the signature of
containing the expected hash for FILE." NARINFO, doesn't match HASH, a bytevector containing the hash of NARINFO."
(let* (;; XXX: This is just to keep the errors happy; get a sensible (let ((uri (uri->string (narinfo-uri narinfo))))
;; file name. (signature-case (signature hash acl)
(file #f) (valid-signature #t)
(subject (signature-subject signature)) (invalid-signature
(data (signature-signed-data signature))) (leave (_ "invalid signature for '~a'~%") uri))
(if (and data subject) (hash-mismatch
(if (authorized-key? subject acl) (leave (_ "hash mismatch for '~a'~%") uri))
(if (equal? (hash-data->bytevector data) hash) (unauthorized-key
(unless (valid-signature? signature) (leave (_ "'~a' is signed with an unauthorized key~%") uri))
(raise (condition (corrupt-signature
(&message (message "invalid signature")) (leave (_ "signature on '~a' is corrupt~%") uri)))))
(&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)))))))
(define* (read-narinfo port #:optional url) (define* (read-narinfo port #:optional url)
"Read a narinfo from PORT. If URL is true, it must be a string used to "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. ;; Regexp matching a signature line in a narinfo.
(make-regexp "(.+)^[[:blank:]]*Signature:[[:blank:]].+$")) (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 (define* (assert-valid-narinfo narinfo
#:optional (acl (current-acl)) #:optional (acl (current-acl))
#:key (verbose? #t)) #:key (verbose? #t))
"Raise an exception if NARINFO lacks a signature, has an invalid signature, "Raise an exception if NARINFO lacks a signature, has an invalid signature,
or is signed by an unauthorized key." or is signed by an unauthorized key."
(let* ((contents (narinfo-contents narinfo)) (let ((hash (narinfo-sha256 narinfo)))
(res (regexp-exec %signature-line-rx contents))) (if (not hash)
(if (not res)
(if %allow-unauthenticated-substitutes? (if %allow-unauthenticated-substitutes?
narinfo narinfo
(leave (_ "narinfo lacks a signature: ~s~%") (leave (_ "narinfo for '~a' lacks a signature~%")
contents)) (uri->string (narinfo-uri narinfo))))
(let ((hash (sha256 (string->utf8 (match:substring res 1)))) (let ((signature (narinfo-signature narinfo)))
(signature (narinfo-signature narinfo)))
(unless %allow-unauthenticated-substitutes? (unless %allow-unauthenticated-substitutes?
(assert-valid-signature signature hash #f acl) (assert-valid-signature narinfo signature hash acl)
(when verbose? (when verbose?
(format (current-error-port) (format (current-error-port)
"found valid signature for '~a', from '~a'~%" "found valid signature for '~a', from '~a'~%"
@ -366,12 +347,15 @@ or is signed by an unauthorized key."
(uri->string (narinfo-uri narinfo))))) (uri->string (narinfo-uri narinfo)))))
narinfo)))) narinfo))))
(define (valid-narinfo? narinfo) (define* (valid-narinfo? narinfo #:optional (acl (current-acl)))
"Return #t if NARINFO's signature is not valid." "Return #t if NARINFO's signature is not valid."
(false-if-exception (or %allow-unauthenticated-substitutes?
(begin (let ((hash (narinfo-sha256 narinfo))
(assert-valid-narinfo narinfo #:verbose? #f) (signature (narinfo-signature narinfo)))
#t))) (and hash signature
(signature-case (signature hash acl)
(valid-signature #t)
(else #f))))))
(define (write-narinfo narinfo port) (define (write-narinfo narinfo port)
"Write NARINFO to PORT." "Write NARINFO to PORT."

41
tests/substitute-binary.scm
View File

@ -38,13 +38,6 @@
#:use-module (srfi srfi-35) #:use-module (srfi srfi-35)
#:use-module ((srfi srfi-64) #:hide (test-error))) #: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) (define-syntax-rule (test-quit name error-rx exp)
"Emit a test that passes when EXP throws to 'quit' with value 1, and when "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." 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" (test-assert "valid narinfo-signature->canonical-sexp"
(canonical-sexp? (narinfo-signature->canonical-sexp (signature-field "foo")))) (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 (define %narinfo
@ -317,6 +277,5 @@ a file for NARINFO."
;;; Local Variables: ;;; Local Variables:
;;; eval: (put 'with-narinfo 'scheme-indent-function 1) ;;; 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) ;;; eval: (put 'test-quit 'scheme-indent-function 2)
;;; End: ;;; End: