diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2014-01-23 23:48:34 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2014-01-24 00:01:50 +0100 |
| commit | 49e6291a7a257f89f01644423f1b685778b8862a (patch) | |
| tree | d461cae8cfc21fc9fa421c3fb62d372bf44c2ca7 | |
| parent | 50add47748eb40371d8b88208a13e7230d15c220 (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-- | .gitignore | 1 | ||||
| -rw-r--r-- | Makefile.am | 17 | ||||
| -rw-r--r-- | config-daemon.ac | 16 | ||||
| -rw-r--r-- | daemon.am | 8 | ||||
| -rw-r--r-- | doc/guix.texi | 122 | ||||
| -rw-r--r-- | guix/scripts/offload.scm | 380 | ||||
| -rw-r--r-- | guix/ui.scm | 2 | ||||
| -rw-r--r-- | m4/guix.m4 | 19 | ||||
| -rw-r--r-- | nix/nix-daemon/guix-daemon.cc | 23 | ||||
| -rw-r--r-- | nix/scripts/offload.in | 11 | ||||
| -rw-r--r-- | pre-inst-env.in | 5 |
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 | |||
| 85 | GTAGS | 85 | GTAGS |
| 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 | ||
| 83 | if BUILD_DAEMON_OFFLOAD | ||
| 84 | |||
| 85 | MODULES += \ | ||
| 86 | guix/scripts/offload.scm | ||
| 87 | |||
| 88 | endif 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. |
| 85 | guix/scripts/download.go: guix/build/download.go | 92 | guix/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 | ||
| 195 | if !BUILD_DAEMON_OFFLOAD | ||
| 196 | |||
| 197 | EXTRA_DIST += \ | ||
| 198 | guix/scripts/offload.scm | ||
| 199 | |||
| 200 | endif !BUILD_DAEMON_OFFLOAD | ||
| 201 | |||
| 202 | |||
| 188 | CLEANFILES = \ | 203 | CLEANFILES = \ |
| 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]) | ||
| 110 | fi | 123 | fi |
| 111 | 124 | ||
| 112 | AM_CONDITIONAL([BUILD_DAEMON], [test "x$guix_build_daemon" = "xyes"]) | 125 | AM_CONDITIONAL([BUILD_DAEMON], [test "x$guix_build_daemon" = "xyes"]) |
| 126 | AM_CONDITIONAL([BUILD_DAEMON_OFFLOAD], \ | ||
| 127 | [test "x$guix_build_daemon" = "xyes" \ | ||
| 128 | && test "x$guix_build_daemon_offload" = "xyes"]) | ||
| @@ -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 | ||
| 175 | if BUILD_DAEMON_OFFLOAD | ||
| 176 | |||
| 177 | nodist_pkglibexec_SCRIPTS += \ | ||
| 178 | nix/scripts/offload | ||
| 179 | |||
| 180 | endif 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). |
| 176 | nodist_libexec_SCRIPTS = \ | 184 | nodist_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 |
| 177 | Operations such as building a package or running the garbage collector | 177 | Operations such as building a package or running the garbage collector |
| 178 | are all performed by a specialized process, the @dfn{Guix daemon}, on | 178 | are all performed by a specialized process, the @dfn{build daemon}, on |
| 179 | behalf of clients. Only the daemon may access the store and its | 179 | behalf of clients. Only the daemon may access the store and its |
| 180 | associated database. Thus, any operation that manipulates the store | 180 | associated database. Thus, any operation that manipulates the store |
| 181 | goes through the daemon. For instance, command-line tools such as | 181 | goes 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 |
| 183 | daemon (@i{via} remote procedure calls) to instruct it what to do. | 183 | daemon (@i{via} remote procedure calls) to instruct it what to do. |
| 184 | 184 | ||
| 185 | The following sections explain how to prepare the build daemon's | ||
| 186 | environment. | ||
| 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 | |||
| 185 | In a standard multi-user setup, Guix and its daemon---the | 196 | In 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 |
| 187 | administrator; @file{/nix/store} is owned by @code{root} and | 198 | administrator; @file{/nix/store} is owned by @code{root} and |
| @@ -256,14 +267,6 @@ user @file{nobody}; | |||
| 256 | a writable @file{/tmp} directory. | 267 | a writable @file{/tmp} directory. |
| 257 | @end itemize | 268 | @end itemize |
| 258 | 269 | ||
| 259 | Finally, you may want to generate a key pair to allow the daemon to | ||
| 260 | export signed archives of files from the store (@pxref{Invoking guix | ||
| 261 | archive}): | ||
| 262 | |||
| 263 | @example | ||
| 264 | # guix archive --generate-key | ||
| 265 | @end example | ||
| 266 | |||
| 267 | If you are installing Guix as an unprivileged user, it is still | 270 | If you are installing Guix as an unprivileged user, it is still |
| 268 | possible to run @command{guix-daemon}. However, build processes will | 271 | possible to run @command{guix-daemon}. However, build processes will |
| 269 | not be isolated from one another, and not from the rest of the system. | 272 | 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 | |||
| 271 | programs, libraries, and other files available on the system---making it | 274 | programs, libraries, and other files available on the system---making it |
| 272 | much harder to view them as @emph{pure} functions. | 275 | much 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 | ||
| 282 | The build daemon can @dfn{offload} derivation builds to other machines | ||
| 283 | running Guix, using the @code{offload} @dfn{build hook}. When that | ||
| 284 | feature is enabled, a list of user-specified build machines is read from | ||
| 285 | @file{/etc/guix/machines.scm}; anytime a build is requested, for | ||
| 286 | instance via @code{guix build}, the daemon attempts to offload it to one | ||
| 287 | of the machines that satisfies the derivation's constraints, in | ||
| 288 | particular its system type---e.g., @file{x86_64-linux}. Missing | ||
| 289 | prerequisites for the build are copied over SSH to the target machine, | ||
| 290 | which then proceeds with the build; upon success the output(s) of the | ||
| 291 | build are copied back to the initial machine. | ||
| 292 | |||
| 293 | The @file{/etc/guix/machines.scm} is---not surprisingly!---a Scheme file | ||
| 294 | whose return value must be a list of @code{build-machine} objects. In | ||
| 295 | practice, 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 | ||
| 314 | In the example above we specify a list of two build machines, one for | ||
| 315 | the @code{x86_64} architecture and one for the @code{mips64el} | ||
| 316 | architecture. The compulsory fields for a @code{build-machine} | ||
| 317 | declaration are: | ||
| 318 | |||
| 319 | @table @code | ||
| 320 | |||
| 321 | @item name | ||
| 322 | The remote machine's host name. | ||
| 323 | |||
| 324 | @item system | ||
| 325 | The remote machine's system type. | ||
| 326 | |||
| 327 | @item user | ||
| 328 | The user account to use when connecting to the remote machine over SSH. | ||
| 329 | Note that the SSH key pair must @emph{not} be passphrase-protected, to | ||
| 330 | allow non-interactive logins. | ||
| 331 | |||
| 332 | @end table | ||
| 333 | |||
| 334 | @noindent | ||
| 335 | A number of optional fields may be optionally specified: | ||
| 336 | |||
| 337 | @table @code | ||
| 338 | |||
| 339 | @item private-key | ||
| 340 | The SSH private key file to use when connecting to the machine. | ||
| 341 | |||
| 342 | @item parallel-builds | ||
| 343 | The number of builds that may run in parallel on the machine (1 by | ||
| 344 | default.) | ||
| 345 | |||
| 346 | @item speed | ||
| 347 | A ``relative speed factor''. The offload scheduler will tend to prefer | ||
| 348 | machines with a higher speed factor. | ||
| 349 | |||
| 350 | @item features | ||
| 351 | A list of strings denoting specific features supported by the machine. | ||
| 352 | An example is @code{"kvm"} for machines that have the KVM Linux modules | ||
| 353 | and corresponding hardware support. Derivations can request features by | ||
| 354 | name, and they will be scheduled on matching build machines. | ||
| 355 | |||
| 356 | @end table | ||
| 357 | |||
| 358 | The @code{guix} command must be in the search path on the build | ||
| 359 | machines, since offloading works by invoking the @code{guix archive} and | ||
| 360 | @code{guix build} commands. | ||
| 361 | |||
| 362 | There's one last thing to do once @file{machines.scm} is in place. As | ||
| 363 | explained above, when offloading, files are transferred back and forth | ||
| 364 | between the machine stores. For this to work, you need to generate a | ||
| 365 | key pair to allow the daemon to export signed archives of files from the | ||
| 366 | store (@pxref{Invoking guix archive}): | ||
| 367 | |||
| 368 | @example | ||
| 369 | # guix archive --generate-key | ||
| 370 | @end example | ||
| 371 | |||
| 372 | @noindent | ||
| 373 | Thus, when receiving files, a machine's build daemon can make sure they | ||
| 374 | are genuine, have not been tampered with, and that they are signed by an | ||
| 375 | authorized 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 | ||
| 91 | determined." | ||
| 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 | ||
| 127 | running 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 | ||
| 175 | there. 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 | ||
| 192 | success, #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 | ||
| 371 | Process build offload requests written on the standard input, possibly | ||
| 372 | offloading builds to the machines listed in '~a'.~%") | ||
| 373 | %machine-file) | ||
| 374 | (display (_ " | ||
| 375 | This 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... |
| 565 | Run COMMAND with ARGS.\n")) | 565 | Run 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 @@ | |||
| 1 | dnl GNU Guix --- Functional package management for GNU | 1 | dnl GNU Guix --- Functional package management for GNU |
| 2 | dnl Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> | 2 | dnl Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> |
| 3 | dnl | 3 | dnl |
| 4 | dnl This file is part of GNU Guix. | 4 | dnl This file is part of GNU Guix. |
| 5 | dnl | 5 | dnl |
| @@ -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 | |||
| 138 | dnl GUIX_CHECK_UNBUFFERED_CBIP | ||
| 139 | dnl | ||
| 140 | dnl Check whether 'setbvuf' works on custom binary input ports (CBIPs), as is | ||
| 141 | dnl the case starting with Guile 2.0.10. | ||
| 142 | AC_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 | ||
| 71 | static const struct argp_option options[] = | 72 | static 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 | |||
| 4 | if test "x$GUIX_UNINSTALLED" = "x" | ||
| 5 | then | ||
| 6 | prefix="@prefix@" | ||
| 7 | exec_prefix="@exec_prefix@" | ||
| 8 | exec "@bindir@/guix" offload "$@" | ||
| 9 | else | ||
| 10 | exec guix offload "$@" | ||
| 11 | fi | ||
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 | |||
| 44 | NIX_ROOT_FINDER="$abs_top_builddir/nix/scripts/list-runtime-roots" | 44 | NIX_ROOT_FINDER="$abs_top_builddir/nix/scripts/list-runtime-roots" |
| 45 | NIX_SUBSTITUTERS="$abs_top_builddir/nix/scripts/substitute-binary" | 45 | NIX_SUBSTITUTERS="$abs_top_builddir/nix/scripts/substitute-binary" |
| 46 | NIX_SETUID_HELPER="$abs_top_builddir/nix-setuid-helper" | 46 | NIX_SETUID_HELPER="$abs_top_builddir/nix-setuid-helper" |
| 47 | export NIX_ROOT_FINDER NIX_SETUID_HELPER NIX_SUBSTITUTERS | 47 | NIX_BUILD_HOOK="$abs_top_builddir/nix/scripts/offload" |
| 48 | export NIX_ROOT_FINDER NIX_SETUID_HELPER NIX_SUBSTITUTERS NIX_BUILD_HOOK | ||
| 48 | 49 | ||
| 49 | # The 'guix-register' program. | 50 | # The 'guix-register' program. |
| 50 | GUIX_REGISTER="$abs_top_builddir/guix-register" | 51 | GUIX_REGISTER="$abs_top_builddir/guix-register" |
