From 4e469051a77d02435eafb1df93224a2ce1bb3146 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Tue, 22 Jul 2014 22:53:36 +0200
Subject: system: Add 'create-mount-point?' file system option.

* gnu/system/file-systems.scm (<file-system>)[create-mount-point?]: New
  field.
* gnu/services/base.scm (file-system-service): Add #:create-mount-point?
  parameter and honor it.
* gnu/system.scm (other-file-system-services): Update
  'file-system-service' call accordingly.
* doc/guix.texi (File Systems): Document it.
---
 doc/guix.texi               | 3 +++
 gnu/services/base.scm       | 9 +++++++--
 gnu/system.scm              | 3 ++-
 gnu/system/file-systems.scm | 6 +++++-
 4 files changed, 17 insertions(+), 4 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 2b05a75be4..a88b546380 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -3054,6 +3054,9 @@ instance, for the root file system.
 This Boolean indicates whether the file system needs to be checked for
 errors before being mounted.
 
+@item @code{create-mount-point?} (default: @code{#f})
+When true, the mount point is created if it does not exist yet.
+
 @end table
 @end deftp
 
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 42e232c9ac..9a67109db0 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -96,11 +96,13 @@ This service must be the root of the service dependency graph so that its
       (respawn? #f)))))
 
 (define* (file-system-service device target type
-                              #:key (check? #t) options (title 'any))
+                              #:key (check? #t) create-mount-point?
+                              options (title 'any))
   "Return a service that mounts DEVICE on TARGET as a file system TYPE with
 OPTIONS.  TITLE is a symbol specifying what kind of name DEVICE is: 'label for
 a partition label, 'device for a device file name, or 'any.  When CHECK? is
-true, check the file system before mounting it."
+true, check the file system before mounting it.  When CREATE-MOUNT-POINT? is
+true, create TARGET if it does not exist yet."
   (with-monad %store-monad
     (return
      (service
@@ -109,6 +111,9 @@ true, check the file system before mounting it."
       (documentation "Check, mount, and unmount the given file system.")
       (start #~(lambda args
                  (let ((device (canonicalize-device-spec #$device '#$title)))
+                   #$(if create-mount-point?
+                         #~(mkdir-p #$target)
+                         #~#t)
                    #$(if check?
                          #~(begin
                              ;; Make sure fsck.ext2 & co. can be found.
diff --git a/gnu/system.scm b/gnu/system.scm
index 20942ec7f0..8c6fc13059 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -181,10 +181,11 @@ as 'needed-for-boot'."
   (sequence %store-monad
             (map (match-lambda
                   (($ <file-system> device title target type flags opts
-                                    #f check?)
+                                    #f check? create?)
                    (file-system-service device target type
                                         #:title title
                                         #:check? check?
+                                        #:create-mount-point? create?
                                         #:options opts)))
                  file-systems)))
 
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 0c2021d7b4..ea8d961317 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -28,6 +28,8 @@
             file-system-needed-for-boot?
             file-system-flags
             file-system-options
+            file-system-check?
+            file-system-create-mount-point?
 
             %fuse-control-file-system
             %binary-format-file-system
@@ -57,7 +59,9 @@
   (needed-for-boot? file-system-needed-for-boot?  ; Boolean
                     (default #f))
   (check?           file-system-check?            ; Boolean
-                    (default #t)))
+                    (default #t))
+  (create-mount-point? file-system-create-mount-point? ; Boolean
+                       (default #f)))
 
 (define %fuse-control-file-system
   ;; Control file system for Linux' file systems in user-space (FUSE).
-- 
cgit v1.2.3