aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-10-29 22:20:57 +0100
committerLudovic Courtès <ludo@gnu.org>2015-10-29 23:03:08 +0100
commita241a7ac65358628aecd4e8d4905cc3b66aa894c (patch)
treec5f96a720ffd079a252f0b20cbe48ec3eefcacf5
parent12f92e38d7b7add735b0cfe9a09a27c99d6f9977 (diff)
downloadguix-a241a7ac65358628aecd4e8d4905cc3b66aa894c.tar
guix-a241a7ac65358628aecd4e8d4905cc3b66aa894c.tar.gz
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.
-rw-r--r--gnu/services.scm59
-rw-r--r--gnu/system.scm3
2 files changed, 39 insertions, 23 deletions
diff --git a/gnu/services.scm b/gnu/services.scm
index 818252386f..c8a2a2604f 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 37d6d075c5..3d570c0d1f 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?)