aboutsummaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
Diffstat (limited to 'gnu')
-rw-r--r--gnu/services/base.scm30
-rw-r--r--gnu/services/dmd.scm8
-rw-r--r--gnu/system.scm30
3 files changed, 59 insertions, 9 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)
diff --git a/gnu/system.scm b/gnu/system.scm
index 491e0ed7ae..d76c3670f0 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -184,15 +184,35 @@ file."
(gexp->derivation name builder))
+(define (other-file-system-services os)
+ "Return file system services for the file systems of OS that are not marked
+as 'needed-for-boot'."
+ (define file-systems
+ (remove (lambda (fs)
+ (or (file-system-needed-for-boot? fs)
+ (string=? "/" (file-system-mount-point fs))))
+ (operating-system-file-systems os)))
+
+ (sequence %store-monad
+ (map (match-lambda
+ (($ <file-system> device target type flags opts #f check?)
+ (file-system-service device target type
+ #:check? check?
+ #:options opts)))
+ file-systems)))
+
(define (essential-services os)
"Return the list of essential services for OS. These are special services
that implement part of what's declared in OS are responsible for low-level
bookkeeping."
- (mlet %store-monad ((procs (user-processes-service))
- (root-fs (root-file-system-service))
- (host-name (host-name-service
- (operating-system-host-name os))))
- (return (list host-name procs root-fs))))
+ (mlet* %store-monad ((root-fs (root-file-system-service))
+ (other-fs (other-file-system-services os))
+ (procs (user-processes-service
+ (map (compose first service-provision)
+ other-fs)))
+ (host-name (host-name-service
+ (operating-system-host-name os))))
+ (return (cons* host-name procs root-fs other-fs))))
(define (operating-system-services os)
"Return all the services of OS, including \"internal\" services that do not