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.
This commit is contained in:
Ludovic Courtès 2015-10-29 22:20:57 +01:00
parent 12f92e38d7
commit a241a7ac65
2 changed files with 39 additions and 23 deletions

View File

@ -63,6 +63,7 @@
boot-service-type boot-service-type
activation-service-type activation-service-type
activation-service->script activation-service->script
%linux-bare-metal-service
etc-service-type etc-service-type
etc-directory etc-directory
setuid-program-service-type setuid-program-service-type
@ -244,20 +245,6 @@ file."
(union-build #$output '#$things)) (union-build #$output '#$things))
#:modules '((guix build union)))))) #: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) (define* (activation-service->script service)
"Return as a monadic value the activation script for SERVICE, a service of "Return as a monadic value the activation script for SERVICE, a service of
ACTIVATION-SCRIPT-TYPE." ACTIVATION-SCRIPT-TYPE."
@ -282,8 +269,7 @@ ACTIVATION-SCRIPT-TYPE."
(mlet* %store-monad ((actions (service-activations)) (mlet* %store-monad ((actions (service-activations))
(modules (imported-modules %modules)) (modules (imported-modules %modules))
(compiled (compiled-modules %modules)) (compiled (compiled-modules %modules)))
(modprobe (modprobe-wrapper)))
(gexp->file "activate" (gexp->file "activate"
#~(begin #~(begin
(eval-when (expand load eval) (eval-when (expand load eval)
@ -298,12 +284,6 @@ ACTIVATION-SCRIPT-TYPE."
(activate-/bin/sh (activate-/bin/sh
(string-append #$(canonical-package bash) "/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. ;; Run the services' activation snippets.
;; TODO: Use 'load-compiled'. ;; TODO: Use 'load-compiled'.
(for-each primitive-load '#$actions) (for-each primitive-load '#$actions)
@ -329,6 +309,41 @@ ACTIVATION-SCRIPT-TYPE."
;; receives. ;; receives.
(service activation-service-type #t)) (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) (define (etc-directory service)
"Return the directory for SERVICE, a service of type ETC-SERVICE-TYPE." "Return the directory for SERVICE, a service of type ETC-SERVICE-TYPE."
(files->etc-directory (service-parameters service))) (files->etc-directory (service-parameters service)))

View File

@ -287,7 +287,8 @@ a container or that of a \"bare metal\" system."
;; container. ;; container.
(if container? (if container?
'() '()
(list (service firmware-service-type (list %linux-bare-metal-service
(service firmware-service-type
(operating-system-firmware os)))))))) (operating-system-firmware os))))))))
(define* (operating-system-services os #:key container?) (define* (operating-system-services os #:key container?)