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>

11 files changed, 343 insertions, 9 deletions

diff --git a/.gitignore b/.gitignore
index 6e892ca687..329d489713 100644
--- a/.gitignore
+++ b/.gitignore
@@ -125,3 +125,4 @@ config.cache
 stamp-h[0-9]
 tmp
 /doc/os-config-lightweight-desktop.texi
+/nix/scripts/download
diff --git a/Makefile.am b/Makefile.am
index 5d3639747f..9d62f48024 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -123,6 +123,7 @@ MODULES =					\
   guix/import/elpa.scm   			\
   guix/scripts.scm				\
   guix/scripts/download.scm			\
+  guix/scripts/perform-download.scm		\
   guix/scripts/build.scm			\
   guix/scripts/archive.scm			\
   guix/scripts/import.scm			\
diff --git a/config-daemon.ac b/config-daemon.ac
index f66f31269d..8a3e6d8b60 100644
--- a/config-daemon.ac
+++ b/config-daemon.ac
@@ -144,6 +144,8 @@ if test "x$guix_build_daemon" = "xyes"; then
 
   AC_CONFIG_FILES([nix/scripts/list-runtime-roots],
     [chmod +x nix/scripts/list-runtime-roots])
+  AC_CONFIG_FILES([nix/scripts/download],
+    [chmod +x nix/scripts/download])
   AC_CONFIG_FILES([nix/scripts/substitute],
     [chmod +x nix/scripts/substitute])
   AC_CONFIG_FILES([nix/scripts/guix-authenticate],
diff --git a/guix/scripts/perform-download.scm b/guix/scripts/perform-download.scm
new file mode 100644
index 0000000000..0d2e7089aa
--- /dev/null
+++ b/guix/scripts/perform-download.scm
@@ -0,0 +1,113 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix scripts perform-download)
+  #:use-module (guix ui)
+  #:use-module (guix derivations)
+  #:use-module ((guix store) #:select (derivation-path?))
+  #:use-module (guix build download)
+  #:use-module (ice-9 match)
+  #:export (guix-perform-download))
+
+;; This program is a helper for the daemon's 'download' built-in builder.
+
+(define-syntax derivation-let
+  (syntax-rules ()
+    ((_ drv ((id name) rest ...) body ...)
+     (let ((id (assoc-ref (derivation-builder-environment-vars drv)
+                          name)))
+       (derivation-let drv (rest ...) body ...)))
+    ((_ drv () body ...)
+     (begin body ...))))
+
+(define %user-module
+  ;; Module in which content-address mirror procedures are evaluated.
+  (let ((module (make-fresh-user-module)))
+    (module-use! module (resolve-interface '(guix base32)))
+    module))
+
+(define (perform-download drv)
+  "Perform the download described by DRV, a fixed-output derivation."
+  (derivation-let drv ((url "url")
+                       (output "out")
+                       (executable "executable")
+                       (mirrors "mirrors")
+                       (content-addressed-mirrors "content-addressed-mirrors"))
+    (unless url
+      (leave (_ "~a: missing URL~%") (derivation-file-name drv)))
+
+    (let* ((url        (call-with-input-string url read))
+           (drv-output (assoc-ref (derivation-outputs drv) "out"))
+           (algo       (derivation-output-hash-algo drv-output))
+           (hash       (derivation-output-hash drv-output)))
+      (unless (and algo hash)
+        (leave (_ "~a is not a fixed-output derivation~%")
+               (derivation-file-name drv)))
+
+      ;; We're invoked by the daemon, which gives us write access to OUTPUT.
+      (when (url-fetch url output
+                       #:mirrors (if mirrors
+                                     (call-with-input-file mirrors read)
+                                     '())
+                       #:content-addressed-mirrors
+                       (if content-addressed-mirrors
+                           (call-with-input-file content-addressed-mirrors
+                             (lambda (port)
+                               (eval (read port) %user-module)))
+                           '())
+                       #:hashes `((,algo . ,hash))
+
+                       ;; Since DRV's output hash is known, X.509 certificate
+                       ;; validation is pointless.
+                       #:verify-certificate? #f)
+        (when (and executable (string=? executable "1"))
+          (chmod output #o755))))))
+
+(define (assert-low-privileges)
+  (when (zero? (getuid))
+    (leave (_ "refusing to run with elevated privileges (UID ~a)~%")
+           (getuid))))
+
+(define (guix-perform-download . args)
+  "Perform the download described by the given fixed-output derivation.
+
+This is an \"out-of-band\" download in that this code is executed directly by
+the daemon and not explicitly described as an input of the derivation.  This
+allows us to sidestep bootstrapping problems, such downloading the source code
+of GnuTLS over HTTPS, before we have built GnuTLS.  See
+<http://bugs.gnu.org/22774>."
+  (with-error-handling
+    (match args
+      (((? derivation-path? drv))
+       ;; This program must be invoked by guix-daemon under an unprivileged
+       ;; UID to prevent things downloading from 'file:///etc/shadow' or
+       ;; arbitrary code execution via the content-addressed mirror
+       ;; procedures.  (That means we exclude users who did not pass
+       ;; '--build-users-group'.)
+       (assert-low-privileges)
+       (perform-download (call-with-input-file drv read-derivation)))
+      (("--version")
+       (show-version-and-exit))
+      (x
+       (leave (_ "fixed-output derivation name expected~%"))))))
+
+;; Local Variables:
+;; eval: (put 'derivation-let 'scheme-indent-function 2)
+;; End:
+
+;; perform-download.scm ends here
diff --git a/guix/ui.scm b/guix/ui.scm
index 9af8648211..b9fbbfd0e3 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -1184,7 +1184,8 @@ optionally contain a version number and an output name, as in these examples:
 
 (define (show-guix-help)
   (define (internal? command)
-    (member command '("substitute" "authenticate" "offload")))
+    (member command '("substitute" "authenticate" "offload"
+                      "perform-download")))
 
   (format #t (_ "Usage: guix COMMAND ARGS...
 Run COMMAND with ARGS.\n"))
diff --git a/nix/libstore/build.cc b/nix/libstore/build.cc
index ae78e65199..889ee3d2bd 100644
--- a/nix/libstore/build.cc
+++ b/nix/libstore/build.cc
@@ -8,6 +8,7 @@
 #include "util.hh"
 #include "archive.hh"
 #include "affinity.hh"
+#include "builtins.hh"
 
 #include <map>
 #include <sstream>
@@ -2047,7 +2048,12 @@ void DerivationGoal::runChild()
         commonChildInit(builderOut);
 
 #if CHROOT_ENABLED
-        if (useChroot) {
+	/* Note: built-in builders are *not* running in a chroot environment
+	   so that we can easily implement them in Guile without having it as
+	   a derivation input (they are running under a separate build user,
+	   though).  */
+
+        if (useChroot && !isBuiltin(drv)) {
             /* Initialise the loopback interface. */
             AutoCloseFD fd(socket(PF_INET, SOCK_DGRAM, IPPROTO_IP));
             if (fd == -1) throw SysError("cannot open IP socket");
@@ -2255,6 +2261,28 @@ void DerivationGoal::runChild()
                 throw SysError("setuid failed");
         }
 
+        restoreSIGPIPE();
+
+        /* Indicate that we managed to set up the build environment. */
+        writeFull(STDERR_FILENO, "\n");
+
+        /* Execute the program.  This should not return. */
+        if (isBuiltin(drv)) {
+            try {
+                logType = ltFlat;
+
+		auto buildDrv = lookupBuiltinBuilder(drv.builder);
+                if (buildDrv != NULL)
+                    buildDrv(drv, drvPath);
+                else
+                    throw Error(format("unsupported builtin function '%1%'") % string(drv.builder, 8));
+                _exit(0);
+            } catch (std::exception & e) {
+                writeFull(STDERR_FILENO, "error: " + string(e.what()) + "\n");
+                _exit(1);
+            }
+        }
+
         /* Fill in the arguments. */
         Strings args;
         string builderBasename = baseNameOf(drv.builder);
@@ -2262,12 +2290,6 @@ void DerivationGoal::runChild()
         foreach (Strings::iterator, i, drv.args)
             args.push_back(rewriteHashes(*i, rewritesToTmp));
 
-        restoreSIGPIPE();
-
-        /* Indicate that we managed to set up the build environment. */
-        writeFull(STDERR_FILENO, "\n");
-
-        /* Execute the program.  This should not return. */
         execve(drv.builder.c_str(), stringsToCharPtrs(args).data(), stringsToCharPtrs(envStrs).data());
 
         throw SysError(format("executing `%1%'") % drv.builder);
diff --git a/nix/libstore/builtins.cc b/nix/libstore/builtins.cc
new file mode 100644
index 0000000000..605e44079a
--- /dev/null
+++ b/nix/libstore/builtins.cc
@@ -0,0 +1,69 @@
+/* GNU Guix --- Functional package management for GNU
+   Copyright (C) 2016 Ludovic Courtès <ludo@gnu.org>
+
+   This file is part of GNU Guix.
+
+   GNU Guix is free software; you can redistribute it and/or modify it
+   under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or (at
+   your option) any later version.
+
+   GNU Guix is distributed in the hope that it will be useful, but
+   WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.  */
+
+#include <builtins.hh>
+#include <util.hh>
+#include <globals.hh>
+
+#include <unistd.h>
+
+namespace nix {
+
+static void builtinDownload(const Derivation &drv,
+			    const std::string &drvPath)
+{
+    /* Invoke 'guix perform-download'.  */
+    Strings args;
+    args.push_back("perform-download");
+    args.push_back(drvPath);
+
+    /* Close all other file descriptors. */
+    closeMostFDs(set<int>());
+
+    const char *const argv[] = { "download", drvPath.c_str(), NULL };
+
+    /* XXX: Hack our way to use the 'download' script from 'LIBEXECDIR/guix'
+       or just 'LIBEXECDIR', depending on whether we're running uninstalled or
+       not.  */
+    const string subdir = getenv("GUIX_UNINSTALLED") != NULL
+	? "" : "/guix";
+
+    const string program = settings.nixLibexecDir + subdir + "/download";
+    execv(program.c_str(), (char *const *) argv);
+
+    throw SysError(format("failed to run download program '%1%'") % program);
+}
+
+static const std::map<std::string, derivationBuilder> builtins =
+{
+    { "download", builtinDownload }
+};
+
+derivationBuilder lookupBuiltinBuilder(const std::string & name)
+{
+    if (name.substr(0, 8) == "builtin:")
+    {
+	auto realName = name.substr(8);
+	auto builder = builtins.find(realName);
+	return builder == builtins.end() ? NULL : builder->second;
+    }
+    else
+	return NULL;
+}
+
+}
diff --git a/nix/libstore/builtins.hh b/nix/libstore/builtins.hh
new file mode 100644
index 0000000000..0c6db651ab
--- /dev/null
+++ b/nix/libstore/builtins.hh
@@ -0,0 +1,41 @@
+/* GNU Guix --- Functional package management for GNU
+   Copyright (C) 2016 Ludovic Courtès <ludo@gnu.org>
+
+   This file is part of GNU Guix.
+
+   GNU Guix is free software; you can redistribute it and/or modify it
+   under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 3 of the License, or (at
+   your option) any later version.
+
+   GNU Guix is distributed in the hope that it will be useful, but
+   WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.  */
+
+/* Interface to built-in derivation builders.  */
+
+#pragma once
+
+#include <derivations.hh>
+#include <map>
+#include <string>
+
+namespace nix {
+
+    inline bool isBuiltin(const Derivation & drv)
+    {
+	return string(drv.builder, 0, 8) == "builtin:";
+    }
+
+    /* Build DRV, which lives at DRVPATH.  */
+    typedef void (*derivationBuilder) (const Derivation &drv,
+				       const std::string &drvPath);
+
+    /* Return the built-in builder called BUILDER, or NULL if none was
+       found.  */
+    derivationBuilder lookupBuiltinBuilder(const std::string &builder);
+}
diff --git a/nix/local.mk b/nix/local.mk
index c666edd033..86ef769549 100644
--- a/nix/local.mk
+++ b/nix/local.mk
@@ -87,6 +87,7 @@ libstore_a_SOURCES =				\
   %D%/libstore/build.cc				\
   %D%/libstore/pathlocks.cc			\
   %D%/libstore/derivations.cc			\
+  %D%/libstore/builtins.cc			\
   %D%/libstore/sqlite.cc
 
 libstore_headers =				\
@@ -98,6 +99,7 @@ libstore_headers =				\
   %D%/libstore/misc.hh				\
   %D%/libstore/local-store.hh			\
   %D%/libstore/sqlite.hh			\
+  %D%/libstore/builtins.hh			\
   %D%/libstore/store-api.hh
 
 libstore_a_CPPFLAGS =				\
@@ -166,7 +168,8 @@ noinst_HEADERS =						\
 
 nodist_pkglibexec_SCRIPTS =			\
   %D%/scripts/list-runtime-roots		\
-  %D%/scripts/substitute
+  %D%/scripts/substitute			\
+  %D%/scripts/download
 
 if BUILD_DAEMON_OFFLOAD
 
diff --git a/nix/scripts/download.in b/nix/scripts/download.in
new file mode 100644
index 0000000000..4d7088a993
--- /dev/null
+++ b/nix/scripts/download.in
@@ -0,0 +1,11 @@
+#!@SHELL@
+# A shorthand for "guix perform-download", for use by the daemon.
+
+if test "x$GUIX_UNINSTALLED" = "x"
+then
+    prefix="@prefix@"
+    exec_prefix="@exec_prefix@"
+    exec "@bindir@/guix" perform-download "$@"
+else
+    exec guix perform-download "$@"
+fi
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 '())))