From 49e6291a7a257f89f01644423f1b685778b8862a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 23 Jan 2014 23:48:34 +0100 Subject: Add 'guix offload' as a daemon build hook. * nix/nix-daemon/guix-daemon.cc (GUIX_OPT_NO_BUILD_HOOK): New macro. (options): Add '--no-build-hook'. (parse_opt): Handle it. (main)[HAVE_DAEMON_OFFLOAD_HOOK]: Set 'useBuildHook' by default. Set $NIX_BUILD_HOOK to our offload hook unless otherwise specified. [!HAVE_DAEMON_OFFLOAD_HOOK]: Clear 'useBuildHook'. * pre-inst-env.in: Set and export NIX_BUILD_HOOK. * nix/scripts/offload.in, guix/scripts/offload.scm: New files. * guix/ui.scm (show-guix-help)[internal?]: Add "offload". * config-daemon.ac: Call 'GUIX_CHECK_UNBUFFERED_CBIP'. Instantiate 'nix/scripts/offload'. Set 'BUILD_DAEMON_OFFLOAD' conditional, and optionally define 'HAVE_DEAMON_OFFLOAD_HOOK' cpp macro. * daemon.am (nodist_pkglibexec_SCRIPTS)[BUILD_DAEMON_OFFLOAD]: Add it. * Makefile.am (MODULES)[BUILD_DAEMON_OFFLOAD]: Add 'guix/scripts/offload.scm'. (EXTRA_DIST)[!BUILD_DAEMON_OFFLOAD]: Likewise. * m4/guix.m4 (GUIX_CHECK_UNBUFFERED_CBIP): New macro. * doc/guix.texi (Setting Up the Daemon): Move most of the body to... (Build Environment Setup): ... this. New subsection. (Daemon Offload Setup): New subsection. --- .gitignore | 1 + Makefile.am | 17 +- config-daemon.ac | 16 ++ daemon.am | 8 + doc/guix.texi | 122 +++++++++++++- guix/scripts/offload.scm | 380 ++++++++++++++++++++++++++++++++++++++++++ guix/ui.scm | 2 +- m4/guix.m4 | 19 ++- nix/nix-daemon/guix-daemon.cc | 23 ++- nix/scripts/offload.in | 11 ++ pre-inst-env.in | 5 +- 11 files changed, 589 insertions(+), 15 deletions(-) create mode 100644 guix/scripts/offload.scm create mode 100644 nix/scripts/offload.in diff --git a/.gitignore b/.gitignore index 09a593e9fa..10b18daa5e 100644 --- a/.gitignore +++ b/.gitignore @@ -85,3 +85,4 @@ GRTAGS GTAGS /nix-setuid-helper /nix/scripts/guix-authenticate +/nix/scripts/offload diff --git a/Makefile.am b/Makefile.am index 6d6aba059b..16b28eb181 100644 --- a/Makefile.am +++ b/Makefile.am @@ -1,5 +1,5 @@ # GNU Guix --- Functional package management for GNU -# Copyright © 2012, 2013 Ludovic Courtès +# Copyright © 2012, 2013, 2014 Ludovic Courtès # Copyright © 2013 Andreas Enge # # This file is part of GNU Guix. @@ -80,6 +80,13 @@ MODULES = \ guix.scm \ $(GNU_SYSTEM_MODULES) +if BUILD_DAEMON_OFFLOAD + +MODULES += \ + guix/scripts/offload.scm + +endif BUILD_DAEMON_OFFLOAD + # Because of the autoload hack in (guix build download), we must build it # first to avoid errors on systems where (gnutls) is unavailable. guix/scripts/download.go: guix/build/download.go @@ -185,6 +192,14 @@ EXTRA_DIST = \ release.nix \ $(TESTS) +if !BUILD_DAEMON_OFFLOAD + +EXTRA_DIST += \ + guix/scripts/offload.scm + +endif !BUILD_DAEMON_OFFLOAD + + CLEANFILES = \ $(GOBJECTS) \ $(SCM_TESTS:tests/%.scm=%.log) diff --git a/config-daemon.ac b/config-daemon.ac index 0717141198..1169bb6ef4 100644 --- a/config-daemon.ac +++ b/config-daemon.ac @@ -95,6 +95,17 @@ if test "x$guix_build_daemon" = "xyes"; then dnl Check for (for immutable file support). AC_CHECK_HEADERS([linux/fs.h]) + dnl Check whether the 'offload' build hook can be built (uses + dnl 'restore-file-set', which requires unbuffered custom binary input + dnl ports from Guile >= 2.0.10.) + GUIX_CHECK_UNBUFFERED_CBIP + guix_build_daemon_offload="$ac_cv_guix_cbips_support_setvbuf" + + if test "x$guix_build_daemon_offload" = "xyes"; then + AC_DEFINE([HAVE_DAEMON_OFFLOAD_HOOK], [1], + [Define if the daemon's 'offload' build hook is being built.]) + fi + dnl Temporary directory used to store the daemon's data. AC_MSG_CHECKING([for unit test root]) GUIX_TEST_ROOT="`pwd`/test-tmp" @@ -107,6 +118,11 @@ if test "x$guix_build_daemon" = "xyes"; then [chmod +x nix/scripts/substitute-binary]) AC_CONFIG_FILES([nix/scripts/guix-authenticate], [chmod +x nix/scripts/guix-authenticate]) + AC_CONFIG_FILES([nix/scripts/offload], + [chmod +x nix/scripts/offload]) fi AM_CONDITIONAL([BUILD_DAEMON], [test "x$guix_build_daemon" = "xyes"]) +AM_CONDITIONAL([BUILD_DAEMON_OFFLOAD], \ + [test "x$guix_build_daemon" = "xyes" \ + && test "x$guix_build_daemon_offload" = "xyes"]) diff --git a/daemon.am b/daemon.am index f4700f0b07..1059e444ab 100644 --- a/daemon.am +++ b/daemon.am @@ -172,6 +172,14 @@ nodist_pkglibexec_SCRIPTS = \ nix/scripts/list-runtime-roots \ nix/scripts/substitute-binary +if BUILD_DAEMON_OFFLOAD + +nodist_pkglibexec_SCRIPTS += \ + nix/scripts/offload + +endif BUILD_DAEMON_OFFLOAD + + # XXX: It'd be better to hide it in $(pkglibexecdir). nodist_libexec_SCRIPTS = \ nix/scripts/guix-authenticate diff --git a/doc/guix.texi b/doc/guix.texi index a637614fbb..48e4631836 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -175,13 +175,24 @@ your goal is to share the store with Nix. @cindex daemon Operations such as building a package or running the garbage collector -are all performed by a specialized process, the @dfn{Guix daemon}, on +are all performed by a specialized process, the @dfn{build daemon}, on behalf of clients. Only the daemon may access the store and its associated database. Thus, any operation that manipulates the store goes through the daemon. For instance, command-line tools such as @command{guix package} and @command{guix build} communicate with the daemon (@i{via} remote procedure calls) to instruct it what to do. +The following sections explain how to prepare the build daemon's +environment. + +@menu +* Build Environment Setup:: Preparing the isolated build environment. +* Daemon Offload Setup:: Offloading builds to remote machines. +@end menu + +@node Build Environment Setup +@subsection Build Environment Setup + In a standard multi-user setup, Guix and its daemon---the @command{guix-daemon} program---are installed by the system administrator; @file{/nix/store} is owned by @code{root} and @@ -256,14 +267,6 @@ user @file{nobody}; a writable @file{/tmp} directory. @end itemize -Finally, you may want to generate a key pair to allow the daemon to -export signed archives of files from the store (@pxref{Invoking guix -archive}): - -@example -# guix archive --generate-key -@end example - If you are installing Guix as an unprivileged user, it is still possible to run @command{guix-daemon}. However, build processes will not be isolated from one another, and not from the rest of the system. @@ -271,6 +274,107 @@ Thus, build processes may interfere with each other, and may access programs, libraries, and other files available on the system---making it much harder to view them as @emph{pure} functions. + +@node Daemon Offload Setup +@subsection Using the Offload Facility + +@cindex offloading +The build daemon can @dfn{offload} derivation builds to other machines +running Guix, using the @code{offload} @dfn{build hook}. When that +feature is enabled, a list of user-specified build machines is read from +@file{/etc/guix/machines.scm}; anytime a build is requested, for +instance via @code{guix build}, the daemon attempts to offload it to one +of the machines that satisfies the derivation's constraints, in +particular its system type---e.g., @file{x86_64-linux}. Missing +prerequisites for the build are copied over SSH to the target machine, +which then proceeds with the build; upon success the output(s) of the +build are copied back to the initial machine. + +The @file{/etc/guix/machines.scm} is---not surprisingly!---a Scheme file +whose return value must be a list of @code{build-machine} objects. In +practice, it typically looks like this: + +@example +(list (build-machine + (name "eightysix.example.org") + (system "x86_64-linux") + (user "bob") + (speed 2.)) ; incredibly fast! + + (build-machine + (name "meeps.example.org") + (system "mips64el-linux") + (user "alice") + (private-key + (string-append (getenv "HOME") + "/.ssh/id-rsa-for-guix")))) +@end example + +@noindent +In the example above we specify a list of two build machines, one for +the @code{x86_64} architecture and one for the @code{mips64el} +architecture. The compulsory fields for a @code{build-machine} +declaration are: + +@table @code + +@item name +The remote machine's host name. + +@item system +The remote machine's system type. + +@item user +The user account to use when connecting to the remote machine over SSH. +Note that the SSH key pair must @emph{not} be passphrase-protected, to +allow non-interactive logins. + +@end table + +@noindent +A number of optional fields may be optionally specified: + +@table @code + +@item private-key +The SSH private key file to use when connecting to the machine. + +@item parallel-builds +The number of builds that may run in parallel on the machine (1 by +default.) + +@item speed +A ``relative speed factor''. The offload scheduler will tend to prefer +machines with a higher speed factor. + +@item features +A list of strings denoting specific features supported by the machine. +An example is @code{"kvm"} for machines that have the KVM Linux modules +and corresponding hardware support. Derivations can request features by +name, and they will be scheduled on matching build machines. + +@end table + +The @code{guix} command must be in the search path on the build +machines, since offloading works by invoking the @code{guix archive} and +@code{guix build} commands. + +There's one last thing to do once @file{machines.scm} is in place. As +explained above, when offloading, files are transferred back and forth +between the machine stores. For this to work, you need to generate a +key pair to allow the daemon to export signed archives of files from the +store (@pxref{Invoking guix archive}): + +@example +# guix archive --generate-key +@end example + +@noindent +Thus, when receiving files, a machine's build daemon can make sure they +are genuine, have not been tampered with, and that they are signed by an +authorized key. + + @node Invoking guix-daemon @section Invoking @command{guix-daemon} diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm new file mode 100644 index 0000000000..d919ede3c7 --- /dev/null +++ b/guix/scripts/offload.scm @@ -0,0 +1,380 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 Ludovic Courtès +;;; +;;; 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 . + +(define-module (guix scripts offload) + #:use-module (guix config) + #:use-module (guix records) + #:use-module (guix store) + #:use-module (guix derivations) + #:use-module (guix nar) + #:use-module (guix utils) + #:use-module ((guix build utils) #:select (which)) + #:use-module (guix ui) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) + #:use-module (ice-9 popen) + #:use-module (ice-9 rdelim) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) + #:use-module (ice-9 format) + #:use-module (rnrs io ports) + #:export (build-machine + build-requirements + guix-offload)) + +;;; Commentary: +;;; +;;; Attempt to offload builds to the machines listed in +;;; /etc/guix/machines.scm, transferring missing dependencies over SSH, and +;;; retrieving the build output(s) over SSH upon success. +;;; +;;; This command should not be used directly; instead, it is called on-demand +;;; by the daemon, unless it was started with '--no-build-hook' or a client +;;; inhibited build hooks. +;;; +;;; Code: + + +(define-record-type* + build-machine make-build-machine + build-machine? + (name build-machine-name) ; string + (system build-machine-system) ; string + (user build-machine-user) ; string + (private-key build-machine-private-key ; file name + (default (user-lsh-private-key))) + (parallel-builds build-machine-parallel-builds ; number + (default 1)) + (speed build-machine-speed ; inexact real + (default 1.0)) + (features build-machine-features ; list of strings + (default '()))) + +(define-record-type* + build-requirements make-build-requirements + build-requirements? + (system build-requirements-system) ; string + (features build-requirements-features ; list of strings + (default '()))) + +(define %machine-file + ;; File that lists machines available as build slaves. + (string-append %config-directory "/machines.scm")) + +(define %lsh-command + "lsh") + +(define %lshg-command + ;; FIXME: 'lshg' fails to pass large amounts of data, see + ;; . + "lsh") + +(define (user-lsh-private-key) + "Return the user's default lsh private key, or #f if it could not be +determined." + (and=> (getenv "HOME") + (cut string-append <> "/.lsh/identity"))) + +(define %user-module + ;; Module in which the machine description file is loaded. + (let ((module (make-fresh-user-module))) + (module-use! module (resolve-interface '(guix scripts offload))) + module)) + +(define* (build-machines #:optional (file %machine-file)) + "Read the list of build machines from FILE and return it." + (catch #t + (lambda () + ;; Avoid ABI incompatibility with the record. + (set! %fresh-auto-compile #t) + + (save-module-excursion + (lambda () + (set-current-module %user-module) + (primitive-load %machine-file)))) + (lambda args + (match args + (('system-error . _) + (let ((err (system-error-errno args))) + ;; Silently ignore missing file since this is a common case. + (if (= ENOENT err) + '() + (leave (_ "failed to open machine file '~a': ~a~%") + %machine-file (strerror err))))) + (_ + (leave (_ "failed to load machine file '~a': ~s~%") + %machine-file args)))))) + +(define (open-ssh-gateway machine) + "Initiate an SSH connection gateway to MACHINE, and return the PID of the +running lsh gateway upon success, or #f on failure." + (catch 'system-error + (lambda () + (let* ((port (open-pipe* OPEN_READ %lsh-command + "-l" (build-machine-user machine) + "-i" (build-machine-private-key machine) + ;; XXX: With lsh 2.1, passing '--write-pid' + ;; last causes the PID not to be printed. + "--write-pid" "--gateway" "--background" "-z" + (build-machine-name machine))) + (line (read-line port)) + (status (close-pipe port))) + (if (zero? status) + (let ((pid (string->number line))) + (if (integer? pid) + pid + (begin + (warning (_ "'~a' did not write its PID on stdout: ~s~%") + %lsh-command line) + #f))) + (begin + (warning (_ "failed to initiate SSH connection to '~a':\ + '~a' exited with ~a~%") + (build-machine-name machine) + %lsh-command + (status:exit-val status)) + #f)))) + (lambda args + (leave (_ "failed to execute '~a': ~a~%") + %lsh-command (strerror (system-error-errno args)))))) + +(define (remote-pipe machine mode command) + "Run COMMAND on MACHINE, assuming an lsh gateway has been set up." + (catch 'system-error + (lambda () + (apply open-pipe* mode %lshg-command + "-l" (build-machine-user machine) "-z" + (build-machine-name machine) + command)) + (lambda args + (warning (_ "failed to execute '~a': ~a~%") + %lshg-command (strerror (system-error-errno args))) + #f))) + +(define* (offload drv machine + #:key print-build-trace? (max-silent-time 3600) + (build-timeout 7200)) + "Perform DRV on MACHINE, assuming DRV and its prerequisites are available +there. Return a read pipe from where to read the build log." + (format (current-error-port) "offloading '~a' to '~a'...~%" + (derivation-file-name drv) (build-machine-name machine)) + (format (current-error-port) "@ build-remote ~a ~a~%" + (derivation-file-name drv) (build-machine-name machine)) + + ;; FIXME: Protect DRV from garbage collection on MACHINE. + (let ((pipe (remote-pipe machine OPEN_READ + `("guix" "build" + ;; FIXME: more options + ,(format #f "--max-silent-time=~a" + max-silent-time) + ,(derivation-file-name drv))))) + pipe)) + +(define (send-files files machine) + "Send the subset of FILES that's missing to MACHINE's store. Return #t on +success, #f otherwise." + (define (missing-files files) + ;; Return the subset of FILES not already on MACHINE. + (let* ((files (format #f "~{~a~%~}" files)) + (missing (filtered-port + (list (which %lshg-command) + "-l" (build-machine-user machine) + "-i" (build-machine-private-key machine) + (build-machine-name machine) + "guix" "archive" "--missing") + (open-input-string files)))) + (string-tokenize (get-string-all missing)))) + + (with-store store + (guard (c ((nix-protocol-error? c) + (warning (_ "failed to export files for '~a': ~s~%") + (build-machine-name machine) + c) + (false-if-exception (close-pipe pipe)) + #f)) + + ;; Compute the subset of FILES missing on MACHINE, and send them in + ;; topologically sorted order so that they can actually be imported. + (let ((files (missing-files (topologically-sorted store files))) + (pipe (remote-pipe machine OPEN_WRITE + '("guix" "archive" "--import")))) + (format #t (_ "sending ~a store files to '~a'...~%") + (length files) (build-machine-name machine)) + (catch 'system-error + (lambda () + (export-paths store files pipe)) + (lambda args + (warning (_ "failed while exporting files to '~a': ~a~%") + (build-machine-name machine) + (strerror (system-error-errno args))))) + (zero? (close-pipe pipe)))))) + +(define (retrieve-files files machine) + "Retrieve FILES from MACHINE's store, and import them." + (define host + (build-machine-name machine)) + + (let ((pipe (remote-pipe machine OPEN_READ + `("guix" "archive" "--export" ,@files)))) + (and pipe + (with-store store + (guard (c ((nix-protocol-error? c) + (warning (_ "failed to import files from '~a': ~s~%") + host c) + #f)) + (format (current-error-port) "retrieving ~a files from '~a'...~%" + (length files) host) + + ;; We cannot use the 'import-paths' RPC here because we already + ;; hold the locks for FILES. + (restore-file-set pipe + #:log-port (current-error-port) + #:lock? #f) + + (zero? (close-pipe pipe))))))) + +(define (machine-matches? machine requirements) + "Return #t if MACHINE matches REQUIREMENTS." + (and (string=? (build-requirements-system requirements) + (build-machine-system machine)) + (lset<= string=? + (build-requirements-features requirements) + (build-machine-features machine)))) + +(define (machine-faster? m1 m2) + "Return #t if M1 is faster than M2." + (> (build-machine-speed m1) (build-machine-speed m2))) + +(define (choose-build-machine requirements machines) + "Return the best machine among MACHINES fulfilling REQUIREMENTS, or #f." + ;; FIXME: Take machine load into account, and/or shuffle MACHINES. + (let ((machines (sort (filter (cut machine-matches? <> requirements) + machines) + machine-faster?))) + (match machines + ((head . _) + head) + (_ #f)))) + +(define* (process-request wants-local? system drv features + #:key + print-build-trace? (max-silent-time 3600) + (build-timeout 7200)) + "Process a request to build DRV." + (let* ((local? (and wants-local? (string=? system (%current-system)))) + (reqs (build-requirements + (system system) + (features features))) + (machine (choose-build-machine reqs (build-machines)))) + (if machine + (match (open-ssh-gateway machine) + ((? integer? pid) + (display "# accept\n") + (let ((inputs (string-tokenize (read-line))) + (outputs (string-tokenize (read-line)))) + (when (send-files (cons (derivation-file-name drv) inputs) + machine) + (let ((log (offload drv machine + #:print-build-trace? print-build-trace? + #:max-silent-time max-silent-time + #:build-timeout build-timeout))) + (let loop ((line (read-line log))) + (if (eof-object? line) + (close-pipe log) + (begin + (display line) (newline) + (loop (read-line log)))))) + (retrieve-files outputs machine))) + (format (current-error-port) "done with offloaded '~a'~%" + (derivation-file-name drv)) + (kill pid SIGTERM)) + (#f + (display "# decline\n"))) + (display "# decline\n")))) + +(define-syntax-rule (with-nar-error-handling body ...) + "Execute BODY with any &nar-error suitably reported to the user." + (guard (c ((nar-error? c) + (let ((file (nar-error-file c))) + (if (condition-has-type? c &message) + (leave (_ "while importing file '~a': ~a~%") + file (gettext (condition-message c))) + (leave (_ "failed to import file '~a'~%") + file))))) + body ...)) + + +;;; +;;; Entry point. +;;; + +(define (guix-offload . args) + (define request-line-rx + ;; The request format. See 'tryBuildHook' method in build.cc. + (make-regexp "([01]) ([a-z0-9_-]+) (/[[:graph:]]+.drv) ([[:graph:]]*)")) + + (define not-coma + (char-set-complement (char-set #\,))) + + ;; Make sure $HOME really corresponds to the current user. This is + ;; necessary since lsh uses that to determine the location of the yarrow + ;; seed file, and fails if it's owned by someone else. + (and=> (passwd:dir (getpw (getuid))) + (cut setenv "HOME" <>)) + + (match args + ((system max-silent-time print-build-trace? build-timeout) + (let ((max-silent-time (string->number max-silent-time)) + (build-timeout (string->number build-timeout)) + (print-build-trace? (string=? print-build-trace? "1"))) + (parameterize ((%current-system system)) + (let loop ((line (read-line))) + (unless (eof-object? line) + (cond ((regexp-exec request-line-rx line) + => + (lambda (match) + (with-nar-error-handling + (process-request (equal? (match:substring match 1) "1") + (match:substring match 2) ; system + (call-with-input-file + (match:substring match 3) + read-derivation) + (string-tokenize + (match:substring match 4) not-coma) + #:print-build-trace? print-build-trace? + #:max-silent-time max-silent-time + #:build-timeout build-timeout)))) + (else + (leave (_ "invalid request line: ~s~%") line))) + (loop (read-line))))))) + (("--version") + (show-version-and-exit "guix offload")) + (("--help") + (format #t (_ "Usage: guix offload SYSTEM PRINT-BUILD-TRACE +Process build offload requests written on the standard input, possibly +offloading builds to the machines listed in '~a'.~%") + %machine-file) + (display (_ " +This tool is meant to be used internally by 'guix-daemon'.\n")) + (show-bug-report-information)) + (x + (leave (_ "invalid arguments: ~{~s ~}~%") x)))) + +;;; offload.scm ends here diff --git a/guix/ui.scm b/guix/ui.scm index bb811c557d..d6058f806b 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -559,7 +559,7 @@ reporting." (define (show-guix-help) (define (internal? command) - (member command '("substitute-binary" "authenticate"))) + (member command '("substitute-binary" "authenticate" "offload"))) (format #t (_ "Usage: guix COMMAND ARGS... Run COMMAND with ARGS.\n")) diff --git a/m4/guix.m4 b/m4/guix.m4 index a98378db79..19e041a72c 100644 --- a/m4/guix.m4 +++ b/m4/guix.m4 @@ -1,5 +1,5 @@ dnl GNU Guix --- Functional package management for GNU -dnl Copyright © 2012, 2013 Ludovic Courtès +dnl Copyright © 2012, 2013, 2014 Ludovic Courtès dnl dnl This file is part of GNU Guix. dnl @@ -134,3 +134,20 @@ AC_DEFUN([GUIX_CHECK_SRFI_37], [ ac_cv_guix_srfi_37_broken=yes fi]) ]) + +dnl GUIX_CHECK_UNBUFFERED_CBIP +dnl +dnl Check whether 'setbvuf' works on custom binary input ports (CBIPs), as is +dnl the case starting with Guile 2.0.10. +AC_DEFUN([GUIX_CHECK_UNBUFFERED_CBIP], [ + AC_CACHE_CHECK([whether Guile's custom binary input ports support 'setvbuf'], + [ac_cv_guix_cbips_support_setvbuf], + [if "$GUILE" -c "(use-modules (rnrs io ports)) \ + (let ((p (make-custom-binary-input-port \"cbip\" pk #f #f #f))) \ + (setvbuf p _IONBF))" >&5 2>&1 + then + ac_cv_guix_cbips_support_setvbuf=yes + else + ac_cv_guix_cbips_support_setvbuf=no + fi]) +]) diff --git a/nix/nix-daemon/guix-daemon.cc b/nix/nix-daemon/guix-daemon.cc index cf87e39354..d35b1cd076 100644 --- a/nix/nix-daemon/guix-daemon.cc +++ b/nix/nix-daemon/guix-daemon.cc @@ -1,5 +1,5 @@ /* GNU Guix --- Functional package management for GNU - Copyright (C) 2012, 2013 Ludovic Courtès + Copyright (C) 2012, 2013, 2014 Ludovic Courtès This file is part of GNU Guix. @@ -67,6 +67,7 @@ builds derivations on behalf of its clients."; #define GUIX_OPT_CHROOT_DIR 10 #define GUIX_OPT_LISTEN 11 #define GUIX_OPT_NO_SUBSTITUTES 12 +#define GUIX_OPT_NO_BUILD_HOOK 13 static const struct argp_option options[] = { @@ -94,6 +95,8 @@ static const struct argp_option options[] = "Perform builds as a user of GROUP" }, { "no-substitutes", GUIX_OPT_NO_SUBSTITUTES, 0, 0, "Do not use substitutes" }, + { "no-build-hook", GUIX_OPT_NO_BUILD_HOOK, 0, 0, + "Do not use the 'build hook'" }, { "cache-failures", GUIX_OPT_CACHE_FAILURES, 0, 0, "Cache build failures" }, { "lose-logs", GUIX_OPT_LOSE_LOGS, 0, 0, @@ -159,6 +162,9 @@ parse_opt (int key, char *arg, struct argp_state *state) case GUIX_OPT_NO_SUBSTITUTES: settings.useSubstitutes = false; break; + case GUIX_OPT_NO_BUILD_HOOK: + settings.useBuildHook = false; + break; case GUIX_OPT_DEBUG: verbosity = lvlDebug; break; @@ -226,6 +232,21 @@ main (int argc, char *argv[]) settings.substituters.clear (); settings.useSubstitutes = true; +#ifdef HAVE_DAEMON_OFFLOAD_HOOK + /* Use our build hook for distributed builds by default. */ + settings.useBuildHook = true; + if (getenv ("NIX_BUILD_HOOK") == NULL) + { + std::string build_hook; + + build_hook = settings.nixLibexecDir + "/guix/offload"; + setenv ("NIX_BUILD_HOOK", build_hook.c_str (), 1); + } +#else + /* We are not installing any build hook, so disable it. */ + settings.useBuildHook = false; +#endif + argp_parse (&argp, argc, argv, 0, 0, 0); if (settings.useSubstitutes) diff --git a/nix/scripts/offload.in b/nix/scripts/offload.in new file mode 100644 index 0000000000..50faed31c0 --- /dev/null +++ b/nix/scripts/offload.in @@ -0,0 +1,11 @@ +#!@SHELL@ +# A shorthand for "guix offload", for use by the daemon. + +if test "x$GUIX_UNINSTALLED" = "x" +then + prefix="@prefix@" + exec_prefix="@exec_prefix@" + exec "@bindir@/guix" offload "$@" +else + exec guix offload "$@" +fi diff --git a/pre-inst-env.in b/pre-inst-env.in index 3f1fa59bb8..e90e1b0ac4 100644 --- a/pre-inst-env.in +++ b/pre-inst-env.in @@ -1,7 +1,7 @@ #!/bin/sh # GNU Guix --- Functional package management for GNU -# Copyright © 2012, 2013 Ludovic Courtès +# Copyright © 2012, 2013, 2014 Ludovic Courtès # # This file is part of GNU Guix. # @@ -44,7 +44,8 @@ export PATH NIX_ROOT_FINDER="$abs_top_builddir/nix/scripts/list-runtime-roots" NIX_SUBSTITUTERS="$abs_top_builddir/nix/scripts/substitute-binary" NIX_SETUID_HELPER="$abs_top_builddir/nix-setuid-helper" -export NIX_ROOT_FINDER NIX_SETUID_HELPER NIX_SUBSTITUTERS +NIX_BUILD_HOOK="$abs_top_builddir/nix/scripts/offload" +export NIX_ROOT_FINDER NIX_SETUID_HELPER NIX_SUBSTITUTERS NIX_BUILD_HOOK # The 'guix-register' program. GUIX_REGISTER="$abs_top_builddir/guix-register" -- cgit v1.2.3