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.

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index e0f2888..6431a3a 100644 (file)
--- 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 8d4c483..0d17285 100644 (file)
--- 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 491e0ed..d76c367 100644 (file)
--- 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

diff --git a/guix/build/linux-initrd.scm b/guix/build/linux-initrd.scm
index 83636df..0c3b2f0 100644 (file)
--- a/guix/build/linux-initrd.scm
+++ b/guix/build/linux-initrd.scm
@@ -30,6 +30,7 @@
             linux-command-line
             make-essential-device-nodes
             configure-qemu-networking
+            check-file-system
             mount-file-system
             bind-mount
             load-linux-module*