From 94d92c7796a3dd50c27d532315f7d497ac99f08e Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 20 Jul 2015 04:30:16 +0200
Subject: daemon: Add "builtin:download" derivation builder.

This ensures that 1) the derivation doesn't change when Guix changes;
2) the derivation closure doesn't contain Guix and its dependencies; 3)
we don't have to rely on ugly chroot hacks.

Adapted from Nix commit 0a2bee307b20411f5b0dda0c662b1f9bb9e0e131.

* nix/libstore/build.cc (DerivationGoal::runChild): Add special case for
'isBuiltin(drv)'.  Disable chroot when 'isBuiltin(drv)'.
* nix/libstore/builtins.cc, nix/libstore/builtins.hh,
nix/scripts/download.in, guix/scripts/perform-download.scm: New files.
* guix/ui.scm (show-guix-help)[internal?]: Add 'perform-download'.
* nix/local.mk (libstore_a_SOURCES): Add builtins.cc.
(libstore_headers): Add builtins.hh.
(nodist_pkglibexec_SCRIPTS): Add 'scripts/download'.
* config-daemon.ac: Emit 'scripts/download'.
* Makefile.am (MODULES): Add 'guix/scripts/perform-download.scm'.
* tests/derivations.scm ("unknown built-in builder")
("'download' built-in builder")
("'download' built-in builder, invalid hash")
("'download' built-in builder, not found")
("'download' built-in builder, not fixed-output"): New tests.

Co-authored-by: Eelco Dolstra <eelco.dolstra@logicblox.com>
---
 tests/derivations.scm | 70 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 70 insertions(+)

(limited to 'tests/derivations.scm')

diff --git a/tests/derivations.scm b/tests/derivations.scm
index d8553b223e..449fb47832 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -16,6 +16,8 @@
 ;;; You should have received a copy of the GNU General Public License
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
+(unsetenv "http_proxy")
+
 (define-module (test-derivations)
   #:use-module (guix derivations)
   #:use-module (guix grafts)
@@ -24,6 +26,7 @@
   #:use-module (guix hash)
   #:use-module (guix base32)
   #:use-module (guix tests)
+  #:use-module (guix tests http)
   #:use-module ((guix packages) #:select (package-derivation base32))
   #:use-module ((guix build utils) #:select (executable-file?))
   #:use-module ((gnu packages) #:select (search-bootstrap-binary))
@@ -75,6 +78,9 @@
         (lambda (e1 e2)
           (string<? (car e1) (car e2)))))
 
+;; Avoid collisions with other tests.
+(%http-server-port 10500)
+
 
 (test-begin "derivations")
 
@@ -205,6 +211,70 @@
                 (= (stat:ino (lstat file1))
                    (stat:ino (lstat file2))))))))
 
+(test-assert "unknown built-in builder"
+  (let ((drv (derivation %store "ohoh" "builtin:does-not-exist" '())))
+    (guard (c ((nix-protocol-error? c)
+               (string-contains (nix-protocol-error-message c) "failed")))
+      (build-derivations %store (list drv))
+      #f)))
+
+(unless (force %http-server-socket)
+  (test-skip 1))
+(test-assert "'download' built-in builder"
+  (let ((text (random-text)))
+    (with-http-server 200 text
+      (let* ((drv (derivation %store "world"
+                              "builtin:download" '()
+                              #:env-vars `(("url"
+                                            . ,(object->string (%local-url))))
+                              #:hash-algo 'sha256
+                              #:hash (sha256 (string->utf8 text)))))
+        (and (build-derivations %store (list drv))
+             (string=? (call-with-input-file (derivation->output-path drv)
+                         get-string-all)
+                       text))))))
+
+(unless (force %http-server-socket)
+  (test-skip 1))
+(test-assert "'download' built-in builder, invalid hash"
+  (with-http-server 200 "hello, world!"
+    (let* ((drv (derivation %store "world"
+                            "builtin:download" '()
+                            #:env-vars `(("url"
+                                          . ,(object->string (%local-url))))
+                            #:hash-algo 'sha256
+                            #:hash (sha256 (random-bytevector 100))))) ;wrong
+      (guard (c ((nix-protocol-error? c)
+                 (string-contains (nix-protocol-error-message c) "failed")))
+        (build-derivations %store (list drv))
+        #f))))
+
+(unless (force %http-server-socket)
+  (test-skip 1))
+(test-assert "'download' built-in builder, not found"
+  (with-http-server 404 "not found"
+    (let* ((drv (derivation %store "will-never-be-found"
+                            "builtin:download" '()
+                            #:env-vars `(("url"
+                                          . ,(object->string (%local-url))))
+                            #:hash-algo 'sha256
+                            #:hash (sha256 (random-bytevector 100)))))
+      (guard (c ((nix-protocol-error? c)
+                 (string-contains (nix-protocol-error-message (pk c)) "failed")))
+        (build-derivations %store (list drv))
+        #f))))
+
+(test-assert "'download' built-in builder, not fixed-output"
+  (let* ((source (add-text-to-store %store "hello" "hi!"))
+         (url    (string-append "file://" source))
+         (drv    (derivation %store "world"
+                             "builtin:download" '()
+                             #:env-vars `(("url" . ,(object->string url))))))
+    (guard (c ((nix-protocol-error? c)
+               (string-contains (nix-protocol-error-message c) "failed")))
+      (build-derivations %store (list drv))
+      #f)))
+
 (test-equal "derivation-name"
   "foo-0.0"
   (let ((drv (derivation %store "foo-0.0" %bash '())))
-- 
cgit v1.2.3