ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 13:58:15 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

substitute-binary: Micro-optimize 'narinfo-sha256'.

Browse source 
* guix/scripts/substitute-binary.scm (narinfo-signature->canonical-sexp):
  Change "~a" to "~s" in error message.
  (%signature-line-rx): Remove.
  (narinfo-sha256): Use 'string-contains' instead of 'regexp-exec', and
  'string-take' instead of 'match:substring'.
This commit is contained in:
Ludovic Courtès 2015-01-09 01:10:31 +01:00
parent fb519bd831
commit 8234fcf21a
1 changed files with 5 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
guix/scripts/substitute-binary.scm
View file

@ -241,7 +241,7 @@ (define (narinfo-signature->canonical-sexp str)
((version _ sig)
(let ((maybe-number (string->number version)))
(cond ((not (number? maybe-number))
(leave (_ "signature version must be a number: ~a~%")
(leave (_ "signature version must be a number: ~s~%")
version))
;; Currently, there are no other versions.
((not (= 1 maybe-number))
@ -313,18 +313,15 @@ (define* (read-narinfo port #:optional url)
"References" "Deriver" "System"
"Signature"))))
(define %signature-line-rx
;; 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)
(match (string-contains contents "Signature:")
(#f #f)
((= (cut match:substring <> 1) above-signature)
(sha256 (string->utf8 above-signature))))))
(index
(let ((above-signature (string-take contents index)))
(sha256 (string->utf8 above-signature)))))))
(define* (assert-valid-narinfo narinfo
#:optional (acl (current-acl))