From fe0cff14f6c5facee4192529f5c7b7a972f185ca Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 12 Apr 2013 17:30:27 +0200
Subject: substitute-binary: Implement `--substitute'.

This allows build outputs to be transparently downloaded from
http://hydra.gnu.org, for example.

* config-daemon.ac: Check for `gzip', `bzip2', and `xz'.
* guix/config.scm.in (%gzip, %bzip2, %xz): New variable.
* guix/scripts/substitute-binary.scm (fetch): Return SIZE as a second value.
  (<narinfo>): Change `url' to `uri'.
  (make-narinfo): Rename to...
  (narinfo-maker): ... this.  Handle relative URLs.
  (fetch-narinfo): Adjust accordingly.
  (filtered-port, decompressed-port): New procedures.
  (guix-substitute-binary): Implement the `--substitute' case.
* tests/store.scm ("substitute query"): Use (%store-prefix) instead
  of (getenv "NIX_STORE_DIR").
  ("substitute"): New test.
---
 tests/store.scm | 55 ++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 54 insertions(+), 1 deletion(-)

(limited to 'tests')

diff --git a/tests/store.scm b/tests/store.scm
index c75b99c6a9..4ee20a9352 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -23,9 +23,11 @@ (define-module (test-store)
   #:use-module (guix base32)
   #:use-module (guix packages)
   #:use-module (guix derivations)
+  #:use-module (guix nar)
   #:use-module (gnu packages)
   #:use-module (gnu packages bootstrap)
   #:use-module (ice-9 match)
+  #:use-module (rnrs io ports)
   #:use-module (web uri)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
@@ -141,7 +143,7 @@ (define (random-text)
     (call-with-output-file (string-append dir "/nix-cache-info")
       (lambda (p)
         (format p "StoreDir: ~a\nWantMassQuery: 0\n"
-                (getenv "NIX_STORE_DIR"))))
+                (%store-prefix))))
     (call-with-output-file (string-append dir "/" (store-path-hash-part o)
                                           ".narinfo")
       (lambda (p)
@@ -167,6 +169,57 @@ (define (random-text)
                  (null? (substitutable-references s))
                  (equal? (substitutable-nar-size s) 1234)))))))
 
+(test-assert "substitute"
+  (let* ((s   (open-connection))
+         (c   (random-text))                      ; contents of the output
+         (d   (build-expression->derivation
+               s "substitute-me" (%current-system)
+               `(call-with-output-file %output
+                  (lambda (p)
+                    (exit 1)                      ; would actually fail
+                    (display ,c p)))
+               '()
+               #:guile-for-build
+               (package-derivation s %bootstrap-guile (%current-system))))
+         (o   (derivation-path->output-path d))
+         (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
+                     (compose uri-path string->uri))))
+    ;; Create fake substituter data, to be read by `substitute-binary'.
+    (call-with-output-file (string-append dir "/nix-cache-info")
+      (lambda (p)
+        (format p "StoreDir: ~a\nWantMassQuery: 0\n"
+                (%store-prefix))))
+    (call-with-output-file (string-append dir "/example.out")
+      (lambda (p)
+        (display c p)))
+    (call-with-output-file (string-append dir "/example.nar")
+      (lambda (p)
+        (write-file (string-append dir "/example.out") p)))
+    (call-with-output-file (string-append dir "/" (store-path-hash-part o)
+                                          ".narinfo")
+      (lambda (p)
+        (format p "StorePath: ~a
+URL: ~a
+Compression: none
+NarSize: 1234
+NarHash: sha256:~a
+References: 
+System: ~a
+Deriver: ~a~%"
+                o                                   ; StorePath
+                "example.nar"                       ; relative URL
+                (call-with-input-file (string-append dir "/example.nar")
+                  (compose bytevector->nix-base32-string sha256
+                           get-bytevector-all))
+                (%current-system)                   ; System
+                (basename d))))                     ; Deriver
+
+    ;; Make sure we use `substitute-binary'.
+    (set-build-options s #:use-substitutes? #t)
+    (and (has-substitutes? s o)
+         (build-derivations s (list d))
+         (equal? c (call-with-input-file o get-string-all)))))
+
 (test-end "store")
 
 
-- 
cgit v1.2.3