diff options
author | Ludovic Courtès <ludo@gnu.org> | 2014-05-10 23:33:52 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2014-05-10 23:33:52 +0200 |
commit | 023f391c7860d21aee9e9b3e601d7a81bb5d128d (patch) | |
tree | e4567181f1bd1a1a14fa646501503794a68c3f8d /gnu/services/base.scm | |
parent | 23ed63a12d941ad836f3fc9902ba4f145db1975c (diff) | |
download | patches-023f391c7860d21aee9e9b3e601d7a81bb5d128d.tar patches-023f391c7860d21aee9e9b3e601d7a81bb5d128d.tar.gz |
services: Add 'file-system-service'.
* gnu/services/base.scm (file-system-service): New procedure.
(user-processes-service): Add 'requirements' parameter.
* gnu/services/dmd.scm (dmd-configuration-file): Use (guix build
linux-initrd).
* guix/build/linux-initrd.scm (guix): Export 'check-file-system'.
* gnu/system.scm (file-union): New procedure.
(essential-services): Use it. Add that to the returned list.
Diffstat (limited to 'gnu/services/base.scm')
-rw-r--r-- | gnu/services/base.scm | 30 |
1 files changed, 28 insertions, 2 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm index e0f2888ee0..6431a3aaba 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -30,6 +30,7 @@ #:use-module (srfi srfi-26) #:use-module (ice-9 format) #:export (root-file-system-service + file-system-service user-processes-service host-name-service mingetty-service @@ -87,19 +88,44 @@ This service must be the root of the service dependency graph so that its #f))))) (respawn? #f))))) -(define* (user-processes-service #:key (grace-delay 2)) +(define* (file-system-service device target type + #:key (check? #t) options) + "Return a service that mounts DEVICE on TARGET as a file system TYPE with +OPTIONS. When CHECK? is true, check the file system before mounting it." + (with-monad %store-monad + (return + (service + (provision (list (symbol-append 'file-system- (string->symbol target)))) + (requirement '(root-file-system)) + (documentation "Check, mount, and unmount the given file system.") + (start #~(lambda args + #$(if check? + #~(check-file-system #$device #$type) + #~#t) + (mount #$device #$target #$type 0 #$options) + #t)) + (stop #~(lambda args + ;; Normally there are no processes left at this point, so + ;; TARGET can be safely unmounted. + (umount #$target) + #f)))))) + +(define* (user-processes-service requirements #:key (grace-delay 2)) "Return the service that is responsible for terminating all the processes so that the root file system can be re-mounted read-only, just before rebooting/halting. Processes still running GRACE-DELAY seconds after SIGTERM has been sent are terminated with SIGKILL. +The returned service will depend on 'root-file-system' and on all the services +listed in REQUIREMENTS. + All the services that spawn processes must depend on this one so that they are stopped before 'kill' is called." (with-monad %store-monad (return (service (documentation "When stopped, terminate all user processes.") (provision '(user-processes)) - (requirement '(root-file-system)) + (requirement (cons 'root-file-system requirements)) (start #~(const #t)) (stop #~(lambda _ ;; When this happens, all the processes have been |