From cd6f6c22fb581e5ef2aa88f5e9c14a4c54a071c3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 28 Oct 2015 21:36:07 +0100 Subject: services: Add 'modify-services'. * gnu/services.scm (%modify-service, modify-services): New macros. * gnu/services/base.scm (mingetty-service-type, guix-service-type): Export. * emacs/guix-devel.el (guix-devel-keywords): Add 'modify-services'. Ditto in 'guix-devel-scheme-indent' call. * doc/guix.texi (Using the Configuration System): Give an example of 'modify-services'. (Service Reference): Document it. --- gnu/services.scm | 42 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) (limited to 'gnu/services.scm') diff --git a/gnu/services.scm b/gnu/services.scm index d0fe0ade17..818252386f 100644 --- a/gnu/services.scm +++ b/gnu/services.scm @@ -48,6 +48,7 @@ service-kind service-parameters + modify-services service-back-edges fold-services @@ -133,6 +134,47 @@ (parameters service-parameters)) +(define-syntax %modify-service + (syntax-rules (=>) + ((_ service) + service) + ((_ svc (kind param => exp ...) clauses ...) + (if (eq? (service-kind svc) kind) + (let ((param (service-parameters svc))) + (service (service-kind svc) + (begin exp ...))) + (%modify-service svc clauses ...))))) + +(define-syntax modify-services + (syntax-rules () + "Modify the services listed in SERVICES according to CLAUSES. Each clause +must have the form: + + (TYPE VARIABLE => BODY) + +where TYPE is a service type, such as 'guix-service-type', and VARIABLE is an +identifier that is bound within BODY to the value of the service of that +TYPE. Consider this example: + + (modify-services %base-services + (guix-service-type config => + (guix-configuration + (inherit config) + (use-substitutes? #f) + (extra-options '(\"--gc-keep-derivations\")))) + (mingetty-service-type config => + (mingetty-configuration + (inherit config) + (motd (plain-file \"motd\" \"Hi there!\"))))) + +It changes the configuration of the GUIX-SERVICE-TYPE instance, and that of +all the MINGETTY-SERVICE-TYPE instances. + +This is a shorthand for (map (lambda (svc) ...) %base-services)." + ((_ services clauses ...) + (map (lambda (service) + (%modify-service service clauses ...)) + services)))) ;;; -- cgit v1.2.3 From a241a7ac65358628aecd4e8d4905cc3b66aa894c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 29 Oct 2015 22:20:57 +0100 Subject: 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(-) (limited to 'gnu/services.scm') 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?) -- cgit v1.2.3