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.
This commit is contained in:
parent
50add47748
commit
49e6291a7a
|
@ -85,3 +85,4 @@ GRTAGS
|
||||||
GTAGS
|
GTAGS
|
||||||
/nix-setuid-helper
|
/nix-setuid-helper
|
||||||
/nix/scripts/guix-authenticate
|
/nix/scripts/guix-authenticate
|
||||||
|
/nix/scripts/offload
|
||||||
|
|
17
Makefile.am
17
Makefile.am
|
@ -1,5 +1,5 @@
|
||||||
# GNU Guix --- Functional package management for GNU
|
# GNU Guix --- Functional package management for GNU
|
||||||
# Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
|
# Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
||||||
# Copyright © 2013 Andreas Enge <andreas@enge.fr>
|
# Copyright © 2013 Andreas Enge <andreas@enge.fr>
|
||||||
#
|
#
|
||||||
# This file is part of GNU Guix.
|
# This file is part of GNU Guix.
|
||||||
|
@ -80,6 +80,13 @@ MODULES = \
|
||||||
guix.scm \
|
guix.scm \
|
||||||
$(GNU_SYSTEM_MODULES)
|
$(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
|
# Because of the autoload hack in (guix build download), we must build it
|
||||||
# first to avoid errors on systems where (gnutls) is unavailable.
|
# first to avoid errors on systems where (gnutls) is unavailable.
|
||||||
guix/scripts/download.go: guix/build/download.go
|
guix/scripts/download.go: guix/build/download.go
|
||||||
|
@ -185,6 +192,14 @@ EXTRA_DIST = \
|
||||||
release.nix \
|
release.nix \
|
||||||
$(TESTS)
|
$(TESTS)
|
||||||
|
|
||||||
|
if !BUILD_DAEMON_OFFLOAD
|
||||||
|
|
||||||
|
EXTRA_DIST += \
|
||||||
|
guix/scripts/offload.scm
|
||||||
|
|
||||||
|
endif !BUILD_DAEMON_OFFLOAD
|
||||||
|
|
||||||
|
|
||||||
CLEANFILES = \
|
CLEANFILES = \
|
||||||
$(GOBJECTS) \
|
$(GOBJECTS) \
|
||||||
$(SCM_TESTS:tests/%.scm=%.log)
|
$(SCM_TESTS:tests/%.scm=%.log)
|
||||||
|
|
|
@ -95,6 +95,17 @@ if test "x$guix_build_daemon" = "xyes"; then
|
||||||
dnl Check for <linux/fs.h> (for immutable file support).
|
dnl Check for <linux/fs.h> (for immutable file support).
|
||||||
AC_CHECK_HEADERS([linux/fs.h])
|
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.
|
dnl Temporary directory used to store the daemon's data.
|
||||||
AC_MSG_CHECKING([for unit test root])
|
AC_MSG_CHECKING([for unit test root])
|
||||||
GUIX_TEST_ROOT="`pwd`/test-tmp"
|
GUIX_TEST_ROOT="`pwd`/test-tmp"
|
||||||
|
@ -107,6 +118,11 @@ if test "x$guix_build_daemon" = "xyes"; then
|
||||||
[chmod +x nix/scripts/substitute-binary])
|
[chmod +x nix/scripts/substitute-binary])
|
||||||
AC_CONFIG_FILES([nix/scripts/guix-authenticate],
|
AC_CONFIG_FILES([nix/scripts/guix-authenticate],
|
||||||
[chmod +x nix/scripts/guix-authenticate])
|
[chmod +x nix/scripts/guix-authenticate])
|
||||||
|
AC_CONFIG_FILES([nix/scripts/offload],
|
||||||
|
[chmod +x nix/scripts/offload])
|
||||||
fi
|
fi
|
||||||
|
|
||||||
AM_CONDITIONAL([BUILD_DAEMON], [test "x$guix_build_daemon" = "xyes"])
|
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"])
|
||||||
|
|
|
@ -172,6 +172,14 @@ nodist_pkglibexec_SCRIPTS = \
|
||||||
nix/scripts/list-runtime-roots \
|
nix/scripts/list-runtime-roots \
|
||||||
nix/scripts/substitute-binary
|
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).
|
# XXX: It'd be better to hide it in $(pkglibexecdir).
|
||||||
nodist_libexec_SCRIPTS = \
|
nodist_libexec_SCRIPTS = \
|
||||||
nix/scripts/guix-authenticate
|
nix/scripts/guix-authenticate
|
||||||
|
|
122
doc/guix.texi
122
doc/guix.texi
|
@ -175,13 +175,24 @@ your goal is to share the store with Nix.
|
||||||
|
|
||||||
@cindex daemon
|
@cindex daemon
|
||||||
Operations such as building a package or running the garbage collector
|
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
|
behalf of clients. Only the daemon may access the store and its
|
||||||
associated database. Thus, any operation that manipulates the store
|
associated database. Thus, any operation that manipulates the store
|
||||||
goes through the daemon. For instance, command-line tools such as
|
goes through the daemon. For instance, command-line tools such as
|
||||||
@command{guix package} and @command{guix build} communicate with the
|
@command{guix package} and @command{guix build} communicate with the
|
||||||
daemon (@i{via} remote procedure calls) to instruct it what to do.
|
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
|
In a standard multi-user setup, Guix and its daemon---the
|
||||||
@command{guix-daemon} program---are installed by the system
|
@command{guix-daemon} program---are installed by the system
|
||||||
administrator; @file{/nix/store} is owned by @code{root} and
|
administrator; @file{/nix/store} is owned by @code{root} and
|
||||||
|
@ -256,14 +267,6 @@ user @file{nobody};
|
||||||
a writable @file{/tmp} directory.
|
a writable @file{/tmp} directory.
|
||||||
@end itemize
|
@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
|
If you are installing Guix as an unprivileged user, it is still
|
||||||
possible to run @command{guix-daemon}. However, build processes will
|
possible to run @command{guix-daemon}. However, build processes will
|
||||||
not be isolated from one another, and not from the rest of the system.
|
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
|
programs, libraries, and other files available on the system---making it
|
||||||
much harder to view them as @emph{pure} functions.
|
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
|
@node Invoking guix-daemon
|
||||||
@section Invoking @command{guix-daemon}
|
@section Invoking @command{guix-daemon}
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,380 @@
|
||||||
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
|
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
|
||||||
|
;;;
|
||||||
|
;;; This file is part of GNU Guix.
|
||||||
|
;;;
|
||||||
|
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||||||
|
;;; under the terms of the GNU General Public License as published by
|
||||||
|
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||||
|
;;; your option) any later version.
|
||||||
|
;;;
|
||||||
|
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||||||
|
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
;;; GNU General Public License for more details.
|
||||||
|
;;;
|
||||||
|
;;; You should have received a copy of the GNU General Public License
|
||||||
|
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
(define-module (guix scripts 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>
|
||||||
|
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>
|
||||||
|
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
|
||||||
|
;; <http://lists.lysator.liu.se/pipermail/lsh-bugs/2014q1/000639.html>.
|
||||||
|
"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 <build-machine> 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
|
|
@ -559,7 +559,7 @@ reporting."
|
||||||
|
|
||||||
(define (show-guix-help)
|
(define (show-guix-help)
|
||||||
(define (internal? command)
|
(define (internal? command)
|
||||||
(member command '("substitute-binary" "authenticate")))
|
(member command '("substitute-binary" "authenticate" "offload")))
|
||||||
|
|
||||||
(format #t (_ "Usage: guix COMMAND ARGS...
|
(format #t (_ "Usage: guix COMMAND ARGS...
|
||||||
Run COMMAND with ARGS.\n"))
|
Run COMMAND with ARGS.\n"))
|
||||||
|
|
19
m4/guix.m4
19
m4/guix.m4
|
@ -1,5 +1,5 @@
|
||||||
dnl GNU Guix --- Functional package management for GNU
|
dnl GNU Guix --- Functional package management for GNU
|
||||||
dnl Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
|
dnl Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
||||||
dnl
|
dnl
|
||||||
dnl This file is part of GNU Guix.
|
dnl This file is part of GNU Guix.
|
||||||
dnl
|
dnl
|
||||||
|
@ -134,3 +134,20 @@ AC_DEFUN([GUIX_CHECK_SRFI_37], [
|
||||||
ac_cv_guix_srfi_37_broken=yes
|
ac_cv_guix_srfi_37_broken=yes
|
||||||
fi])
|
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])
|
||||||
|
])
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
/* GNU Guix --- Functional package management for GNU
|
/* GNU Guix --- Functional package management for GNU
|
||||||
Copyright (C) 2012, 2013 Ludovic Courtès <ludo@gnu.org>
|
Copyright (C) 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
||||||
|
|
||||||
This file is part of GNU Guix.
|
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_CHROOT_DIR 10
|
||||||
#define GUIX_OPT_LISTEN 11
|
#define GUIX_OPT_LISTEN 11
|
||||||
#define GUIX_OPT_NO_SUBSTITUTES 12
|
#define GUIX_OPT_NO_SUBSTITUTES 12
|
||||||
|
#define GUIX_OPT_NO_BUILD_HOOK 13
|
||||||
|
|
||||||
static const struct argp_option options[] =
|
static const struct argp_option options[] =
|
||||||
{
|
{
|
||||||
|
@ -94,6 +95,8 @@ static const struct argp_option options[] =
|
||||||
"Perform builds as a user of GROUP" },
|
"Perform builds as a user of GROUP" },
|
||||||
{ "no-substitutes", GUIX_OPT_NO_SUBSTITUTES, 0, 0,
|
{ "no-substitutes", GUIX_OPT_NO_SUBSTITUTES, 0, 0,
|
||||||
"Do not use substitutes" },
|
"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-failures", GUIX_OPT_CACHE_FAILURES, 0, 0,
|
||||||
"Cache build failures" },
|
"Cache build failures" },
|
||||||
{ "lose-logs", GUIX_OPT_LOSE_LOGS, 0, 0,
|
{ "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:
|
case GUIX_OPT_NO_SUBSTITUTES:
|
||||||
settings.useSubstitutes = false;
|
settings.useSubstitutes = false;
|
||||||
break;
|
break;
|
||||||
|
case GUIX_OPT_NO_BUILD_HOOK:
|
||||||
|
settings.useBuildHook = false;
|
||||||
|
break;
|
||||||
case GUIX_OPT_DEBUG:
|
case GUIX_OPT_DEBUG:
|
||||||
verbosity = lvlDebug;
|
verbosity = lvlDebug;
|
||||||
break;
|
break;
|
||||||
|
@ -226,6 +232,21 @@ main (int argc, char *argv[])
|
||||||
settings.substituters.clear ();
|
settings.substituters.clear ();
|
||||||
settings.useSubstitutes = true;
|
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);
|
argp_parse (&argp, argc, argv, 0, 0, 0);
|
||||||
|
|
||||||
if (settings.useSubstitutes)
|
if (settings.useSubstitutes)
|
||||||
|
|
|
@ -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
|
|
@ -1,7 +1,7 @@
|
||||||
#!/bin/sh
|
#!/bin/sh
|
||||||
|
|
||||||
# GNU Guix --- Functional package management for GNU
|
# GNU Guix --- Functional package management for GNU
|
||||||
# Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
|
# Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
||||||
#
|
#
|
||||||
# This file is part of GNU Guix.
|
# 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_ROOT_FINDER="$abs_top_builddir/nix/scripts/list-runtime-roots"
|
||||||
NIX_SUBSTITUTERS="$abs_top_builddir/nix/scripts/substitute-binary"
|
NIX_SUBSTITUTERS="$abs_top_builddir/nix/scripts/substitute-binary"
|
||||||
NIX_SETUID_HELPER="$abs_top_builddir/nix-setuid-helper"
|
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.
|
# The 'guix-register' program.
|
||||||
GUIX_REGISTER="$abs_top_builddir/guix-register"
|
GUIX_REGISTER="$abs_top_builddir/guix-register"
|
||||||
|
|
Loading…
Reference in New Issue