~ruther/guix-local

8146fdb3342361dedcf36d96d7a53a7dc0858e63 — Ludovic Courtès 12 years ago de28fef
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.
1 files changed, 13 insertions(+), 3 deletions(-)

M guix/scripts/substitute-binary.scm
M guix/scripts/substitute-binary.scm => guix/scripts/substitute-binary.scm +13 -3
@@ 343,7 343,9 @@ No authentication and authorization checks are performed here!"
  ;; Regexp matching a signature line in a narinfo.
  (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,
or is signed by an unauthorized key."
  (let* ((contents  (narinfo-contents narinfo))


@@ 356,12 358,20 @@ or is signed by an unauthorized key."
        (let ((hash      (sha256 (string->utf8 (match:substring res 1))))
              (signature (narinfo-signature narinfo)))
          (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))))

(define (valid-narinfo? narinfo)
  "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)
  "Write NARINFO to PORT."