summary refs log tree commit diff
path: root/gnu/services/base.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-05-10 23:33:52 +0200
committerLudovic Courtès <ludo@gnu.org>2014-05-10 23:33:52 +0200
commit023f391c7860d21aee9e9b3e601d7a81bb5d128d (patch)
treee4567181f1bd1a1a14fa646501503794a68c3f8d /gnu/services/base.scm
parent23ed63a12d941ad836f3fc9902ba4f145db1975c (diff)
downloadguix-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.scm30
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