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:
Ludovic Courtès
parent
50add47748
commit
49e6291a7a
|
|
@ -85,3 +85,4 @@ GRTAGS
|
|||
GTAGS
|
||||
/nix-setuid-helper
|
||||
/nix/scripts/guix-authenticate
|
||||
/nix/scripts/offload
|
||||
|
|
|
|||
17
Makefile.am
17
Makefile.am
|
|
@ -1,5 +1,5 @@
|
|||
# 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>
|
||||
#
|
||||
# This file is part of GNU Guix.
|
||||
|
|
@ -80,6 +80,13 @@ MODULES = \
|
|||
guix.scm \
|
||||
$(GNU_SYSTEM_MODULES)
|
||||
|
||||
if BUILD_DAEMON_OFFLOAD
|
||||
|
||||
MODULES += \
|
||||
guix/scripts/offload.scm
|
||||
|
||||
endif BUILD_DAEMON_OFFLOAD
|
||||
|
||||
# Because of the autoload hack in (guix build download), we must build it
|
||||
# first to avoid errors on systems where (gnutls) is unavailable.
|
||||
guix/scripts/download.go: guix/build/download.go
|
||||
|
|
@ -185,6 +192,14 @@ EXTRA_DIST = \
|
|||
release.nix \
|
||||
$(TESTS)
|
||||
|
||||
if !BUILD_DAEMON_OFFLOAD
|
||||
|
||||
EXTRA_DIST += \
|
||||
guix/scripts/offload.scm
|
||||
|
||||
endif !BUILD_DAEMON_OFFLOAD
|
||||
|
||||
|
||||
CLEANFILES = \
|
||||
$(GOBJECTS) \
|
||||
$(SCM_TESTS:tests/%.scm=%.log)
|
||||
|
|
|
|||
|
|
@ -95,6 +95,17 @@ if test "x$guix_build_daemon" = "xyes"; then
|
|||
dnl Check for <linux/fs.h> (for immutable file support).
|
||||
AC_CHECK_HEADERS([linux/fs.h])
|
||||
|
||||
dnl Check whether the 'offload' build hook can be built (uses
|
||||
dnl 'restore-file-set', which requires unbuffered custom binary input
|
||||
dnl ports from Guile >= 2.0.10.)
|
||||
GUIX_CHECK_UNBUFFERED_CBIP
|
||||
guix_build_daemon_offload="$ac_cv_guix_cbips_support_setvbuf"
|
||||
|
||||
if test "x$guix_build_daemon_offload" = "xyes"; then
|
||||
AC_DEFINE([HAVE_DAEMON_OFFLOAD_HOOK], [1],
|
||||
[Define if the daemon's 'offload' build hook is being built.])
|
||||
fi
|
||||
|
||||
dnl Temporary directory used to store the daemon's data.
|
||||
AC_MSG_CHECKING([for unit test root])
|
||||
GUIX_TEST_ROOT="`pwd`/test-tmp"
|
||||
|
|
@ -107,6 +118,11 @@ if test "x$guix_build_daemon" = "xyes"; then
|
|||
[chmod +x nix/scripts/substitute-binary])
|
||||
AC_CONFIG_FILES([nix/scripts/guix-authenticate],
|
||||
[chmod +x nix/scripts/guix-authenticate])
|
||||
AC_CONFIG_FILES([nix/scripts/offload],
|
||||
[chmod +x nix/scripts/offload])
|
||||
fi
|
||||
|
||||
AM_CONDITIONAL([BUILD_DAEMON], [test "x$guix_build_daemon" = "xyes"])
|
||||
AM_CONDITIONAL([BUILD_DAEMON_OFFLOAD], \
|
||||
[test "x$guix_build_daemon" = "xyes" \
|
||||
&& test "x$guix_build_daemon_offload" = "xyes"])
|
||||
|
|
|
|||
|
|
@ -172,6 +172,14 @@ nodist_pkglibexec_SCRIPTS = \
|
|||
nix/scripts/list-runtime-roots \
|
||||
nix/scripts/substitute-binary
|
||||
|
||||
if BUILD_DAEMON_OFFLOAD
|
||||
|
||||
nodist_pkglibexec_SCRIPTS += \
|
||||
nix/scripts/offload
|
||||
|
||||
endif BUILD_DAEMON_OFFLOAD
|
||||
|
||||
|
||||
# XXX: It'd be better to hide it in $(pkglibexecdir).
|
||||
nodist_libexec_SCRIPTS = \
|
||||
nix/scripts/guix-authenticate
|
||||
|
|
|
|||
122
doc/guix.texi
122
doc/guix.texi
|
|
@ -175,13 +175,24 @@ your goal is to share the store with Nix.
|
|||
|
||||
@cindex daemon
|
||||
Operations such as building a package or running the garbage collector
|
||||
are all performed by a specialized process, the @dfn{Guix daemon}, on
|
||||
are all performed by a specialized process, the @dfn{build daemon}, on
|
||||
behalf of clients. Only the daemon may access the store and its
|
||||
associated database. Thus, any operation that manipulates the store
|
||||
goes through the daemon. For instance, command-line tools such as
|
||||
@command{guix package} and @command{guix build} communicate with the
|
||||
daemon (@i{via} remote procedure calls) to instruct it what to do.
|
||||
|
||||
The following sections explain how to prepare the build daemon's
|
||||
environment.
|
||||
|
||||
@menu
|
||||
* Build Environment Setup:: Preparing the isolated build environment.
|
||||
* Daemon Offload Setup:: Offloading builds to remote machines.
|
||||
@end menu
|
||||
|
||||
@node Build Environment Setup
|
||||
@subsection Build Environment Setup
|
||||
|
||||
In a standard multi-user setup, Guix and its daemon---the
|
||||
@command{guix-daemon} program---are installed by the system
|
||||
administrator; @file{/nix/store} is owned by @code{root} and
|
||||
|
|
@ -256,14 +267,6 @@ user @file{nobody};
|
|||
a writable @file{/tmp} directory.
|
||||
@end itemize
|
||||
|
||||
Finally, you may want to generate a key pair to allow the daemon to
|
||||
export signed archives of files from the store (@pxref{Invoking guix
|
||||
archive}):
|
||||
|
||||
@example
|
||||
# guix archive --generate-key
|
||||
@end example
|
||||
|
||||
If you are installing Guix as an unprivileged user, it is still
|
||||
possible to run @command{guix-daemon}. However, build processes will
|
||||
not be isolated from one another, and not from the rest of the system.
|
||||
|
|
@ -271,6 +274,107 @@ Thus, build processes may interfere with each other, and may access
|
|||
programs, libraries, and other files available on the system---making it
|
||||
much harder to view them as @emph{pure} functions.
|
||||
|
||||
|
||||
@node Daemon Offload Setup
|
||||
@subsection Using the Offload Facility
|
||||
|
||||
@cindex offloading
|
||||
The build daemon can @dfn{offload} derivation builds to other machines
|
||||
running Guix, using the @code{offload} @dfn{build hook}. When that
|
||||
feature is enabled, a list of user-specified build machines is read from
|
||||
@file{/etc/guix/machines.scm}; anytime a build is requested, for
|
||||
instance via @code{guix build}, the daemon attempts to offload it to one
|
||||
of the machines that satisfies the derivation's constraints, in
|
||||
particular its system type---e.g., @file{x86_64-linux}. Missing
|
||||
prerequisites for the build are copied over SSH to the target machine,
|
||||
which then proceeds with the build; upon success the output(s) of the
|
||||
build are copied back to the initial machine.
|
||||
|
||||
The @file{/etc/guix/machines.scm} is---not surprisingly!---a Scheme file
|
||||
whose return value must be a list of @code{build-machine} objects. In
|
||||
practice, it typically looks like this:
|
||||
|
||||
@example
|
||||
(list (build-machine
|
||||
(name "eightysix.example.org")
|
||||
(system "x86_64-linux")
|
||||
(user "bob")
|
||||
(speed 2.)) ; incredibly fast!
|
||||
|
||||
(build-machine
|
||||
(name "meeps.example.org")
|
||||
(system "mips64el-linux")
|
||||
(user "alice")
|
||||
(private-key
|
||||
(string-append (getenv "HOME")
|
||||
"/.ssh/id-rsa-for-guix"))))
|
||||
@end example
|
||||
|
||||
@noindent
|
||||
In the example above we specify a list of two build machines, one for
|
||||
the @code{x86_64} architecture and one for the @code{mips64el}
|
||||
architecture. The compulsory fields for a @code{build-machine}
|
||||
declaration are:
|
||||
|
||||
@table @code
|
||||
|
||||
@item name
|
||||
The remote machine's host name.
|
||||
|
||||
@item system
|
||||
The remote machine's system type.
|
||||
|
||||
@item user
|
||||
The user account to use when connecting to the remote machine over SSH.
|
||||
Note that the SSH key pair must @emph{not} be passphrase-protected, to
|
||||
allow non-interactive logins.
|
||||
|
||||
@end table
|
||||
|
||||
@noindent
|
||||
A number of optional fields may be optionally specified:
|
||||
|
||||
@table @code
|
||||
|
||||
@item private-key
|
||||
The SSH private key file to use when connecting to the machine.
|
||||
|
||||
@item parallel-builds
|
||||
The number of builds that may run in parallel on the machine (1 by
|
||||
default.)
|
||||
|
||||
@item speed
|
||||
A ``relative speed factor''. The offload scheduler will tend to prefer
|
||||
machines with a higher speed factor.
|
||||
|
||||
@item features
|
||||
A list of strings denoting specific features supported by the machine.
|
||||
An example is @code{"kvm"} for machines that have the KVM Linux modules
|
||||
and corresponding hardware support. Derivations can request features by
|
||||
name, and they will be scheduled on matching build machines.
|
||||
|
||||
@end table
|
||||
|
||||
The @code{guix} command must be in the search path on the build
|
||||
machines, since offloading works by invoking the @code{guix archive} and
|
||||
@code{guix build} commands.
|
||||
|
||||
There's one last thing to do once @file{machines.scm} is in place. As
|
||||
explained above, when offloading, files are transferred back and forth
|
||||
between the machine stores. For this to work, you need to generate a
|
||||
key pair to allow the daemon to export signed archives of files from the
|
||||
store (@pxref{Invoking guix archive}):
|
||||
|
||||
@example
|
||||
# guix archive --generate-key
|
||||
@end example
|
||||
|
||||
@noindent
|
||||
Thus, when receiving files, a machine's build daemon can make sure they
|
||||
are genuine, have not been tampered with, and that they are signed by an
|
||||
authorized key.
|
||||
|
||||
|
||||
@node Invoking guix-daemon
|
||||
@section Invoking @command{guix-daemon}
|
||||
|
||||
|
|
|
|||
|
|
@ -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 (internal? command)
|
||||
(member command '("substitute-binary" "authenticate")))
|
||||
(member command '("substitute-binary" "authenticate" "offload")))
|
||||
|
||||
(format #t (_ "Usage: guix COMMAND ARGS...
|
||||
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 Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
|
||||
dnl Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
||||
dnl
|
||||
dnl This file is part of GNU Guix.
|
||||
dnl
|
||||
|
|
@ -134,3 +134,20 @@ AC_DEFUN([GUIX_CHECK_SRFI_37], [
|
|||
ac_cv_guix_srfi_37_broken=yes
|
||||
fi])
|
||||
])
|
||||
|
||||
dnl GUIX_CHECK_UNBUFFERED_CBIP
|
||||
dnl
|
||||
dnl Check whether 'setbvuf' works on custom binary input ports (CBIPs), as is
|
||||
dnl the case starting with Guile 2.0.10.
|
||||
AC_DEFUN([GUIX_CHECK_UNBUFFERED_CBIP], [
|
||||
AC_CACHE_CHECK([whether Guile's custom binary input ports support 'setvbuf'],
|
||||
[ac_cv_guix_cbips_support_setvbuf],
|
||||
[if "$GUILE" -c "(use-modules (rnrs io ports)) \
|
||||
(let ((p (make-custom-binary-input-port \"cbip\" pk #f #f #f))) \
|
||||
(setvbuf p _IONBF))" >&5 2>&1
|
||||
then
|
||||
ac_cv_guix_cbips_support_setvbuf=yes
|
||||
else
|
||||
ac_cv_guix_cbips_support_setvbuf=no
|
||||
fi])
|
||||
])
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
/* 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.
|
||||
|
||||
|
|
@ -67,6 +67,7 @@ builds derivations on behalf of its clients.";
|
|||
#define GUIX_OPT_CHROOT_DIR 10
|
||||
#define GUIX_OPT_LISTEN 11
|
||||
#define GUIX_OPT_NO_SUBSTITUTES 12
|
||||
#define GUIX_OPT_NO_BUILD_HOOK 13
|
||||
|
||||
static const struct argp_option options[] =
|
||||
{
|
||||
|
|
@ -94,6 +95,8 @@ static const struct argp_option options[] =
|
|||
"Perform builds as a user of GROUP" },
|
||||
{ "no-substitutes", GUIX_OPT_NO_SUBSTITUTES, 0, 0,
|
||||
"Do not use substitutes" },
|
||||
{ "no-build-hook", GUIX_OPT_NO_BUILD_HOOK, 0, 0,
|
||||
"Do not use the 'build hook'" },
|
||||
{ "cache-failures", GUIX_OPT_CACHE_FAILURES, 0, 0,
|
||||
"Cache build failures" },
|
||||
{ "lose-logs", GUIX_OPT_LOSE_LOGS, 0, 0,
|
||||
|
|
@ -159,6 +162,9 @@ parse_opt (int key, char *arg, struct argp_state *state)
|
|||
case GUIX_OPT_NO_SUBSTITUTES:
|
||||
settings.useSubstitutes = false;
|
||||
break;
|
||||
case GUIX_OPT_NO_BUILD_HOOK:
|
||||
settings.useBuildHook = false;
|
||||
break;
|
||||
case GUIX_OPT_DEBUG:
|
||||
verbosity = lvlDebug;
|
||||
break;
|
||||
|
|
@ -226,6 +232,21 @@ main (int argc, char *argv[])
|
|||
settings.substituters.clear ();
|
||||
settings.useSubstitutes = true;
|
||||
|
||||
#ifdef HAVE_DAEMON_OFFLOAD_HOOK
|
||||
/* Use our build hook for distributed builds by default. */
|
||||
settings.useBuildHook = true;
|
||||
if (getenv ("NIX_BUILD_HOOK") == NULL)
|
||||
{
|
||||
std::string build_hook;
|
||||
|
||||
build_hook = settings.nixLibexecDir + "/guix/offload";
|
||||
setenv ("NIX_BUILD_HOOK", build_hook.c_str (), 1);
|
||||
}
|
||||
#else
|
||||
/* We are not installing any build hook, so disable it. */
|
||||
settings.useBuildHook = false;
|
||||
#endif
|
||||
|
||||
argp_parse (&argp, argc, argv, 0, 0, 0);
|
||||
|
||||
if (settings.useSubstitutes)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
# 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.
|
||||
#
|
||||
|
|
@ -44,7 +44,8 @@ export PATH
|
|||
NIX_ROOT_FINDER="$abs_top_builddir/nix/scripts/list-runtime-roots"
|
||||
NIX_SUBSTITUTERS="$abs_top_builddir/nix/scripts/substitute-binary"
|
||||
NIX_SETUID_HELPER="$abs_top_builddir/nix-setuid-helper"
|
||||
export NIX_ROOT_FINDER NIX_SETUID_HELPER NIX_SUBSTITUTERS
|
||||
NIX_BUILD_HOOK="$abs_top_builddir/nix/scripts/offload"
|
||||
export NIX_ROOT_FINDER NIX_SETUID_HELPER NIX_SUBSTITUTERS NIX_BUILD_HOOK
|
||||
|
||||
# The 'guix-register' program.
|
||||
GUIX_REGISTER="$abs_top_builddir/guix-register"
|
||||
|
|
|
|||
Loading…
Reference in New Issue