From ea0c6e0507a6997f12a4f29d0445b51cf53bd81e Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 19 Oct 2015 23:12:34 +0200
Subject: substitute: Expose narinfo access.

* guix/scripts/substitute.scm: Export <narinfo> accessors.
  (narinfo-hash->sha256): New procedure.
  (cache-narinfo!): Ignore EACCES exceptions.
---
 guix/scripts/substitute.scm | 40 ++++++++++++++++++++++++++++++++++++----
 1 file changed, 36 insertions(+), 4 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index ec8e6244af..8967fa062e 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -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)
 
-- 
cgit v1.2.3