mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-25 22:08:16 -05:00
substitute: Expose narinfo access.
* guix/scripts/substitute.scm: Export <narinfo> accessors. (narinfo-hash->sha256): New procedure. (cache-narinfo!): Ignore EACCES exceptions.
This commit is contained in:
parent
c6f8e9dd64
commit
ea0c6e0507
1 changed files with 36 additions and 4 deletions
|
@ -53,6 +53,25 @@ (define-module (guix scripts substitute)
|
|||
#:use-module (web response)
|
||||
#:use-module (guix http-client)
|
||||
#:export (narinfo-signature->canonical-sexp
|
||||
|
||||
narinfo?
|
||||
narinfo-path
|
||||
narinfo-uri
|
||||
narinfo-uri-base
|
||||
narinfo-compression
|
||||
narinfo-file-hash
|
||||
narinfo-file-size
|
||||
narinfo-hash
|
||||
narinfo-size
|
||||
narinfo-references
|
||||
narinfo-deriver
|
||||
narinfo-system
|
||||
narinfo-signature
|
||||
|
||||
narinfo-hash->sha256
|
||||
assert-valid-narinfo
|
||||
|
||||
lookup-narinfos
|
||||
read-narinfo
|
||||
write-narinfo
|
||||
guix-substitute))
|
||||
|
@ -231,6 +250,12 @@ (define-record-type <narinfo>
|
|||
;; for more information.
|
||||
(contents narinfo-contents))
|
||||
|
||||
(define (narinfo-hash->sha256 hash)
|
||||
"If the string HASH denotes a sha256 hash, return it as a bytevector.
|
||||
Otherwise return #f."
|
||||
(and (string-prefix? "sha256:" hash)
|
||||
(nix-base32-string->bytevector (string-drop hash 7))))
|
||||
|
||||
(define (narinfo-signature->canonical-sexp str)
|
||||
"Return the value of a narinfo's 'Signature' field as a canonical sexp."
|
||||
(match (string-split str #\;)
|
||||
|
@ -429,10 +454,17 @@ (define (cache-entry cache-uri narinfo)
|
|||
(value ,(and=> narinfo narinfo->string))))
|
||||
|
||||
(let ((file (narinfo-cache-file cache-url path)))
|
||||
(mkdir-p (dirname file))
|
||||
(with-atomic-file-output file
|
||||
(lambda (out)
|
||||
(write (cache-entry cache-url narinfo) out))))
|
||||
(catch 'system-error
|
||||
(lambda ()
|
||||
(mkdir-p (dirname file))
|
||||
(with-atomic-file-output file
|
||||
(lambda (out)
|
||||
(write (cache-entry cache-url narinfo) out))))
|
||||
(lambda args
|
||||
;; We may not have write access to the local cache when called from an
|
||||
;; unprivileged process such as 'guix challenge'.
|
||||
(unless (= EACCES (system-error-errno args))
|
||||
(apply throw args)))))
|
||||
|
||||
narinfo)
|
||||
|
||||
|
|
Loading…
Reference in a new issue