From mboxrd@z Thu Jan 1 00:00:00 1970 From: ludo@gnu.org (Ludovic =?utf-8?Q?Court=C3=A8s?=) Subject: Re: [PATCH] system: container: Update to new service API. Date: Tue, 27 Oct 2015 14:22:47 +0100 Message-ID: <87k2q8v42g.fsf@gnu.org> References: <87611txiw7.fsf@izanagi.i-did-not-set--mail-host-address--so-tickle-me> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:57939) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Zr4DH-0003OG-RZ for guix-devel@gnu.org; Tue, 27 Oct 2015 09:23:01 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Zr4DC-0002CB-V1 for guix-devel@gnu.org; Tue, 27 Oct 2015 09:22:55 -0400 In-Reply-To: (David Thompson's message of "Mon, 26 Oct 2015 20:21:24 -0400") List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org To: "Thompson, David" Cc: guix-devel --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Sorry, I meant to preserve #:container? behavior but I forgot this bit. I believe the attached patch provides an Even Greater Way to address the problem, namely by making the modprobe/firmware thing an optional service. Could you try and report back? I tried it in a VM and there=E2=80=99s no regression. Besides, we=E2=80=99ll have to make sure =E2=80=98guix system extension-gra= ph=E2=80=99 honors --container. Ludo=E2=80=99. --=-=-= Content-Type: text/x-patch Content-Disposition: inline diff --git a/gnu/services.scm b/gnu/services.scm index d0fe0ad..a02d79e 100644 --- a/gnu/services.scm +++ b/gnu/services.scm @@ -62,6 +62,7 @@ boot-service-type activation-service-type activation-service->script + %linux-bare-metal-service etc-service-type etc-directory setuid-program-service-type @@ -202,20 +203,6 @@ file." (union-build #$output '#$things)) #:modules '((guix build union)))))) -(define (modprobe-wrapper) - "Return a wrapper for the 'modprobe' command that knows where modules live. - -This wrapper is typically invoked by the Linux kernel ('call_modprobe', in -kernel/kmod.c), a situation where the 'LINUX_MODULE_DIRECTORY' environment -variable is not set---hence the need for this wrapper." - (let ((modprobe "/run/current-system/profile/bin/modprobe")) - (gexp->script "modprobe" - #~(begin - (setenv "LINUX_MODULE_DIRECTORY" - "/run/booted-system/kernel/lib/modules") - (apply execl #$modprobe - (cons #$modprobe (cdr (command-line)))))))) - (define* (activation-service->script service) "Return as a monadic value the activation script for SERVICE, a service of ACTIVATION-SCRIPT-TYPE." @@ -240,8 +227,7 @@ ACTIVATION-SCRIPT-TYPE." (mlet* %store-monad ((actions (service-activations)) (modules (imported-modules %modules)) - (compiled (compiled-modules %modules)) - (modprobe (modprobe-wrapper))) + (compiled (compiled-modules %modules))) (gexp->file "activate" #~(begin (eval-when (expand load eval) @@ -256,12 +242,6 @@ ACTIVATION-SCRIPT-TYPE." (activate-/bin/sh (string-append #$(canonical-package bash) "/bin/sh")) - ;; Tell the kernel to use our 'modprobe' command. - (activate-modprobe #$modprobe) - - ;; Let users debug their own processes! - (activate-ptrace-attach) - ;; Run the services' activation snippets. ;; TODO: Use 'load-compiled'. (for-each primitive-load '#$actions) @@ -287,6 +267,41 @@ ACTIVATION-SCRIPT-TYPE." ;; receives. (service activation-service-type #t)) +(define %modprobe-wrapper + ;; Wrapper for the 'modprobe' command that knows where modules live. + ;; + ;; This wrapper is typically invoked by the Linux kernel ('call_modprobe', + ;; in kernel/kmod.c), a situation where the 'LINUX_MODULE_DIRECTORY' + ;; environment variable is not set---hence the need for this wrapper. + (let ((modprobe "/run/current-system/profile/bin/modprobe")) + (program-file "modprobe" + #~(begin + (setenv "LINUX_MODULE_DIRECTORY" + "/run/booted-system/kernel/lib/modules") + (apply execl #$modprobe + (cons #$modprobe (cdr (command-line)))))))) + +(define %linux-kernel-activation + ;; Activation of the Linux kernel running on the bare metal (as opposed to + ;; running in a container.) + #~(begin + ;; Tell the kernel to use our 'modprobe' command. + (activate-modprobe #$%modprobe-wrapper) + + ;; Let users debug their own processes! + (activate-ptrace-attach))) + +(define linux-bare-metal-service-type + (service-type (name 'linux-bare-metal) + (extensions + (list (service-extension activation-service-type + (const %linux-kernel-activation)))))) + +(define %linux-bare-metal-service + ;; The service that does things that are needed on the "bare metal", but not + ;; necessary or impossible in a container. + (service linux-bare-metal-service-type #f)) + (define (etc-directory service) "Return the directory for SERVICE, a service of type ETC-SERVICE-TYPE." (files->etc-directory (service-parameters service))) diff --git a/gnu/system.scm b/gnu/system.scm index aa76882..de85156 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -290,7 +290,8 @@ a container or that of a \"bare metal\" system." ;; container. (if container? '() - (list (service firmware-service-type + (list %linux-bare-metal-service + (service firmware-service-type (operating-system-firmware os)))))))) (define* (operating-system-services os #:key container?) --=-=-=--