substitute-binary: Notify of valid signatures.

* guix/scripts/substitute-binary.scm (assert-valid-narinfo): Add
  #:verbose? parameter; when true, write "found valid signature".
  (valid-narinfo?): Pass #:verbose? #f.
This commit is contained in:
Ludovic Courtès 2014-03-31 21:58:21 +02:00
parent de28fefd77
commit 8146fdb334

View file

@ -343,7 +343,9 @@ (define %signature-line-rx
;; 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* (assert-valid-narinfo narinfo #:optional (acl (current-acl))) (define* (assert-valid-narinfo narinfo
#:optional (acl (current-acl))
#: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* ((contents (narinfo-contents narinfo))
@ -356,12 +358,20 @@ (define* (assert-valid-narinfo narinfo #:optional (acl (current-acl)))
(let ((hash (sha256 (string->utf8 (match:substring res 1)))) (let ((hash (sha256 (string->utf8 (match:substring res 1))))
(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 signature hash #f acl)
(when verbose?
(format (current-error-port)
"found valid signature for '~a', from '~a'~%"
(narinfo-path narinfo)
(uri->string (narinfo-uri narinfo)))))
narinfo)))) narinfo))))
(define (valid-narinfo? narinfo) (define (valid-narinfo? narinfo)
"Return #t if NARINFO's signature is not valid." "Return #t if NARINFO's signature is not valid."
(false-if-exception (begin (assert-valid-narinfo narinfo) #t))) (false-if-exception
(begin
(assert-valid-narinfo narinfo #:verbose? #f)
#t)))
(define (write-narinfo narinfo port) (define (write-narinfo narinfo port)
"Write NARINFO to PORT." "Write NARINFO to PORT."