02/02: services: Add 'linux-bare-metal-service-type'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit a241a7ac65358628aecd4e8d4905cc3b66aa894c
Author: Ludovic Courtès <address@hidden>
Date:   Thu Oct 29 22:20:57 2015 +0100

    services: Add 'linux-bare-metal-service-type'.
    
    * gnu/services.scm (modprobe-wrapper): Remove.
      (activation-script): Do not use it.  Remove calls to
      'activate-modprobe' and 'activate-ptrace-attach' in gexp.
      (%modprobe-wrapper, %linux-kernel-activation,
      linux-bare-metal-service-type, %linux-bare-metal-service): New
      variables.
    * gnu/system.scm (essential-services): Add %LINUX-BARE-METAL-SERVICE to
      the list, unless CONTAINER? is true.
---
 gnu/services.scm |   59 +++++++++++++++++++++++++++++++++--------------------
 gnu/system.scm   |    3 +-
 2 files changed, 39 insertions(+), 23 deletions(-)

diff --git a/gnu/services.scm b/gnu/services.scm
index 8182523..c8a2a26 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -63,6 +63,7 @@
             boot-service-type
             activation-service-type
             activation-service->script
+            %linux-bare-metal-service
             etc-service-type
             etc-directory
             setuid-program-service-type
@@ -244,20 +245,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."
@@ -282,8 +269,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)
@@ -298,12 +284,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)
@@ -329,6 +309,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 37d6d07..3d570c0 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -287,7 +287,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?)