From mboxrd@z Thu Jan 1 00:00:00 1970 From: Ludovic =?UTF-8?Q?Court=C3=A8s?= Subject: bug#20239: [PATCH 2/4] services: guix: Add 'chroot-directories' field. Date: Tue, 9 Jan 2018 17:14:25 +0100 Message-ID: <20180109161427.28836-3-ludo@gnu.org> References: <87tw6d1j7a.fsf@gnu.org> <20180109161427.28836-1-ludo@gnu.org> Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:55326) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1eYwYL-0001GI-4f for bug-guix@gnu.org; Tue, 09 Jan 2018 11:15:06 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1eYwYI-0006tu-SU for bug-guix@gnu.org; Tue, 09 Jan 2018 11:15:05 -0500 Received: from debbugs.gnu.org ([208.118.235.43]:34662) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1eYwYI-0006ti-Oi for bug-guix@gnu.org; Tue, 09 Jan 2018 11:15:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1eYwYI-0000aX-JT for bug-guix@gnu.org; Tue, 09 Jan 2018 11:15:02 -0500 Sender: "Debbugs-submit" Resent-Message-ID: In-Reply-To: <20180109161427.28836-1-ludo@gnu.org> List-Id: Bug reports for GNU Guix List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guix-bounces+gcggb-bug-guix=m.gmane.org@gnu.org Sender: "bug-Guix" To: 20239@debbugs.gnu.org * gnu/services/base.scm ()[chroot-directories]: New field. (guix-shepherd-service): Honor it. (references-file): New procedure. (guix-service-type)[compose, extend]: New fields. --- gnu/services/base.scm | 64 ++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 53 insertions(+), 11 deletions(-) diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 7c20232a6..8e30bcd34 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -1434,6 +1434,8 @@ failed to register hydra.gnu.org public key: ~a~%" status)))))))) (default #t)) (substitute-urls guix-configuration-substitute-urls ;list of strings (default %default-substitute-urls)) + (chroot-directories guix-configuration-chroot-directories ;list of file-like/strings + (default '())) (max-silent-time guix-configuration-max-silent-time ;integer (default 0)) (timeout guix-configuration-timeout ;integer @@ -1457,23 +1459,35 @@ failed to register hydra.gnu.org public key: ~a~%" status)))))))) (match-record config (guix build-group build-accounts authorize-key? authorized-keys use-substitutes? substitute-urls max-silent-time timeout - log-compression extra-options log-file http-proxy tmpdir) + log-compression extra-options log-file http-proxy tmpdir + chroot-directories) (list (shepherd-service (documentation "Run the Guix daemon.") (provision '(guix-daemon)) (requirement '(user-processes)) + (modules '((srfi srfi-1))) (start #~(make-forkexec-constructor - (list #$(file-append guix "/bin/guix-daemon") - "--build-users-group" #$build-group - "--max-silent-time" #$(number->string max-silent-time) - "--timeout" #$(number->string timeout) - "--log-compression" #$(symbol->string log-compression) - #$@(if use-substitutes? - '() - '("--no-substitutes")) - "--substitute-urls" #$(string-join substitute-urls) - #$@extra-options) + (cons* #$(file-append guix "/bin/guix-daemon") + "--build-users-group" #$build-group + "--max-silent-time" #$(number->string max-silent-time) + "--timeout" #$(number->string timeout) + "--log-compression" #$(symbol->string log-compression) + #$@(if use-substitutes? + '() + '("--no-substitutes")) + "--substitute-urls" #$(string-join substitute-urls) + #$@extra-options + + ;; Add CHROOT-DIRECTORIES and all their dependencies (if + ;; these are store items) to the chroot. + (append-map (lambda (file) + (append-map (lambda (directory) + (list "--chroot-directory" + directory)) + (call-with-input-file file + read))) + '#$(map references-file chroot-directories))) #:environment-variables (list #$@(if http-proxy @@ -1514,6 +1528,24 @@ failed to register hydra.gnu.org public key: ~a~%" status)))))))) #$@(map (cut hydra-key-authorization <> guix) keys)) #~#f)))) +(define* (references-file item #:optional (name "references")) + "Return a file that contains the list of references of ITEM." + (if (struct? item) ;lowerable object + (computed-file name + (with-imported-modules (source-module-closure + '((guix build store-copy))) + #~(begin + (use-modules (guix build store-copy)) + + (call-with-output-file #$output + (lambda (port) + (write (call-with-input-file "graph" + read-reference-graph) + port))))) + #:options `(#:local-build? #f + #:references-graphs (("graph" ,item)))) + (plain-file name "()"))) + (define guix-service-type (service-type (name 'guix) @@ -1523,6 +1555,16 @@ failed to register hydra.gnu.org public key: ~a~%" status)))))))) (service-extension activation-service-type guix-activation) (service-extension profile-service-type (compose list guix-configuration-guix)))) + + ;; Extensions can specify extra directories to add to the build chroot. + (compose concatenate) + (extend (lambda (config directories) + (guix-configuration + (inherit config) + (chroot-directories + (append (guix-configuration-chroot-directories config) + directories))))) + (default-value (guix-configuration)) (description "Run the build daemon of GNU@tie{}Guix, aka. @command{guix-daemon}."))) -- 2.15.1