aboutsummaryrefslogtreecommitdiff
path: root/gnu/services
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/base.scm30
-rw-r--r--gnu/services/dmd.scm8
2 files changed, 34 insertions, 4 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
diff --git a/gnu/services/dmd.scm b/gnu/services/dmd.scm
index 8d4c483cc4..0d17285890 100644
--- a/gnu/services/dmd.scm
+++ b/gnu/services/dmd.scm
@@ -34,7 +34,9 @@
"Return the dmd configuration file for SERVICES."
(define modules
;; Extra modules visible to dmd.conf.
- '((guix build syscalls)))
+ '((guix build syscalls)
+ (guix build linux-initrd)
+ (guix build utils)))
(mlet %store-monad ((modules (imported-modules modules))
(compiled (compiled-modules modules)))
@@ -46,7 +48,9 @@
(cons #$compiled %load-compiled-path)))
(use-modules (ice-9 ftw)
- (guix build syscalls))
+ (guix build syscalls)
+ ((guix build linux-initrd)
+ #:select (check-file-system)))
(register-services
#$@(map (lambda (service)