[bug#45643] [PATCH 2/3] gnu: Make 'file-systems' target extensible.

[raid5atemyhomework via Guix-patches via <guix-patches@gnu.org>]

From fc4538963960550b678713ec46ac461cfbd6173e Mon Sep 17 00:00:00 2001
From: raid5atemyhomework <raid5atemyhomework@protonmail.com>
Date: Sun, 3 Jan 2021 21:09:02 +0800
Subject: [PATCH 2/3] gnu: Make 'file-systems' target extensible.

This is to support something like ZFS, which has a service that mounts
ZFS file systems and does not normally use /etc/fstab
---
 doc/guix.texi                 |  9 +++++++--
 gnu/services/base.scm         | 37 +++++++++++++++++++++++++----------
 gnu/services/file-systems.scm |  5 +++--
 3 files changed, 37 insertions(+), 14 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 5ad3907dbe..4544b481b0 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -13982,8 +13982,13 @@ mount ZFS pools that have a non-@code{legacy} mountpoint. If ZFS
 finds mountable ZFS filesystems that are encrypted by passphrase, it
 will prompt for passphrases on the console.

-ZFS as root filesystem is not supported yet. ZFS for @code{/home} is
-also probably not easily doable yet.
+You can put @code{/home} on a ZFS filesystem by setting it as the
+mountpoint of some ZFS filesystem. However, ZFS will refuse to mount
+onto a non-empty directory, so if you already have an existing
+@code{/home} you have to remove all files in it, then reboot to let
+ZFS mount into @code{/home}.
+
+ZFS as root filesystem is not supported yet.

 @node Mapped Devices
 @section Mapped Devices
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 945b546607..deffd49154 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -66,6 +66,7 @@
                %default-substitute-urls)
   #:export (fstab-service-type
             root-file-system-service
+            file-systems-service-type
             file-system-service-type
             swap-service
             host-name-service
@@ -362,18 +363,30 @@ FILE-SYSTEM."
                        (gnu system file-systems)
                        ,@%default-modules)))))))

+(define (file-systems-service requirements)
+  (list
+    (shepherd-service
+     (provision '(file-systems))
+     (requirement (cons* 'root-file-system 'user-file-systems requirements))
+     (documentation "Target for all the initially-mounted file systems")
+     (start #~(const #t))
+     (stop #~(const #t)))))
+
+(define file-systems-service-type
+  (service-type
+    (name 'file-systems)
+    (extensions (list (service-extension shepherd-root-service-type
+                                         file-systems-service)))
+    (compose concatenate)
+    (extend append)
+    ;; Extensions can add new services to this list.
+    (default-value '())
+    (description "The @code{file-systems} service is the target that is started
+when all file systems have been mounted.")))
+
 (define (file-system-shepherd-services file-systems)
   "Return the list of Shepherd services for FILE-SYSTEMS."
   (let* ((file-systems (filter file-system-mount? file-systems)))
-    (define sink
-      (shepherd-service
-       (provision '(file-systems))
-       (requirement (cons* 'root-file-system 'user-file-systems
-                           (map file-system->shepherd-service-name
-                                file-systems)))
-       (documentation "Target for all the initially-mounted file systems")
-       (start #~(const #t))
-       (stop #~(const #f))))

     (define known-mount-points
       (map file-system-mount-point file-systems))
@@ -403,7 +416,7 @@ FILE-SYSTEM."
                            (filter (negate known?) (mount-points)))
                  #f))))

-    (cons* sink user-unmount
+    (cons* user-unmount
            (map file-system-shepherd-service file-systems))))

 (define (file-system-fstab-entries file-systems)
@@ -431,6 +444,10 @@ FILE-SYSTEM."
                        (service-extension fstab-service-type
                                           file-system-fstab-entries)

+                       ;; Have 'file-systems' depend on each file-system
+                       (service-extension file-systems-service-type
+                                          (cut map file-system->shepherd-service-name <>))
+
                        ;; Have 'user-processes' depend on 'file-systems'.
                        (service-extension user-processes-service-type
                                           (const '(file-systems)))))
diff --git a/gnu/services/file-systems.scm b/gnu/services/file-systems.scm
index bdc33f4028..73a6d52538 100644
--- a/gnu/services/file-systems.scm
+++ b/gnu/services/file-systems.scm
@@ -19,6 +19,7 @@
 (define-module (gnu services file-systems)
   #:use-module (guix gexp)
   #:use-module (gnu services)
+  #:use-module (gnu services base)
   #:use-module (gnu services shepherd))

 ;;; ZFS
@@ -28,7 +29,7 @@
       (shepherd-service
        (documentation "Load ZFS kernel module and import ZFS pools.")
        (provision '(zfs-loader))
-       (requirement '(file-systems))
+       (requirement '(root-file-system))
        (one-shot? #t)
        (modules `((srfi srfi-1)
                   (srfi srfi-34)
@@ -68,5 +69,5 @@
    (description "Load ZFS kernel module and import ZFS pools.")
    (extensions
     (list (service-extension shepherd-root-service-type zfs-loader-shepherd-service)
-          (service-extension user-processes-service-type (const '(zfs-loader)))))))
+          (service-extension file-systems-service-type (const '(zfs-loader)))))))

--
2.29.2