summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-01-23 23:48:34 +0100
committerLudovic Courtès <ludo@gnu.org>2014-01-24 00:01:50 +0100
commit49e6291a7a257f89f01644423f1b685778b8862a (patch)
treed461cae8cfc21fc9fa421c3fb62d372bf44c2ca7
parent50add47748eb40371d8b88208a13e7230d15c220 (diff)
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.
-rw-r--r--.gitignore1
-rw-r--r--Makefile.am17
-rw-r--r--config-daemon.ac16
-rw-r--r--daemon.am8
-rw-r--r--doc/guix.texi122
-rw-r--r--guix/scripts/offload.scm380
-rw-r--r--guix/ui.scm2
-rw-r--r--m4/guix.m419
-rw-r--r--nix/nix-daemon/guix-daemon.cc23
-rw-r--r--nix/scripts/offload.in11
-rw-r--r--pre-inst-env.in5
11 files changed, 589 insertions, 15 deletions
diff --git a/.gitignore b/.gitignore
index 09a593e9fa0..10b18daa5ef 100644
--- a/.gitignore
+++ b/.gitignore
@@ -85,3 +85,4 @@ GRTAGS
85GTAGS 85GTAGS
86/nix-setuid-helper 86/nix-setuid-helper
87/nix/scripts/guix-authenticate 87/nix/scripts/guix-authenticate
88/nix/scripts/offload
diff --git a/Makefile.am b/Makefile.am
index 6d6aba059bc..16b28eb1810 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -1,5 +1,5 @@
1# GNU Guix --- Functional package management for GNU 1# GNU Guix --- Functional package management for GNU
2# Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> 2# Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
3# Copyright © 2013 Andreas Enge <andreas@enge.fr> 3# Copyright © 2013 Andreas Enge <andreas@enge.fr>
4# 4#
5# This file is part of GNU Guix. 5# This file is part of GNU Guix.
@@ -80,6 +80,13 @@ MODULES = \
80 guix.scm \ 80 guix.scm \
81 $(GNU_SYSTEM_MODULES) 81 $(GNU_SYSTEM_MODULES)
82 82
83if BUILD_DAEMON_OFFLOAD
84
85MODULES += \
86 guix/scripts/offload.scm
87
88endif BUILD_DAEMON_OFFLOAD
89
83# Because of the autoload hack in (guix build download), we must build it 90# Because of the autoload hack in (guix build download), we must build it
84# first to avoid errors on systems where (gnutls) is unavailable. 91# first to avoid errors on systems where (gnutls) is unavailable.
85guix/scripts/download.go: guix/build/download.go 92guix/scripts/download.go: guix/build/download.go
@@ -185,6 +192,14 @@ EXTRA_DIST = \
185 release.nix \ 192 release.nix \
186 $(TESTS) 193 $(TESTS)
187 194
195if !BUILD_DAEMON_OFFLOAD
196
197EXTRA_DIST += \
198 guix/scripts/offload.scm
199
200endif !BUILD_DAEMON_OFFLOAD
201
202
188CLEANFILES = \ 203CLEANFILES = \
189 $(GOBJECTS) \ 204 $(GOBJECTS) \
190 $(SCM_TESTS:tests/%.scm=%.log) 205 $(SCM_TESTS:tests/%.scm=%.log)
diff --git a/config-daemon.ac b/config-daemon.ac
index 0717141198e..1169bb6ef41 100644
--- a/config-daemon.ac
+++ b/config-daemon.ac
@@ -95,6 +95,17 @@ if test "x$guix_build_daemon" = "xyes"; then
95 dnl Check for <linux/fs.h> (for immutable file support). 95 dnl Check for <linux/fs.h> (for immutable file support).
96 AC_CHECK_HEADERS([linux/fs.h]) 96 AC_CHECK_HEADERS([linux/fs.h])
97 97
98 dnl Check whether the 'offload' build hook can be built (uses
99 dnl 'restore-file-set', which requires unbuffered custom binary input
100 dnl ports from Guile >= 2.0.10.)
101 GUIX_CHECK_UNBUFFERED_CBIP
102 guix_build_daemon_offload="$ac_cv_guix_cbips_support_setvbuf"
103
104 if test "x$guix_build_daemon_offload" = "xyes"; then
105 AC_DEFINE([HAVE_DAEMON_OFFLOAD_HOOK], [1],
106 [Define if the daemon's 'offload' build hook is being built.])
107 fi
108
98 dnl Temporary directory used to store the daemon's data. 109 dnl Temporary directory used to store the daemon's data.
99 AC_MSG_CHECKING([for unit test root]) 110 AC_MSG_CHECKING([for unit test root])
100 GUIX_TEST_ROOT="`pwd`/test-tmp" 111 GUIX_TEST_ROOT="`pwd`/test-tmp"
@@ -107,6 +118,11 @@ if test "x$guix_build_daemon" = "xyes"; then
107 [chmod +x nix/scripts/substitute-binary]) 118 [chmod +x nix/scripts/substitute-binary])
108 AC_CONFIG_FILES([nix/scripts/guix-authenticate], 119 AC_CONFIG_FILES([nix/scripts/guix-authenticate],
109 [chmod +x nix/scripts/guix-authenticate]) 120 [chmod +x nix/scripts/guix-authenticate])
121 AC_CONFIG_FILES([nix/scripts/offload],
122 [chmod +x nix/scripts/offload])
110fi 123fi
111 124
112AM_CONDITIONAL([BUILD_DAEMON], [test "x$guix_build_daemon" = "xyes"]) 125AM_CONDITIONAL([BUILD_DAEMON], [test "x$guix_build_daemon" = "xyes"])
126AM_CONDITIONAL([BUILD_DAEMON_OFFLOAD], \
127 [test "x$guix_build_daemon" = "xyes" \
128 && test "x$guix_build_daemon_offload" = "xyes"])
diff --git a/daemon.am b/daemon.am
index f4700f0b071..1059e444abd 100644
--- a/daemon.am
+++ b/daemon.am
@@ -172,6 +172,14 @@ nodist_pkglibexec_SCRIPTS = \
172 nix/scripts/list-runtime-roots \ 172 nix/scripts/list-runtime-roots \
173 nix/scripts/substitute-binary 173 nix/scripts/substitute-binary
174 174
175if BUILD_DAEMON_OFFLOAD
176
177nodist_pkglibexec_SCRIPTS += \
178 nix/scripts/offload
179
180endif BUILD_DAEMON_OFFLOAD
181
182
175# XXX: It'd be better to hide it in $(pkglibexecdir). 183# XXX: It'd be better to hide it in $(pkglibexecdir).
176nodist_libexec_SCRIPTS = \ 184nodist_libexec_SCRIPTS = \
177 nix/scripts/guix-authenticate 185 nix/scripts/guix-authenticate
diff --git a/doc/guix.texi b/doc/guix.texi
index a637614fbb2..48e46318364 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -175,13 +175,24 @@ your goal is to share the store with Nix.
175 175
176@cindex daemon 176@cindex daemon
177Operations such as building a package or running the garbage collector 177Operations such as building a package or running the garbage collector
178are all performed by a specialized process, the @dfn{Guix daemon}, on 178are all performed by a specialized process, the @dfn{build daemon}, on
179behalf of clients. Only the daemon may access the store and its 179behalf of clients. Only the daemon may access the store and its
180associated database. Thus, any operation that manipulates the store 180associated database. Thus, any operation that manipulates the store
181goes through the daemon. For instance, command-line tools such as 181goes through the daemon. For instance, command-line tools such as
182@command{guix package} and @command{guix build} communicate with the 182@command{guix package} and @command{guix build} communicate with the
183daemon (@i{via} remote procedure calls) to instruct it what to do. 183daemon (@i{via} remote procedure calls) to instruct it what to do.
184 184
185The following sections explain how to prepare the build daemon's
186environment.
187
188@menu
189* Build Environment Setup:: Preparing the isolated build environment.
190* Daemon Offload Setup:: Offloading builds to remote machines.
191@end menu
192
193@node Build Environment Setup
194@subsection Build Environment Setup
195
185In a standard multi-user setup, Guix and its daemon---the 196In a standard multi-user setup, Guix and its daemon---the
186@command{guix-daemon} program---are installed by the system 197@command{guix-daemon} program---are installed by the system
187administrator; @file{/nix/store} is owned by @code{root} and 198administrator; @file{/nix/store} is owned by @code{root} and
@@ -256,14 +267,6 @@ user @file{nobody};
256a writable @file{/tmp} directory. 267a writable @file{/tmp} directory.
257@end itemize 268@end itemize
258 269
259Finally, you may want to generate a key pair to allow the daemon to
260export signed archives of files from the store (@pxref{Invoking guix
261archive}):
262
263@example
264# guix archive --generate-key
265@end example
266
267If you are installing Guix as an unprivileged user, it is still 270If you are installing Guix as an unprivileged user, it is still
268possible to run @command{guix-daemon}. However, build processes will 271possible to run @command{guix-daemon}. However, build processes will
269not be isolated from one another, and not from the rest of the system. 272not 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
271programs, libraries, and other files available on the system---making it 274programs, libraries, and other files available on the system---making it
272much harder to view them as @emph{pure} functions. 275much harder to view them as @emph{pure} functions.
273 276
277
278@node Daemon Offload Setup
279@subsection Using the Offload Facility
280
281@cindex offloading
282The build daemon can @dfn{offload} derivation builds to other machines
283running Guix, using the @code{offload} @dfn{build hook}. When that
284feature is enabled, a list of user-specified build machines is read from
285@file{/etc/guix/machines.scm}; anytime a build is requested, for
286instance via @code{guix build}, the daemon attempts to offload it to one
287of the machines that satisfies the derivation's constraints, in
288particular its system type---e.g., @file{x86_64-linux}. Missing
289prerequisites for the build are copied over SSH to the target machine,
290which then proceeds with the build; upon success the output(s) of the
291build are copied back to the initial machine.
292
293The @file{/etc/guix/machines.scm} is---not surprisingly!---a Scheme file
294whose return value must be a list of @code{build-machine} objects. In
295practice, it typically looks like this:
296
297@example
298(list (build-machine
299 (name "eightysix.example.org")
300 (system "x86_64-linux")
301 (user "bob")
302 (speed 2.)) ; incredibly fast!
303
304 (build-machine
305 (name "meeps.example.org")
306 (system "mips64el-linux")
307 (user "alice")
308 (private-key
309 (string-append (getenv "HOME")
310 "/.ssh/id-rsa-for-guix"))))
311@end example
312
313@noindent
314In the example above we specify a list of two build machines, one for
315the @code{x86_64} architecture and one for the @code{mips64el}
316architecture. The compulsory fields for a @code{build-machine}
317declaration are:
318
319@table @code
320
321@item name
322The remote machine's host name.
323
324@item system
325The remote machine's system type.
326
327@item user
328The user account to use when connecting to the remote machine over SSH.
329Note that the SSH key pair must @emph{not} be passphrase-protected, to
330allow non-interactive logins.
331
332@end table
333
334@noindent
335A number of optional fields may be optionally specified:
336
337@table @code
338
339@item private-key
340The SSH private key file to use when connecting to the machine.
341
342@item parallel-builds
343The number of builds that may run in parallel on the machine (1 by
344default.)
345
346@item speed
347A ``relative speed factor''. The offload scheduler will tend to prefer
348machines with a higher speed factor.
349
350@item features
351A list of strings denoting specific features supported by the machine.
352An example is @code{"kvm"} for machines that have the KVM Linux modules
353and corresponding hardware support. Derivations can request features by
354name, and they will be scheduled on matching build machines.
355
356@end table
357
358The @code{guix} command must be in the search path on the build
359machines, since offloading works by invoking the @code{guix archive} and
360@code{guix build} commands.
361
362There's one last thing to do once @file{machines.scm} is in place. As
363explained above, when offloading, files are transferred back and forth
364between the machine stores. For this to work, you need to generate a
365key pair to allow the daemon to export signed archives of files from the
366store (@pxref{Invoking guix archive}):
367
368@example
369# guix archive --generate-key
370@end example
371
372@noindent
373Thus, when receiving files, a machine's build daemon can make sure they
374are genuine, have not been tampered with, and that they are signed by an
375authorized key.
376
377
274@node Invoking guix-daemon 378@node Invoking guix-daemon
275@section Invoking @command{guix-daemon} 379@section Invoking @command{guix-daemon}
276 380
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
new file mode 100644
index 00000000000..d919ede3c78
--- /dev/null
+++ b/guix/scripts/offload.scm
@@ -0,0 +1,380 @@
1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
3;;;
4;;; This file is part of GNU Guix.
5;;;
6;;; GNU Guix is free software; you can redistribute it and/or modify it
7;;; under the terms of the GNU General Public License as published by
8;;; the Free Software Foundation; either version 3 of the License, or (at
9;;; your option) any later version.
10;;;
11;;; GNU Guix is distributed in the hope that it will be useful, but
12;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
18
19(define-module (guix scripts offload)
20 #:use-module (guix config)
21 #:use-module (guix records)
22 #:use-module (guix store)
23 #:use-module (guix derivations)
24 #:use-module (guix nar)
25 #:use-module (guix utils)
26 #:use-module ((guix build utils) #:select (which))
27 #:use-module (guix ui)
28 #:use-module (srfi srfi-1)
29 #:use-module (srfi srfi-26)
30 #:use-module (srfi srfi-34)
31 #:use-module (srfi srfi-35)
32 #:use-module (ice-9 popen)
33 #:use-module (ice-9 rdelim)
34 #:use-module (ice-9 match)
35 #:use-module (ice-9 regex)
36 #:use-module (ice-9 format)
37 #:use-module (rnrs io ports)
38 #:export (build-machine
39 build-requirements
40 guix-offload))
41
42;;; Commentary:
43;;;
44;;; Attempt to offload builds to the machines listed in
45;;; /etc/guix/machines.scm, transferring missing dependencies over SSH, and
46;;; retrieving the build output(s) over SSH upon success.
47;;;
48;;; This command should not be used directly; instead, it is called on-demand
49;;; by the daemon, unless it was started with '--no-build-hook' or a client
50;;; inhibited build hooks.
51;;;
52;;; Code:
53
54
55(define-record-type* <build-machine>
56 build-machine make-build-machine
57 build-machine?
58 (name build-machine-name) ; string
59 (system build-machine-system) ; string
60 (user build-machine-user) ; string
61 (private-key build-machine-private-key ; file name
62 (default (user-lsh-private-key)))
63 (parallel-builds build-machine-parallel-builds ; number
64 (default 1))
65 (speed build-machine-speed ; inexact real
66 (default 1.0))
67 (features build-machine-features ; list of strings
68 (default '())))
69
70(define-record-type* <build-requirements>
71 build-requirements make-build-requirements
72 build-requirements?
73 (system build-requirements-system) ; string
74 (features build-requirements-features ; list of strings
75 (default '())))
76
77(define %machine-file
78 ;; File that lists machines available as build slaves.
79 (string-append %config-directory "/machines.scm"))
80
81(define %lsh-command
82 "lsh")
83
84(define %lshg-command
85 ;; FIXME: 'lshg' fails to pass large amounts of data, see
86 ;; <http://lists.lysator.liu.se/pipermail/lsh-bugs/2014q1/000639.html>.
87 "lsh")
88
89(define (user-lsh-private-key)
90 "Return the user's default lsh private key, or #f if it could not be
91determined."
92 (and=> (getenv "HOME")
93 (cut string-append <> "/.lsh/identity")))
94
95(define %user-module
96 ;; Module in which the machine description file is loaded.
97 (let ((module (make-fresh-user-module)))
98 (module-use! module (resolve-interface '(guix scripts offload)))
99 module))
100
101(define* (build-machines #:optional (file %machine-file))
102 "Read the list of build machines from FILE and return it."
103 (catch #t
104 (lambda ()
105 ;; Avoid ABI incompatibility with the <build-machine> record.
106 (set! %fresh-auto-compile #t)
107
108 (save-module-excursion
109 (lambda ()
110 (set-current-module %user-module)
111 (primitive-load %machine-file))))
112 (lambda args
113 (match args
114 (('system-error . _)
115 (let ((err (system-error-errno args)))
116 ;; Silently ignore missing file since this is a common case.
117 (if (= ENOENT err)
118 '()
119 (leave (_ "failed to open machine file '~a': ~a~%")
120 %machine-file (strerror err)))))
121 (_
122 (leave (_ "failed to load machine file '~a': ~s~%")
123 %machine-file args))))))
124
125(define (open-ssh-gateway machine)
126 "Initiate an SSH connection gateway to MACHINE, and return the PID of the
127running lsh gateway upon success, or #f on failure."
128 (catch 'system-error
129 (lambda ()
130 (let* ((port (open-pipe* OPEN_READ %lsh-command
131 "-l" (build-machine-user machine)
132 "-i" (build-machine-private-key machine)
133 ;; XXX: With lsh 2.1, passing '--write-pid'
134 ;; last causes the PID not to be printed.
135 "--write-pid" "--gateway" "--background" "-z"
136 (build-machine-name machine)))
137 (line (read-line port))
138 (status (close-pipe port)))
139 (if (zero? status)
140 (let ((pid (string->number line)))
141 (if (integer? pid)
142 pid
143 (begin
144 (warning (_ "'~a' did not write its PID on stdout: ~s~%")
145 %lsh-command line)
146 #f)))
147 (begin
148 (warning (_ "failed to initiate SSH connection to '~a':\
149 '~a' exited with ~a~%")
150 (build-machine-name machine)
151 %lsh-command
152 (status:exit-val status))
153 #f))))
154 (lambda args
155 (leave (_ "failed to execute '~a': ~a~%")
156 %lsh-command (strerror (system-error-errno args))))))
157
158(define (remote-pipe machine mode command)
159 "Run COMMAND on MACHINE, assuming an lsh gateway has been set up."
160 (catch 'system-error
161 (lambda ()
162 (apply open-pipe* mode %lshg-command
163 "-l" (build-machine-user machine) "-z"
164 (build-machine-name machine)
165 command))
166 (lambda args
167 (warning (_ "failed to execute '~a': ~a~%")
168 %lshg-command (strerror (system-error-errno args)))
169 #f)))
170
171(define* (offload drv machine
172 #:key print-build-trace? (max-silent-time 3600)
173 (build-timeout 7200))
174 "Perform DRV on MACHINE, assuming DRV and its prerequisites are available
175there. Return a read pipe from where to read the build log."
176 (format (current-error-port) "offloading '~a' to '~a'...~%"
177 (derivation-file-name drv) (build-machine-name machine))
178 (format (current-error-port) "@ build-remote ~a ~a~%"
179 (derivation-file-name drv) (build-machine-name machine))
180
181 ;; FIXME: Protect DRV from garbage collection on MACHINE.
182 (let ((pipe (remote-pipe machine OPEN_READ
183 `("guix" "build"
184 ;; FIXME: more options
185 ,(format #f "--max-silent-time=~a"
186 max-silent-time)
187 ,(derivation-file-name drv)))))
188 pipe))
189
190(define (send-files files machine)
191 "Send the subset of FILES that's missing to MACHINE's store. Return #t on
192success, #f otherwise."
193 (define (missing-files files)
194 ;; Return the subset of FILES not already on MACHINE.
195 (let* ((files (format #f "~{~a~%~}" files))
196 (missing (filtered-port
197 (list (which %lshg-command)
198 "-l" (build-machine-user machine)
199 "-i" (build-machine-private-key machine)
200 (build-machine-name machine)
201 "guix" "archive" "--missing")
202 (open-input-string files))))
203 (string-tokenize (get-string-all missing))))
204
205 (with-store store
206 (guard (c ((nix-protocol-error? c)
207 (warning (_ "failed to export files for '~a': ~s~%")
208 (build-machine-name machine)
209 c)
210 (false-if-exception (close-pipe pipe))
211 #f))
212
213 ;; Compute the subset of FILES missing on MACHINE, and send them in
214 ;; topologically sorted order so that they can actually be imported.
215 (let ((files (missing-files (topologically-sorted store files)))
216 (pipe (remote-pipe machine OPEN_WRITE
217 '("guix" "archive" "--import"))))
218 (format #t (_ "sending ~a store files to '~a'...~%")
219 (length files) (build-machine-name machine))
220 (catch 'system-error
221 (lambda ()
222 (export-paths store files pipe))
223 (lambda args
224 (warning (_ "failed while exporting files to '~a': ~a~%")
225 (build-machine-name machine)
226 (strerror (system-error-errno args)))))
227 (zero? (close-pipe pipe))))))
228
229(define (retrieve-files files machine)
230 "Retrieve FILES from MACHINE's store, and import them."
231 (define host
232 (build-machine-name machine))
233
234 (let ((pipe (remote-pipe machine OPEN_READ
235 `("guix" "archive" "--export" ,@files))))
236 (and pipe
237 (with-store store
238 (guard (c ((nix-protocol-error? c)
239 (warning (_ "failed to import files from '~a': ~s~%")
240 host c)
241 #f))
242 (format (current-error-port) "retrieving ~a files from '~a'...~%"
243 (length files) host)
244
245 ;; We cannot use the 'import-paths' RPC here because we already
246 ;; hold the locks for FILES.
247 (restore-file-set pipe
248 #:log-port (current-error-port)
249 #:lock? #f)
250
251 (zero? (close-pipe pipe)))))))
252
253(define (machine-matches? machine requirements)
254 "Return #t if MACHINE matches REQUIREMENTS."
255 (and (string=? (build-requirements-system requirements)
256 (build-machine-system machine))
257 (lset<= string=?
258 (build-requirements-features requirements)
259 (build-machine-features machine))))
260
261(define (machine-faster? m1 m2)
262 "Return #t if M1 is faster than M2."
263 (> (build-machine-speed m1) (build-machine-speed m2)))
264
265(define (choose-build-machine requirements machines)
266 "Return the best machine among MACHINES fulfilling REQUIREMENTS, or #f."
267 ;; FIXME: Take machine load into account, and/or shuffle MACHINES.
268 (let ((machines (sort (filter (cut machine-matches? <> requirements)
269 machines)
270 machine-faster?)))
271 (match machines
272 ((head . _)
273 head)
274 (_ #f))))
275
276(define* (process-request wants-local? system drv features
277 #:key
278 print-build-trace? (max-silent-time 3600)
279 (build-timeout 7200))
280 "Process a request to build DRV."
281 (let* ((local? (and wants-local? (string=? system (%current-system))))
282 (reqs (build-requirements
283 (system system)
284 (features features)))
285 (machine (choose-build-machine reqs (build-machines))))
286 (if machine
287 (match (open-ssh-gateway machine)
288 ((? integer? pid)
289 (display "# accept\n")
290 (let ((inputs (string-tokenize (read-line)))
291 (outputs (string-tokenize (read-line))))
292 (when (send-files (cons (derivation-file-name drv) inputs)
293 machine)
294 (let ((log (offload drv machine
295 #:print-build-trace? print-build-trace?
296 #:max-silent-time max-silent-time
297 #:build-timeout build-timeout)))
298 (let loop ((line (read-line log)))
299 (if (eof-object? line)
300 (close-pipe log)
301 (begin
302 (display line) (newline)
303 (loop (read-line log))))))
304 (retrieve-files outputs machine)))
305 (format (current-error-port) "done with offloaded '~a'~%"
306 (derivation-file-name drv))
307 (kill pid SIGTERM))
308 (#f
309 (display "# decline\n")))
310 (display "# decline\n"))))
311
312(define-syntax-rule (with-nar-error-handling body ...)
313 "Execute BODY with any &nar-error suitably reported to the user."
314 (guard (c ((nar-error? c)
315 (let ((file (nar-error-file c)))
316 (if (condition-has-type? c &message)
317 (leave (_ "while importing file '~a': ~a~%")
318 file (gettext (condition-message c)))
319 (leave (_ "failed to import file '~a'~%")
320 file)))))
321 body ...))
322
323
324;;;
325;;; Entry point.
326;;;
327
328(define (guix-offload . args)
329 (define request-line-rx
330 ;; The request format. See 'tryBuildHook' method in build.cc.
331 (make-regexp "([01]) ([a-z0-9_-]+) (/[[:graph:]]+.drv) ([[:graph:]]*)"))
332
333 (define not-coma
334 (char-set-complement (char-set #\,)))
335
336 ;; Make sure $HOME really corresponds to the current user. This is
337 ;; necessary since lsh uses that to determine the location of the yarrow
338 ;; seed file, and fails if it's owned by someone else.
339 (and=> (passwd:dir (getpw (getuid)))
340 (cut setenv "HOME" <>))
341
342 (match args
343 ((system max-silent-time print-build-trace? build-timeout)
344 (let ((max-silent-time (string->number max-silent-time))
345 (build-timeout (string->number build-timeout))
346 (print-build-trace? (string=? print-build-trace? "1")))
347 (parameterize ((%current-system system))
348 (let loop ((line (read-line)))
349 (unless (eof-object? line)
350 (cond ((regexp-exec request-line-rx line)
351 =>
352 (lambda (match)
353 (with-nar-error-handling
354 (process-request (equal? (match:substring match 1) "1")
355 (match:substring match 2) ; system
356 (call-with-input-file
357 (match:substring match 3)
358 read-derivation)
359 (string-tokenize
360 (match:substring match 4) not-coma)
361 #:print-build-trace? print-build-trace?
362 #:max-silent-time max-silent-time
363 #:build-timeout build-timeout))))
364 (else
365 (leave (_ "invalid request line: ~s~%") line)))
366 (loop (read-line)))))))
367 (("--version")
368 (show-version-and-exit "guix offload"))
369 (("--help")
370 (format #t (_ "Usage: guix offload SYSTEM PRINT-BUILD-TRACE
371Process build offload requests written on the standard input, possibly
372offloading builds to the machines listed in '~a'.~%")
373 %machine-file)
374 (display (_ "
375This tool is meant to be used internally by 'guix-daemon'.\n"))
376 (show-bug-report-information))
377 (x
378 (leave (_ "invalid arguments: ~{~s ~}~%") x))))
379
380;;; offload.scm ends here
diff --git a/guix/ui.scm b/guix/ui.scm
index bb811c557d0..d6058f806bb 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -559,7 +559,7 @@ reporting."
559 559
560(define (show-guix-help) 560(define (show-guix-help)
561 (define (internal? command) 561 (define (internal? command)
562 (member command '("substitute-binary" "authenticate"))) 562 (member command '("substitute-binary" "authenticate" "offload")))
563 563
564 (format #t (_ "Usage: guix COMMAND ARGS... 564 (format #t (_ "Usage: guix COMMAND ARGS...
565Run COMMAND with ARGS.\n")) 565Run COMMAND with ARGS.\n"))
diff --git a/m4/guix.m4 b/m4/guix.m4
index a98378db792..19e041a72c6 100644
--- a/m4/guix.m4
+++ b/m4/guix.m4
@@ -1,5 +1,5 @@
1dnl GNU Guix --- Functional package management for GNU 1dnl GNU Guix --- Functional package management for GNU
2dnl Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> 2dnl Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
3dnl 3dnl
4dnl This file is part of GNU Guix. 4dnl This file is part of GNU Guix.
5dnl 5dnl
@@ -134,3 +134,20 @@ AC_DEFUN([GUIX_CHECK_SRFI_37], [
134 ac_cv_guix_srfi_37_broken=yes 134 ac_cv_guix_srfi_37_broken=yes
135 fi]) 135 fi])
136]) 136])
137
138dnl GUIX_CHECK_UNBUFFERED_CBIP
139dnl
140dnl Check whether 'setbvuf' works on custom binary input ports (CBIPs), as is
141dnl the case starting with Guile 2.0.10.
142AC_DEFUN([GUIX_CHECK_UNBUFFERED_CBIP], [
143 AC_CACHE_CHECK([whether Guile's custom binary input ports support 'setvbuf'],
144 [ac_cv_guix_cbips_support_setvbuf],
145 [if "$GUILE" -c "(use-modules (rnrs io ports)) \
146 (let ((p (make-custom-binary-input-port \"cbip\" pk #f #f #f))) \
147 (setvbuf p _IONBF))" >&5 2>&1
148 then
149 ac_cv_guix_cbips_support_setvbuf=yes
150 else
151 ac_cv_guix_cbips_support_setvbuf=no
152 fi])
153])
diff --git a/nix/nix-daemon/guix-daemon.cc b/nix/nix-daemon/guix-daemon.cc
index cf87e393545..d35b1cd0769 100644
--- a/nix/nix-daemon/guix-daemon.cc
+++ b/nix/nix-daemon/guix-daemon.cc
@@ -1,5 +1,5 @@
1/* GNU Guix --- Functional package management for GNU 1/* GNU Guix --- Functional package management for GNU
2 Copyright (C) 2012, 2013 Ludovic Courtès <ludo@gnu.org> 2 Copyright (C) 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
3 3
4 This file is part of GNU Guix. 4 This file is part of GNU Guix.
5 5
@@ -67,6 +67,7 @@ builds derivations on behalf of its clients.";
67#define GUIX_OPT_CHROOT_DIR 10 67#define GUIX_OPT_CHROOT_DIR 10
68#define GUIX_OPT_LISTEN 11 68#define GUIX_OPT_LISTEN 11
69#define GUIX_OPT_NO_SUBSTITUTES 12 69#define GUIX_OPT_NO_SUBSTITUTES 12
70#define GUIX_OPT_NO_BUILD_HOOK 13
70 71
71static const struct argp_option options[] = 72static const struct argp_option options[] =
72 { 73 {
@@ -94,6 +95,8 @@ static const struct argp_option options[] =
94 "Perform builds as a user of GROUP" }, 95 "Perform builds as a user of GROUP" },
95 { "no-substitutes", GUIX_OPT_NO_SUBSTITUTES, 0, 0, 96 { "no-substitutes", GUIX_OPT_NO_SUBSTITUTES, 0, 0,
96 "Do not use substitutes" }, 97 "Do not use substitutes" },
98 { "no-build-hook", GUIX_OPT_NO_BUILD_HOOK, 0, 0,
99 "Do not use the 'build hook'" },
97 { "cache-failures", GUIX_OPT_CACHE_FAILURES, 0, 0, 100 { "cache-failures", GUIX_OPT_CACHE_FAILURES, 0, 0,
98 "Cache build failures" }, 101 "Cache build failures" },
99 { "lose-logs", GUIX_OPT_LOSE_LOGS, 0, 0, 102 { "lose-logs", GUIX_OPT_LOSE_LOGS, 0, 0,
@@ -159,6 +162,9 @@ parse_opt (int key, char *arg, struct argp_state *state)
159 case GUIX_OPT_NO_SUBSTITUTES: 162 case GUIX_OPT_NO_SUBSTITUTES:
160 settings.useSubstitutes = false; 163 settings.useSubstitutes = false;
161 break; 164 break;
165 case GUIX_OPT_NO_BUILD_HOOK:
166 settings.useBuildHook = false;
167 break;
162 case GUIX_OPT_DEBUG: 168 case GUIX_OPT_DEBUG:
163 verbosity = lvlDebug; 169 verbosity = lvlDebug;
164 break; 170 break;
@@ -226,6 +232,21 @@ main (int argc, char *argv[])
226 settings.substituters.clear (); 232 settings.substituters.clear ();
227 settings.useSubstitutes = true; 233 settings.useSubstitutes = true;
228 234
235#ifdef HAVE_DAEMON_OFFLOAD_HOOK
236 /* Use our build hook for distributed builds by default. */
237 settings.useBuildHook = true;
238 if (getenv ("NIX_BUILD_HOOK") == NULL)
239 {
240 std::string build_hook;
241
242 build_hook = settings.nixLibexecDir + "/guix/offload";
243 setenv ("NIX_BUILD_HOOK", build_hook.c_str (), 1);
244 }
245#else
246 /* We are not installing any build hook, so disable it. */
247 settings.useBuildHook = false;
248#endif
249
229 argp_parse (&argp, argc, argv, 0, 0, 0); 250 argp_parse (&argp, argc, argv, 0, 0, 0);
230 251
231 if (settings.useSubstitutes) 252 if (settings.useSubstitutes)
diff --git a/nix/scripts/offload.in b/nix/scripts/offload.in
new file mode 100644
index 00000000000..50faed31c0b
--- /dev/null
+++ b/nix/scripts/offload.in
@@ -0,0 +1,11 @@
1#!@SHELL@
2# A shorthand for "guix offload", for use by the daemon.
3
4if test "x$GUIX_UNINSTALLED" = "x"
5then
6 prefix="@prefix@"
7 exec_prefix="@exec_prefix@"
8 exec "@bindir@/guix" offload "$@"
9else
10 exec guix offload "$@"
11fi
diff --git a/pre-inst-env.in b/pre-inst-env.in
index 3f1fa59bb82..e90e1b0ac49 100644
--- a/pre-inst-env.in
+++ b/pre-inst-env.in
@@ -1,7 +1,7 @@
1#!/bin/sh 1#!/bin/sh
2 2
3# GNU Guix --- Functional package management for GNU 3# GNU Guix --- Functional package management for GNU
4# Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> 4# Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
5# 5#
6# This file is part of GNU Guix. 6# This file is part of GNU Guix.
7# 7#
@@ -44,7 +44,8 @@ export PATH
44NIX_ROOT_FINDER="$abs_top_builddir/nix/scripts/list-runtime-roots" 44NIX_ROOT_FINDER="$abs_top_builddir/nix/scripts/list-runtime-roots"
45NIX_SUBSTITUTERS="$abs_top_builddir/nix/scripts/substitute-binary" 45NIX_SUBSTITUTERS="$abs_top_builddir/nix/scripts/substitute-binary"
46NIX_SETUID_HELPER="$abs_top_builddir/nix-setuid-helper" 46NIX_SETUID_HELPER="$abs_top_builddir/nix-setuid-helper"
47export NIX_ROOT_FINDER NIX_SETUID_HELPER NIX_SUBSTITUTERS 47NIX_BUILD_HOOK="$abs_top_builddir/nix/scripts/offload"
48export NIX_ROOT_FINDER NIX_SETUID_HELPER NIX_SUBSTITUTERS NIX_BUILD_HOOK
48 49
49# The 'guix-register' program. 50# The 'guix-register' program.
50GUIX_REGISTER="$abs_top_builddir/guix-register" 51GUIX_REGISTER="$abs_top_builddir/guix-register"