[bug#70542] [PATCH 0/4] Improve Shepherd service support for networked file systems

[bug#70542] [PATCH 0/4] Improve Shepherd service support for networked file systems

[Richard Sent]

Hi Guix!

This patch series aims to improve the experience when using Guix and Shepherd
to manage networked file systems.

Previously, operating-system file-system entries would all be started before
the symbol 'file-systems was provided, which many other Shepherd services
depend on. This meant that adding a networked file-system with (mount? #t)
would (depending on mount-can-fail?) either halt boot due to 'user-processes
(and thus 'networking) not being provisioned, or fail to mount, even though
Guix contained the code to sucessfully mount that file system.

Now, file system entries can specify arbitrary Shepherd symbols that other
services provision. When this is done, that specific file-system entry is not
mounted as part of providing 'file-systems.

I considered adding a (network?) flag to the file-system record instead, but
that wouldn't handle every case (say, if an Avahi .local address was used). So
instead I went with the more general approach.

Prior workarounds were verbose [1] and required creating a custom service
entry. This method allows for reusing code already present in (gnu
services base) and (gnu build file-systems).

I considered splitting CIFS support into its own patch, but since the support
is fairly meaningless without the preceding commits, I figured keeping it was
best.

This patch series resolves https://issues.guix.gnu.org/46563.

Richard Sent (4):
  file-systems: Add requirements field to file-systems
  services: base: Use requirements to delay some file-systems
  file-systems: Add support for mounting CIFS file systems
  system: Do not check for CIFS file system availability

 doc/guix.texi               | 13 ++++++++
 gnu/build/file-systems.scm  | 60 ++++++++++++++++++++++++++++++++-----
 gnu/machine/ssh.scm         |  3 +-
 gnu/services/base.scm       | 16 ++++++++--
 gnu/system/file-systems.scm |  3 ++
 guix/scripts/system.scm     |  3 +-
 6 files changed, 87 insertions(+), 11 deletions(-)


base-commit: 0f68306268773f0eaa4327e1f6fdcb39442e4a34
-- 
2.41.0

[bug#70542] [PATCH 1/4] file-systems: Add requirements field to file-systems

[Richard Sent]

* gnu/system/file-systems.scm (file-system): Add requirements field to the
file-system record. This field will be used for adding additional Shepherd
requirements to a file system Shepherd service.
* doc/guix.texi: Add documentation for file-system requirements.

Change-Id: If0392db03d48e8820aa53df1df482c12ec72e1a5
---
 doc/guix.texi               | 13 +++++++++++++
 gnu/system/file-systems.scm |  3 +++
 2 files changed, 16 insertions(+)

diff --git a/doc/guix.texi b/doc/guix.texi
index 65af136e61..80b24e2de9 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -17751,6 +17751,19 @@ File Systems
 
 Another example is a file system that depends on a mapped device, for
 example for an encrypted partition (@pxref{Mapped Devices}).
+
+@item @code{requirements} (default: @code{'()})
+This is a list of symbols denoting Shepherd requirements that must be
+met before mounting the file system.
+
+As an example, an NFS file system would typically have a requirement for
+@code{networking}.
+
+Typically, file systems are mounted before most other Shepherd services
+are started. However, file systems with a non-empty requirements field
+are mounted after Shepherd services have begun. Any Shepherd service
+that depends on a file system with a non-empty requirements field must
+depend on it directly and not on the generic symbol @code{file-systems}.
 @end table
 @end deftp
 
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index af0567bd3e..76a51a2b69 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -57,6 +57,7 @@ (define-module (gnu system file-systems)
             file-system-repair
             file-system-create-mount-point?
             file-system-dependencies
+            file-system-requirements
             file-system-location
 
             file-system-type-predicate
@@ -185,6 +186,8 @@ (define-record-type* <file-system> file-system
                        (default #f))
   (dependencies     file-system-dependencies      ; list of <file-system>
                     (default '()))                ; or <mapped-device>
+  (requirements     file-system-requirements      ; list of symbols
+                    (default '()))
   (location         file-system-location
                     (default (current-source-location))
                     (innate)))
-- 
2.41.0

[bug#70542] [PATCH 2/4] services: base: Use requirements to delay some file-systems

[Richard Sent]

Add a mechanism to only require a subset of file-system entries during early
Shepherd initialization. Any file-system with additional Shepherd service
requirements (e.g. networking) will be brought up after 'file-systems is
provisioned.

* gnu/services/base.scm (file-system-shepherd-service): Splice
file-system-requirements into the Shepherd service requirement list.
* gnu/services/base.scm (file-system-shepherd-services): Provision
'file-system when file-systems that satisfy initial-file-system?  are started.

Change-Id: I7b1336ee970f4320f7431bef187e66f34f0d718c
---
 gnu/services/base.scm | 16 ++++++++++++++--
 1 file changed, 14 insertions(+), 2 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 3f912225a0..af92b700b4 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -403,6 +403,7 @@ (define (file-system-shepherd-service file-system)
         (create? (file-system-create-mount-point? file-system))
         (mount?  (file-system-mount? file-system))
         (dependencies (file-system-dependencies file-system))
+        (requirements (file-system-requirements file-system))
         (packages (file-system-packages (list file-system))))
     (and (or mount? create?)
          (with-imported-modules (source-module-closure
@@ -411,7 +412,8 @@ (define (file-system-shepherd-service file-system)
             (provision (list (file-system->shepherd-service-name file-system)))
             (requirement `(root-file-system
                            udev
-                           ,@(map dependency->shepherd-service-name dependencies)))
+                           ,@(map dependency->shepherd-service-name dependencies)
+                           ,@requirements))
             (documentation "Check, mount, and unmount the given file system.")
             (start #~(lambda args
                        #$(if create?
@@ -460,12 +462,22 @@ (define (file-system-shepherd-services file-systems)
                                  (or (file-system-mount? x)
                                      (file-system-create-mount-point? x)))
                                file-systems)))
+
+    (define (initial-file-system? file-system)
+      "Return #t if the file system should be mounted initially or #f."
+      ;; File systems with additional Shepherd requirements (e.g. networking)
+      ;; should not be considered initial. Those requirements likely rely on
+      ;; 'file-systems being provisioned.
+      (null? (file-system-requirements file-system)))
+
     (define sink
       (shepherd-service
        (provision '(file-systems))
        (requirement (cons* 'root-file-system 'user-file-systems
                            (map file-system->shepherd-service-name
-                                file-systems)))
+                                ;; Only file systems considered initial should
+                                ;; be required to provision 'file-systems.
+                                (filter initial-file-system? file-systems))))
        (documentation "Target for all the initially-mounted file systems")
        (start #~(const #t))
        (stop #~(const #f))))
-- 
2.41.0

[bug#70542] [PATCH 3/4] file-systems: Add support for mounting CIFS file systems

[Richard Sent]

* gnu/build/file-systems (canonicalize-device-name): Do not attempt to resolve
CIFS formatted device specifications.
* gnu/build/file-systems (mount-file-system): Add (mount-cifs)
and (host-to-ip). Logic for ip/host to ip resolution was duplicated with
mount-nfs, so isolate into a dedicated function.

Change-Id: I522d70a10651ca79533a4fc60b96b884243a3526
---
 gnu/build/file-systems.scm | 60 +++++++++++++++++++++++++++++++++-----
 1 file changed, 53 insertions(+), 7 deletions(-)

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index 78d779f398..ae29b36c4e 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -8,6 +8,7 @@
 ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2022 Oleg Pykhalov <go.wigust@gmail.com>
 ;;; Copyright © 2024 Nicolas Graves <ngraves@ngraves.fr>
+;;; Copyright © 2024 Richard Sent <richard@freakingpenguin.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -37,6 +38,7 @@ (define-module (gnu build file-systems)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 regex)
   #:use-module (system foreign)
   #:autoload   (system repl repl) (start-repl)
   #:use-module (srfi srfi-1)
@@ -1047,8 +1049,11 @@ (define (canonicalize-device-spec spec)
 
   (match spec
     ((? string?)
-     (if (or (string-contains spec ":/") (string=? spec "none"))
-         spec                  ; do not resolve NFS / tmpfs devices
+     (if (or (string-contains spec ":/") ;nfs
+             (and (>= (string-length spec) 2)
+                  (equal? (string-take spec 2) "//")) ;cifs
+             (string=? spec "none"))
+         spec                  ; do not resolve NFS / CIFS / tmpfs devices
          ;; Nothing to do, but wait until SPEC shows up.
          (resolve identity spec identity)))
     ((? file-system-label?)
@@ -1156,6 +1161,14 @@ (define* (mount-file-system fs #:key (root "/root")
                             (repair (file-system-repair fs)))
   "Mount the file system described by FS, a <file-system> object, under ROOT."
 
+  (define* (host-to-ip host #:optional service)
+    "Return the IP address for host, which may be an IP address or a hostname."
+    (let* ((aa (match (getaddrinfo host service) ((x . _) x)))
+           (sa (addrinfo:addr aa))
+           (inet-addr (inet-ntop (sockaddr:fam sa)
+                                 (sockaddr:addr sa))))
+      inet-addr))
+
   (define (mount-nfs source mount-point type flags options)
     (let* ((idx (string-rindex source #\:))
            (host-part (string-take source idx))
@@ -1163,11 +1176,7 @@ (define* (mount-file-system fs #:key (root "/root")
            (host (match (string-split host-part (string->char-set "[]"))
                  (("" h "") h)
                  ((h) h)))
-           (aa (match (getaddrinfo host "nfs") ((x . _) x)))
-           (sa (addrinfo:addr aa))
-           (inet-addr (inet-ntop (sockaddr:fam sa)
-                                 (sockaddr:addr sa))))
-
+           (inet-addr (host-to-ip host "nfs")))
       ;; Mounting an NFS file system requires passing the address
       ;; of the server in the addr= option
       (mount source mount-point type flags
@@ -1176,6 +1185,41 @@ (define* (mount-file-system fs #:key (root "/root")
                             (if options
                                 (string-append "," options)
                                 "")))))
+
+  (define (mount-cifs source mount-point type flags options)
+    ;; Source is of form "//<server-ip-or-host>/<service>"
+    (let* ((regex-match (string-match "//([^/]+)/(.+)" source))
+           (server (match:substring regex-match 1))
+           (share (match:substring regex-match 2))
+           ;; Match ",guest,", ",guest$", "^guest,", or "^guest$," not
+           ;; e.g. user=foo,pass=notaguest
+           (guest? (string-match "(^|,)(guest)($|,)" options))
+           ;; Perform DNS resolution now instead of attempting kernel dns
+           ;; resolver upcalling. /sbin/request-key does not exist and the
+           ;; kernel hardcodes the path.
+           ;;
+           ;; (getaddrinfo) doesn't support cifs service, so omit it.
+           (inet-addr (host-to-ip server)))
+      (mount source mount-point type flags
+             (string-append "ip="
+                            inet-addr
+                            ;; As of Linux af1a3d2ba9 (v5.11) unc is ignored
+                            ;; and source is parsed by the kernel
+                            ;; directly. Pass it for compatibility.
+                            ",unc="
+                            ;; Match format of mount.cifs's mount syscall.
+                            "\\\\" server "\\" share
+                            (if guest?
+                                ",user=,pass="
+                                "")
+                            (if options
+                                ;; No need to delete "guest" from options.
+                                ;; linux/fs/smb/client/fs_context.c explicitly
+                                ;; ignores it. Also, avoiding excess commas
+                                ;; when deleting is a pain.
+                                (string-append "," options)
+                                "")))))
+
   (let* ((type    (file-system-type fs))
          (source  (canonicalize-device-spec (file-system-device fs)))
          (target  (string-append root "/"
@@ -1210,6 +1254,8 @@ (define* (mount-file-system fs #:key (root "/root")
         (cond
          ((string-prefix? "nfs" type)
           (mount-nfs source target type flags options))
+         ((string-prefix? "cifs" type)
+          (mount-cifs source target type flags options))
          ((memq 'shared (file-system-flags fs))
           (mount source target type flags options)
           (mount "none" target #f MS_SHARED))
-- 
2.41.0

[bug#70542] [PATCH 4/4] system: Do not check for CIFS file system availability

[Richard Sent]

* gnu/machine/ssh.scm (machine-check-file-system-availability): Skip checking
for CIFS availability, similar to NFS.
* guix/scripts/system.scm (check-file-system-availability): Likewise.

Change-Id: Ib6452d1b0d3c15028c79b05422ffa317de0a419a
---
 gnu/machine/ssh.scm     | 3 ++-
 guix/scripts/system.scm | 3 ++-
 2 files changed, 4 insertions(+), 2 deletions(-)

diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index b47ce7c225..0be9ebbc0d 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -222,7 +222,8 @@ (define (machine-check-file-system-availability machine)
                    (not (member (file-system-type fs)
                                 %pseudo-file-system-types))
                    ;; Don't try to validate network file systems.
-                   (not (string-prefix? "nfs" (file-system-type fs)))
+                   (not (or (string-prefix? "nfs" (file-system-type fs))
+                            (string-prefix? "cifs" (file-system-type fs))))
                    (not (memq 'bind-mount (file-system-flags fs)))))
             (operating-system-file-systems (machine-operating-system machine))))
 
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 2260bcf985..99c58f3812 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -591,7 +591,8 @@ (define (check-file-system-availability file-systems)
                    (not (member (file-system-type fs)
                                 %pseudo-file-system-types))
                    ;; Don't try to validate network file systems.
-                   (not (string-prefix? "nfs" (file-system-type fs)))
+                   (not (or (string-prefix? "nfs" (file-system-type fs))
+                            (string-prefix? "cifs" (file-system-type fs))))
                    (not (memq 'bind-mount (file-system-flags fs)))))
             file-systems))
 
-- 
2.41.0

[bug#70542] Missing reference in cover letter

[Richard Sent]

Oops, forgot to include the link to [1] in the cover letter.

(If you see this Felix, nothing's wrong with your code! :) I just needed
an example of how it's currently done.)

[1] https://lists.gnu.org/archive/html/guix-devel/2024-04/msg00233.html

-- 
Take it easy,
Richard Sent
Making my computer weirder one commit at a time.

[bug#70542] [PATCH 4/4] system: Do not check for CIFS file system availability

[Liliana Marie Prikler]

Am Dienstag, dem 23.04.2024 um 16:47 -0400 schrieb Richard Sent:
> * gnu/machine/ssh.scm (machine-check-file-system-availability): Skip
> checking
> for CIFS availability, similar to NFS.
> * guix/scripts/system.scm (check-file-system-availability): Likewise.
> 
> Change-Id: Ib6452d1b0d3c15028c79b05422ffa317de0a419a
This should probably be done already when adding the CIFS file system.

Cheers

[bug#70542] [PATCH 3/4] file-systems: Add support for mounting CIFS file systems

[Liliana Marie Prikler]

Am Dienstag, dem 23.04.2024 um 16:47 -0400 schrieb Richard Sent:
> * gnu/build/file-systems (canonicalize-device-name): Do not attempt
> to resolve CIFS formatted device specifications.
> * gnu/build/file-systems (mount-file-system): Add (mount-cifs)
> and (host-to-ip). Logic for ip/host to ip resolution was duplicated
> with mount-nfs, so isolate into a dedicated function.
You should factor out host-to-ip in a separate patch before adding
mount-cifs.

> Change-Id: I522d70a10651ca79533a4fc60b96b884243a3526
> ---
>  gnu/build/file-systems.scm | 60 +++++++++++++++++++++++++++++++++---
> --
>  1 file changed, 53 insertions(+), 7 deletions(-)
> 
> diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
> index 78d779f398..ae29b36c4e 100644
> --- a/gnu/build/file-systems.scm
> +++ b/gnu/build/file-systems.scm
> @@ -8,6 +8,7 @@
>  ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
>  ;;; Copyright © 2022 Oleg Pykhalov <go.wigust@gmail.com>
>  ;;; Copyright © 2024 Nicolas Graves <ngraves@ngraves.fr>
> +;;; Copyright © 2024 Richard Sent <richard@freakingpenguin.com>
>  ;;;
>  ;;; This file is part of GNU Guix.
>  ;;;
> @@ -37,6 +38,7 @@ (define-module (gnu build file-systems)
>    #:use-module (rnrs bytevectors)
>    #:use-module (ice-9 match)
>    #:use-module (ice-9 rdelim)
> +  #:use-module (ice-9 regex)
>    #:use-module (system foreign)
>    #:autoload   (system repl repl) (start-repl)
>    #:use-module (srfi srfi-1)
> @@ -1047,8 +1049,11 @@ (define (canonicalize-device-spec spec)
>  
>    (match spec
>      ((? string?)
> -     (if (or (string-contains spec ":/") (string=? spec "none"))
> -         spec                  ; do not resolve NFS / tmpfs devices
> +     (if (or (string-contains spec ":/") ;nfs
> +             (and (>= (string-length spec) 2)
> +                  (equal? (string-take spec 2) "//")) ;cifs
> +             (string=? spec "none"))
> +         spec                  ; do not resolve NFS / CIFS / tmpfs
> devices
>           ;; Nothing to do, but wait until SPEC shows up.
>           (resolve identity spec identity)))
>      ((? file-system-label?)
> @@ -1156,6 +1161,14 @@ (define* (mount-file-system fs #:key (root
> "/root")
>                              (repair (file-system-repair fs)))
>    "Mount the file system described by FS, a <file-system> object,
> under ROOT."
>  
> +  (define* (host-to-ip host #:optional service)
> +    "Return the IP address for host, which may be an IP address or a
> hostname."
> +    (let* ((aa (match (getaddrinfo host service) ((x . _) x)))
> +           (sa (addrinfo:addr aa))
> +           (inet-addr (inet-ntop (sockaddr:fam sa)
> +                                 (sockaddr:addr sa))))
> +      inet-addr))
> +
>    (define (mount-nfs source mount-point type flags options)
>      (let* ((idx (string-rindex source #\:))
>             (host-part (string-take source idx))
> @@ -1163,11 +1176,7 @@ (define* (mount-file-system fs #:key (root
> "/root")
>             (host (match (string-split host-part (string->char-set
> "[]"))
>                   (("" h "") h)
>                   ((h) h)))
> -           (aa (match (getaddrinfo host "nfs") ((x . _) x)))
> -           (sa (addrinfo:addr aa))
> -           (inet-addr (inet-ntop (sockaddr:fam sa)
> -                                 (sockaddr:addr sa))))
> -
> +           (inet-addr (host-to-ip host "nfs")))
>        ;; Mounting an NFS file system requires passing the address
>        ;; of the server in the addr= option
>        (mount source mount-point type flags
> @@ -1176,6 +1185,41 @@ (define* (mount-file-system fs #:key (root
> "/root")
>                              (if options
>                                  (string-append "," options)
>                                  "")))))
> +
> +  (define (mount-cifs source mount-point type flags options)
> +    ;; Source is of form "//<server-ip-or-host>/<service>"
> +    (let* ((regex-match (string-match "//([^/]+)/(.+)" source))
> +           (server (match:substring regex-match 1))
> +           (share (match:substring regex-match 2))
> +           ;; Match ",guest,", ",guest$", "^guest,", or "^guest$,"
> not
> +           ;; e.g. user=foo,pass=notaguest
> +           (guest? (string-match "(^|,)(guest)($|,)" options))
> +           ;; Perform DNS resolution now instead of attempting
> kernel dns
> +           ;; resolver upcalling. /sbin/request-key does not exist
> and the
> +           ;; kernel hardcodes the path.
> +           ;;
> +           ;; (getaddrinfo) doesn't support cifs service, so omit
> it.
> +           (inet-addr (host-to-ip server)))
> +      (mount source mount-point type flags
> +             (string-append "ip="
> +                            inet-addr
> +                            ;; As of Linux af1a3d2ba9 (v5.11) unc is
> ignored
> +                            ;; and source is parsed by the kernel
> +                            ;; directly. Pass it for compatibility.
> +                            ",unc="
> +                            ;; Match format of mount.cifs's mount
> syscall.
> +                            "\\\\" server "\\" share
> +                            (if guest?
> +                                ",user=,pass="
> +                                "")
> +                            (if options
> +                                ;; No need to delete "guest" from
> options.
> +                                ;; linux/fs/smb/client/fs_context.c
> explicitly
> +                                ;; ignores it. Also, avoiding excess
> commas
> +                                ;; when deleting is a pain.
> +                                (string-append "," options)
> +                                "")))))
Any reason we ought to solve guest specially?  Let's just assume that
user and pass are always (possibly empty) strings.  If you need to
abstract over it, you could always make a procedure or something.

Cheers

[bug#70542] [PATCH 2/4] services: base: Use requirements to delay some file-systems

[Liliana Marie Prikler]

Am Dienstag, dem 23.04.2024 um 16:47 -0400 schrieb Richard Sent:
> Add a mechanism to only require a subset of file-system entries
> during early
> Shepherd initialization. Any file-system with additional Shepherd
> service
> requirements (e.g. networking) will be brought up after 'file-systems
> is
> provisioned.
> 
> * gnu/services/base.scm (file-system-shepherd-service): Splice
> file-system-requirements into the Shepherd service requirement list.
> * gnu/services/base.scm (file-system-shepherd-services): Provision
> 'file-system when file-systems that satisfy initial-file-system?  are
> started.
> 
> Change-Id: I7b1336ee970f4320f7431bef187e66f34f0d718c
> ---
>  gnu/services/base.scm | 16 ++++++++++++++--
>  1 file changed, 14 insertions(+), 2 deletions(-)
> 
> diff --git a/gnu/services/base.scm b/gnu/services/base.scm
> index 3f912225a0..af92b700b4 100644
> --- a/gnu/services/base.scm
> +++ b/gnu/services/base.scm
> @@ -403,6 +403,7 @@ (define (file-system-shepherd-service file-
> system)
>          (create? (file-system-create-mount-point? file-system))
>          (mount?  (file-system-mount? file-system))
>          (dependencies (file-system-dependencies file-system))
> +        (requirements (file-system-requirements file-system))
>          (packages (file-system-packages (list file-system))))
>      (and (or mount? create?)
>           (with-imported-modules (source-module-closure
> @@ -411,7 +412,8 @@ (define (file-system-shepherd-service file-
> system)
>              (provision (list (file-system->shepherd-service-name
> file-system)))
>              (requirement `(root-file-system
>                             udev
> -                           ,@(map dependency->shepherd-service-name
> dependencies)))
> +                           ,@(map dependency->shepherd-service-name
> dependencies)
> +                           ,@requirements))
>              (documentation "Check, mount, and unmount the given file
> system.")
>              (start #~(lambda args
>                         #$(if create?
> @@ -460,12 +462,22 @@ (define (file-system-shepherd-services file-
> systems)
>                                   (or (file-system-mount? x)
>                                       (file-system-create-mount-
> point? x)))
>                                 file-systems)))
> +
> +    (define (initial-file-system? file-system)
> +      "Return #t if the file system should be mounted initially or
> #f."
> +      ;; File systems with additional Shepherd requirements (e.g.
> networking)
> +      ;; should not be considered initial. Those requirements likely
> rely on
> +      ;; 'file-systems being provisioned.
> +      (null? (file-system-requirements file-system)))
> +
>      (define sink
>        (shepherd-service
>         (provision '(file-systems))
>         (requirement (cons* 'root-file-system 'user-file-systems
>                             (map file-system->shepherd-service-name
> -                                file-systems)))
> +                                ;; Only file systems considered
> initial should
> +                                ;; be required to provision 'file-
> systems.
> +                                (filter initial-file-system? file-
> systems))))
I'd compose null? and file-system-requirements directly in the filter –
that's easier to wrap my head around.
You then also have a little more space to explain why this composition
is done in the first place.

Cheers

[bug#70542] [PATCH 1/4] file-systems: Add requirements field to file-systems

[Liliana Marie Prikler]

Am Dienstag, dem 23.04.2024 um 16:47 -0400 schrieb Richard Sent:
> * gnu/system/file-systems.scm (file-system): Add requirements field
> to the
> file-system record. This field will be used for adding additional
> Shepherd
> requirements to a file system Shepherd service.
> * doc/guix.texi: Add documentation for file-system requirements.
> 
> Change-Id: If0392db03d48e8820aa53df1df482c12ec72e1a5
> ---
>  doc/guix.texi               | 13 +++++++++++++
>  gnu/system/file-systems.scm |  3 +++
>  2 files changed, 16 insertions(+)
> 
> diff --git a/doc/guix.texi b/doc/guix.texi
> index 65af136e61..80b24e2de9 100644
> --- a/doc/guix.texi
> +++ b/doc/guix.texi
> @@ -17751,6 +17751,19 @@ File Systems
>  
>  Another example is a file system that depends on a mapped device,
> for
>  example for an encrypted partition (@pxref{Mapped Devices}).
> +
> +@item @code{requirements} (default: @code{'()})
> +This is a list of symbols denoting Shepherd requirements that must
> be
> +met before mounting the file system.
> +
> +As an example, an NFS file system would typically have a requirement
> for
> +@code{networking}.
> +
> +Typically, file systems are mounted before most other Shepherd
> services
> +are started. However, file systems with a non-empty requirements
> field
> +are mounted after Shepherd services have begun. Any Shepherd service
> +that depends on a file system with a non-empty requirements field
> must
> +depend on it directly and not on the generic symbol @code{file-
> systems}.
>  @end table
>  @end deftp
>  
> diff --git a/gnu/system/file-systems.scm b/gnu/system/file-
> systems.scm
> index af0567bd3e..76a51a2b69 100644
> --- a/gnu/system/file-systems.scm
> +++ b/gnu/system/file-systems.scm
> @@ -57,6 +57,7 @@ (define-module (gnu system file-systems)
>              file-system-repair
>              file-system-create-mount-point?
>              file-system-dependencies
> +            file-system-requirements
>              file-system-location
>  
>              file-system-type-predicate
> @@ -185,6 +186,8 @@ (define-record-type* <file-system> file-system
>                         (default #f))
>    (dependencies     file-system-dependencies      ; list of <file-
> system>
>                      (default '()))                ; or <mapped-
> device>
> +  (requirements     file-system-requirements      ; list of symbols
> +                    (default '()))
>    (location         file-system-location
>                      (default (current-source-location))
>                      (innate)))
LGTM, could possibly be merged with 2/4 if others agree.

Cheers

[bug#70542] [PATCH 3/4] file-systems: Add support for mounting CIFS file systems

[Richard Sent]

Hi!

Thanks for the feedback! :)

> Any reason we ought to solve guest specially? Let's just assume that
> user and pass are always (possibly empty) strings. If you need to
> abstract over it, you could always make a procedure or something.

My reason for handling guest specifically is to try and match the
behavior of the userspace "mount.cifs" program as much as possible. That
program will parse options, and if it encounters the option "guest",
silently replace it with "user=,pass=" before initiating the mount
system call.

The kernel driver itself ignores the "guest" option, so unless we handle
it ourselves by inserting blank user and pass options, it wouldn't have
an effect.

If I understand what you're saying, we could have user and pass
variables that default to "" unless options includes e.g.
user=foo,pass=bar. That would diverge from mount.cifs's behavior though,
which is something I'm reluctant to do.

I don't know if not passing user or pass is identical to passing
user=,pass=, but if it's not then users would get confused reading
mount.cifs's documentation and trying to apply the same logic to their
OS declaration.

-- 
Take it easy, Richard Sent Making my computer weirder one commit at a
time.

[bug#70542] [PATCH 3/4] file-systems: Add support for mounting CIFS file systems

[Liliana Marie Prikler]

Am Mittwoch, dem 24.04.2024 um 14:22 -0400 schrieb Richard Sent:
> Hi!
> 
> Thanks for the feedback! :)
> 
> > Any reason we ought to solve guest specially? Let's just assume
> > that user and pass are always (possibly empty) strings. If you need
> > to abstract over it, you could always make a procedure or
> > something.
> 
> My reason for handling guest specifically is to try and match the
> behavior of the userspace "mount.cifs" program as much as possible.
> That program will parse options, and if it encounters the option
> "guest", silently replace it with "user=,pass=" before initiating the
> mount system call.
> 
> The kernel driver itself ignores the "guest" option, so unless we
> handle it ourselves by inserting blank user and pass options, it
> wouldn't have an effect.
> 
> If I understand what you're saying, we could have user and pass
> variables that default to "" unless options includes e.g.
> user=foo,pass=bar. That would diverge from mount.cifs's behavior
> though, which is something I'm reluctant to do.
> 
> I don't know if not passing user or pass is identical to passing
> user=,pass=, but if it's not then users would get confused reading
> mount.cifs's documentation and trying to apply the same logic to
> their OS declaration.
I'm rarely that deep in our interaction with file systems, but do we go
through mount or do directly talk to the kernel driver?  If we do
mount.cifs under the hood, this should not be an issue.  Otherwise, we
should do our best to document this behaviour.  I assume that
specifying neither user nor guest would result in an error, but you're
welcome to discover bugs^Wfresh new features.

Cheers

[bug#70542] [PATCH 3/4] file-systems: Add support for mounting CIFS file systems

[Richard Sent]

> I'm rarely that deep in our interaction with file systems

Haha, join the club!

> do we go through mount or do directly talk to the kernel driver? If we
> do mount.cifs under the hood, this should not be an issue. Otherwise,
> we should do our best to document this behaviour.

mount-file-system uses the mount system call under the hood, no
userspace tooling as far as I can tell. See mount in (guix build
syscalls). Unfortunately this means we need to replicate the userspace
mount.cifs program's behavior for handling the guest option.

This would definitely be easier (and probably compatible with more file
systems) if we used the standard userspace tools, but I don't think
there's a good way to do that at present.

My hope is that if we match mount.cifs's behavior in how we handle the
guest option (adding user=,pass=), we won't need extra documentation
explaining CIFS file system options. Users would just follow
mount.cifs's documentation (which is probably what they'd find first).
To my knowledge the patch's current behavior w.r.t. guest matches
mount.cifs.

If we were to implement our own divergent behavior from mount.cifs, then
we would need to document that divergence. But I don't think we need to
document that our behavior matches the mount.cifs program's behavior.

(Or, if we do, it should probably be a more general statement like "File
system options are passed to the mount system call, with slight
adjustments to match the userspace mount.<type> equivalent program's
behavior." Something akin to that, but it's not specifically a CIFS
thing.)

> I assume that specifying neither user nor guest would result in an
> error, but you're welcome to discover bugs^Wfresh new features.

I think I'd be content with calling that "user error". If mount.cifs
doesn't do anything special, neither should we. ;)

-- 
Take it easy,
Richard Sent
Making my computer weirder one commit at a time.

[bug#70542] [PATCH v2 1/3] services: base: Add optional delayed mount of file-systems

[Richard Sent]

Add a mechanism to only require mounting a subset of file-system entries
during early Shepherd initialization. Any file-system with additional Shepherd
service requirements (e.g. networking) is not required to provision
'file-systems.

* gnu/services/base.scm (file-system-shepherd-service): Splice
file-system-requirements into the Shepherd service requirement list.
* gnu/services/base.scm (file-system-shepherd-services): Provision
'file-system only when file system services without additional Shepherd
requirements are started.
* gnu/system/file-systems.scm (file-system): Add requirements field to the
file-system record. This field is used for adding additional Shepherd
requirements to a file-system Shepherd service.
* doc/guix.texi: Add documentation for file-system requirements.

Change-Id: If0392db03d48e8820aa53df1df482c12ec72e1a5
---
 doc/guix.texi               | 13 +++++++++++++
 gnu/services/base.scm       | 14 ++++++++++++--
 gnu/system/file-systems.scm |  3 +++
 3 files changed, 28 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 3ee9f54773..5c89e2110f 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -17750,6 +17750,19 @@ File Systems
 
 Another example is a file system that depends on a mapped device, for
 example for an encrypted partition (@pxref{Mapped Devices}).
+
+@item @code{requirements} (default: @code{'()})
+This is a list of symbols denoting Shepherd requirements that must be
+met before mounting the file system.
+
+As an example, an NFS file system would typically have a requirement for
+@code{networking}.
+
+Typically, file systems are mounted before most other Shepherd services
+are started. However, file systems with a non-empty requirements field
+are mounted after Shepherd services have begun. Any Shepherd service
+that depends on a file system with a non-empty requirements field must
+depend on it directly and not on the generic symbol @code{file-systems}.
 @end table
 @end deftp
 
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 3f912225a0..4fd946c4aa 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -403,6 +403,7 @@ (define (file-system-shepherd-service file-system)
         (create? (file-system-create-mount-point? file-system))
         (mount?  (file-system-mount? file-system))
         (dependencies (file-system-dependencies file-system))
+        (requirements (file-system-requirements file-system))
         (packages (file-system-packages (list file-system))))
     (and (or mount? create?)
          (with-imported-modules (source-module-closure
@@ -411,7 +412,8 @@ (define (file-system-shepherd-service file-system)
             (provision (list (file-system->shepherd-service-name file-system)))
             (requirement `(root-file-system
                            udev
-                           ,@(map dependency->shepherd-service-name dependencies)))
+                           ,@(map dependency->shepherd-service-name dependencies)
+                           ,@requirements))
             (documentation "Check, mount, and unmount the given file system.")
             (start #~(lambda args
                        #$(if create?
@@ -460,12 +462,20 @@ (define (file-system-shepherd-services file-systems)
                                  (or (file-system-mount? x)
                                      (file-system-create-mount-point? x)))
                                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)))
+                                ;; Do not require file systems with Shepherd
+                                ;; requirements to provision
+                                ;; 'file-systems. Many Shepherd services
+                                ;; require 'file-systems, so we would likely
+                                ;; deadlock.
+                                (filter (lambda (file-system)
+                                          (null? (file-system-requirements file-system)))
+                                        file-systems))))
        (documentation "Target for all the initially-mounted file systems")
        (start #~(const #t))
        (stop #~(const #f))))
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index af0567bd3e..76a51a2b69 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -57,6 +57,7 @@ (define-module (gnu system file-systems)
             file-system-repair
             file-system-create-mount-point?
             file-system-dependencies
+            file-system-requirements
             file-system-location
 
             file-system-type-predicate
@@ -185,6 +186,8 @@ (define-record-type* <file-system> file-system
                        (default #f))
   (dependencies     file-system-dependencies      ; list of <file-system>
                     (default '()))                ; or <mapped-device>
+  (requirements     file-system-requirements      ; list of symbols
+                    (default '()))
   (location         file-system-location
                     (default (current-source-location))
                     (innate)))

base-commit: 91d9e145e15241c20729a4f1fa43f3d662f6b806
-- 
2.41.0

[bug#70542] [PATCH v2 2/3] file-systems: Add host-to-ip nested function

[Richard Sent]

* gnu/build/file-systems (mount-file-system): Split out getaddrinfo logic into a
dedicated function, (host-to-ip)

Change-Id: I522d70a10651ca79533a4fc60b96b884243a3526
---
 gnu/build/file-systems.scm | 15 ++++++++++-----
 1 file changed, 10 insertions(+), 5 deletions(-)

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index 78d779f398..e47ac39ab0 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -1156,6 +1156,14 @@ (define* (mount-file-system fs #:key (root "/root")
                             (repair (file-system-repair fs)))
   "Mount the file system described by FS, a <file-system> object, under ROOT."
 
+  (define* (host-to-ip host #:optional service)
+    "Return the IP address for host, which may be an IP address or a hostname."
+    (let* ((aa (match (getaddrinfo host service) ((x . _) x)))
+           (sa (addrinfo:addr aa))
+           (inet-addr (inet-ntop (sockaddr:fam sa)
+                                 (sockaddr:addr sa))))
+      inet-addr))
+
   (define (mount-nfs source mount-point type flags options)
     (let* ((idx (string-rindex source #\:))
            (host-part (string-take source idx))
@@ -1163,11 +1171,7 @@ (define* (mount-file-system fs #:key (root "/root")
            (host (match (string-split host-part (string->char-set "[]"))
                  (("" h "") h)
                  ((h) h)))
-           (aa (match (getaddrinfo host "nfs") ((x . _) x)))
-           (sa (addrinfo:addr aa))
-           (inet-addr (inet-ntop (sockaddr:fam sa)
-                                 (sockaddr:addr sa))))
-
+           (inet-addr (host-to-ip host "nfs")))
       ;; Mounting an NFS file system requires passing the address
       ;; of the server in the addr= option
       (mount source mount-point type flags
@@ -1176,6 +1180,7 @@ (define* (mount-file-system fs #:key (root "/root")
                             (if options
                                 (string-append "," options)
                                 "")))))
+
   (let* ((type    (file-system-type fs))
          (source  (canonicalize-device-spec (file-system-device fs)))
          (target  (string-append root "/"
-- 
2.41.0

[bug#70542] [PATCH v2 3/3] file-systems: Add support for mounting CIFS file systems

[Richard Sent]

* gnu/build/file-systems (canonicalize-device-name): Do not attempt to resolve
CIFS formatted device specifications.
(mount-file-systems): Add mount-cifs nested function.
* gnu/machine/ssh.scm (machine-check-file-system-availability): Skip checking
for CIFS availability, similar to NFS.
* guix/scripts/system.scm (check-file-system-availability): Likewise.

Change-Id: I182e290eba64bbe5d1332815eb93bb68c01e0c3c
---
 gnu/build/file-systems.scm | 45 ++++++++++++++++++++++++++++++++++++--
 gnu/machine/ssh.scm        |  3 ++-
 guix/scripts/system.scm    |  3 ++-
 3 files changed, 47 insertions(+), 4 deletions(-)

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index e47ac39ab0..ae29b36c4e 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -8,6 +8,7 @@
 ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2022 Oleg Pykhalov <go.wigust@gmail.com>
 ;;; Copyright © 2024 Nicolas Graves <ngraves@ngraves.fr>
+;;; Copyright © 2024 Richard Sent <richard@freakingpenguin.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -37,6 +38,7 @@ (define-module (gnu build file-systems)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 regex)
   #:use-module (system foreign)
   #:autoload   (system repl repl) (start-repl)
   #:use-module (srfi srfi-1)
@@ -1047,8 +1049,11 @@ (define (canonicalize-device-spec spec)
 
   (match spec
     ((? string?)
-     (if (or (string-contains spec ":/") (string=? spec "none"))
-         spec                  ; do not resolve NFS / tmpfs devices
+     (if (or (string-contains spec ":/") ;nfs
+             (and (>= (string-length spec) 2)
+                  (equal? (string-take spec 2) "//")) ;cifs
+             (string=? spec "none"))
+         spec                  ; do not resolve NFS / CIFS / tmpfs devices
          ;; Nothing to do, but wait until SPEC shows up.
          (resolve identity spec identity)))
     ((? file-system-label?)
@@ -1181,6 +1186,40 @@ (define* (mount-file-system fs #:key (root "/root")
                                 (string-append "," options)
                                 "")))))
 
+  (define (mount-cifs source mount-point type flags options)
+    ;; Source is of form "//<server-ip-or-host>/<service>"
+    (let* ((regex-match (string-match "//([^/]+)/(.+)" source))
+           (server (match:substring regex-match 1))
+           (share (match:substring regex-match 2))
+           ;; Match ",guest,", ",guest$", "^guest,", or "^guest$," not
+           ;; e.g. user=foo,pass=notaguest
+           (guest? (string-match "(^|,)(guest)($|,)" options))
+           ;; Perform DNS resolution now instead of attempting kernel dns
+           ;; resolver upcalling. /sbin/request-key does not exist and the
+           ;; kernel hardcodes the path.
+           ;;
+           ;; (getaddrinfo) doesn't support cifs service, so omit it.
+           (inet-addr (host-to-ip server)))
+      (mount source mount-point type flags
+             (string-append "ip="
+                            inet-addr
+                            ;; As of Linux af1a3d2ba9 (v5.11) unc is ignored
+                            ;; and source is parsed by the kernel
+                            ;; directly. Pass it for compatibility.
+                            ",unc="
+                            ;; Match format of mount.cifs's mount syscall.
+                            "\\\\" server "\\" share
+                            (if guest?
+                                ",user=,pass="
+                                "")
+                            (if options
+                                ;; No need to delete "guest" from options.
+                                ;; linux/fs/smb/client/fs_context.c explicitly
+                                ;; ignores it. Also, avoiding excess commas
+                                ;; when deleting is a pain.
+                                (string-append "," options)
+                                "")))))
+
   (let* ((type    (file-system-type fs))
          (source  (canonicalize-device-spec (file-system-device fs)))
          (target  (string-append root "/"
@@ -1215,6 +1254,8 @@ (define* (mount-file-system fs #:key (root "/root")
         (cond
          ((string-prefix? "nfs" type)
           (mount-nfs source target type flags options))
+         ((string-prefix? "cifs" type)
+          (mount-cifs source target type flags options))
          ((memq 'shared (file-system-flags fs))
           (mount source target type flags options)
           (mount "none" target #f MS_SHARED))
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index b47ce7c225..0be9ebbc0d 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -222,7 +222,8 @@ (define (machine-check-file-system-availability machine)
                    (not (member (file-system-type fs)
                                 %pseudo-file-system-types))
                    ;; Don't try to validate network file systems.
-                   (not (string-prefix? "nfs" (file-system-type fs)))
+                   (not (or (string-prefix? "nfs" (file-system-type fs))
+                            (string-prefix? "cifs" (file-system-type fs))))
                    (not (memq 'bind-mount (file-system-flags fs)))))
             (operating-system-file-systems (machine-operating-system machine))))
 
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 2260bcf985..99c58f3812 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -591,7 +591,8 @@ (define (check-file-system-availability file-systems)
                    (not (member (file-system-type fs)
                                 %pseudo-file-system-types))
                    ;; Don't try to validate network file systems.
-                   (not (string-prefix? "nfs" (file-system-type fs)))
+                   (not (or (string-prefix? "nfs" (file-system-type fs))
+                            (string-prefix? "cifs" (file-system-type fs))))
                    (not (memq 'bind-mount (file-system-flags fs)))))
             file-systems))
 
-- 
2.41.0

[bug#70542] [PATCH 0/4] Improve Shepherd service support for networked file systems

[Jonathan Brielmaier via Guix-patches via]

Hello Richard,

thanks for improving the CIFS mounting problem!

I'm using a CIFS share on one of my servers. There I stumbled upon a
problem, that the share is disappearing (e.g. CIFS server unavailable
for a short time) and gets not automatically remounted.

So I'm using a simple cron job to workaround this problem:
```
;; CIFS mount disappears often
(define mount-all-job
   #~(job "0 * * * *"
          "mount --all"
          #:user "root"))
```

Do you know if this particular problem gets resolved with your patch?

~Jonathan

[bug#70542] [PATCH 0/4] Improve Shepherd service support for networked file systems

[Richard Sent]

Hi Jonathan!

Jonathan Brielmaier <jonathan.brielmaier@web.de> writes:

> Hello Richard,
>
> thanks for improving the CIFS mounting problem!
>
> I'm using a CIFS share on one of my servers. There I stumbled upon a
> problem, that the share is disappearing (e.g. CIFS server unavailable
> for a short time) and gets not automatically remounted.
>
> Do you know if this particular problem gets resolved with your patch?
>

I've never experienced that issue myself so I can't say for sure.
However, I don't believe my patch would resolve that issue.

file-system-shepherd-service in (gnu services base) is in charge of
mounting the file system. That service does not attempt to monitor the
file system's status after running. There's no daemon. If the file
system is mounted successfully, Shepherd will think there's no problem.

My understanding is that Shepherd will not respawn a service that
starts, then exits sucessfully. From Shepherd's manual:

> start’.  If the starting attempt failed, it must return ‘#f’
> or throw an exception; otherwise, the return value is stored
> as the “running value” of the service.

This could be solved by, for example, adding a remount? flag and/or
remount-delay field to file-systems and changing
file-system-shepherd-service to conditionally use a fork-style
constructor many other services use. Within that process, a loop checks
if there is a file system mounted at the target location.

There might be a better way to structure this. I'd be a little worried
about adding many new file-system record fields that aren't always used.
Consider when needed-for-boot is #t, file-system-shepherd-service isn't
used at all. Those new flags silently do nothing. I think that's fine
when it's just one (requirements), but it's probably worth some thought
if we add more later.

Either way it's probably another patch problem.

-- 
Take it easy,
Richard Sent
Making my computer weirder one commit at a time.

[bug#70542] [PATCH v3 0/3] Improve Shepherd service support for networked file systems

[Richard Sent]

Hi all,

Since there hasn't been any discussion on this patch and it fell off QA
recently, I figured I'd resubmit with a small change.

file-system-requirements was changed to file-system-shepherd-requirements to
be more consistent with other services.

I still feel like shepherd-requirements shouldn't be merged with dependencies
due to functional differences, but if there's consensus otherwise I can change
it.

I believe all other feedback so far has been addressed. :)

Richard Sent (3):
  services: base: Add optional delayed mount of file-systems
  file-systems: Add host-to-ip nested function
  file-systems: Add support for mounting CIFS file systems

 doc/guix.texi               | 14 +++++++++
 gnu/build/file-systems.scm  | 60 ++++++++++++++++++++++++++++++++-----
 gnu/machine/ssh.scm         |  3 +-
 gnu/services/base.scm       | 14 +++++++--
 gnu/system/file-systems.scm | 57 ++++++++++++++++++-----------------
 guix/scripts/system.scm     |  3 +-
 6 files changed, 113 insertions(+), 38 deletions(-)


base-commit: fba6896f625dcbeef112387fc90abe83acae1720
-- 
2.41.0

[bug#70542] [PATCH v3 1/3] services: base: Add optional delayed mount of file-systems

[Richard Sent]

Add a mechanism to only require mounting a subset of file-system entries
during early Shepherd initialization. Any file-system with additional Shepherd
service requirements (e.g. networking) is not required to provision
'file-systems.

* gnu/services/base.scm (file-system-shepherd-service): Splice
file-system-requirements into the Shepherd service requirement list.
(file-system-shepherd-services): Provision 'file-system only when file system
services without additional Shepherd requirements are started.
* gnu/system/file-systems.scm (file-system): Add shepherd-requirements field
to the file-system record. This field is used for adding additional Shepherd
requirements to a file-system Shepherd service.
* doc/guix.texi: Add documentation for file-system shepherd-requirements.

Change-Id: If0392db03d48e8820aa53df1df482c12ec72e1a5
---
 doc/guix.texi               | 14 +++++++++
 gnu/services/base.scm       | 14 +++++++--
 gnu/system/file-systems.scm | 57 +++++++++++++++++++------------------
 3 files changed, 56 insertions(+), 29 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 1224104038..158fd6c125 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -17862,6 +17862,20 @@ File Systems
 
 Another example is a file system that depends on a mapped device, for
 example for an encrypted partition (@pxref{Mapped Devices}).
+
+@item @code{shepherd-requirements} (default: @code{'()})
+This is a list of symbols denoting Shepherd requirements that must be
+met before mounting the file system.
+
+As an example, an NFS file system would typically have a requirement for
+@code{networking}.
+
+Typically, file systems are mounted before most other Shepherd services
+are started.  However, file systems with a non-empty
+shepherd-requirements field are mounted after Shepherd services have
+begun.  Any Shepherd service that depends on a file system with a
+non-empty shepherd-requirements field must depend on it directly and not
+on the generic symbol @code{file-systems}.
 @end table
 @end deftp
 
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 85160bd3ab..a552438753 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -404,6 +404,7 @@ (define (file-system-shepherd-service file-system)
         (create? (file-system-create-mount-point? file-system))
         (mount?  (file-system-mount? file-system))
         (dependencies (file-system-dependencies file-system))
+        (requirements (file-system-shepherd-requirements file-system))
         (packages (file-system-packages (list file-system))))
     (and (or mount? create?)
          (with-imported-modules (source-module-closure
@@ -412,7 +413,8 @@ (define (file-system-shepherd-service file-system)
             (provision (list (file-system->shepherd-service-name file-system)))
             (requirement `(root-file-system
                            udev
-                           ,@(map dependency->shepherd-service-name dependencies)))
+                           ,@(map dependency->shepherd-service-name dependencies)
+                           ,@requirements))
             (documentation "Check, mount, and unmount the given file system.")
             (start #~(lambda args
                        #$(if create?
@@ -461,12 +463,20 @@ (define (file-system-shepherd-services file-systems)
                                  (or (file-system-mount? x)
                                      (file-system-create-mount-point? x)))
                                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)))
+                                ;; Do not require file systems with Shepherd
+                                ;; requirements to provision
+                                ;; 'file-systems. Many Shepherd services
+                                ;; require 'file-systems, so we would likely
+                                ;; deadlock.
+                                (filter (lambda (file-system)
+                                          (null? (file-system-shepherd-requirements file-system)))
+                                        file-systems))))
        (documentation "Target for all the initially-mounted file systems")
        (start #~(const #t))
        (stop #~(const #f))))
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index c791b24a9f..4ea8237c70 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -57,6 +57,7 @@ (define-module (gnu system file-systems)
             file-system-repair
             file-system-create-mount-point?
             file-system-dependencies
+            file-system-shepherd-requirements
             file-system-location
 
             file-system-type-predicate
@@ -161,33 +162,35 @@ (define-syntax validate-file-system-flags
 (define-record-type* <file-system> file-system
   make-file-system
   file-system?
-  (device           file-system-device) ; string | <uuid> | <file-system-label>
-  (mount-point      file-system-mount-point)      ; string
-  (type             file-system-type)             ; string
-  (flags            file-system-flags             ; list of symbols
-                    (default '())
-                    (sanitize validate-file-system-flags))
-  (options          file-system-options           ; string or #f
-                    (default #f))
-  (mount?           file-system-mount?            ; Boolean
-                    (default #t))
-  (mount-may-fail?  file-system-mount-may-fail?   ; Boolean
-                    (default #f))
-  (needed-for-boot? %file-system-needed-for-boot? ; Boolean
-                    (default #f))
-  (check?           file-system-check?            ; Boolean
-                    (default #t))
-  (skip-check-if-clean? file-system-skip-check-if-clean? ; Boolean
-                        (default #t))
-  (repair           file-system-repair            ; symbol or #f
-                    (default 'preen))
-  (create-mount-point? file-system-create-mount-point? ; Boolean
-                       (default #f))
-  (dependencies     file-system-dependencies      ; list of <file-system>
-                    (default '()))                ; or <mapped-device>
-  (location         file-system-location
-                    (default (current-source-location))
-                    (innate)))
+  (device                file-system-device)               ; string | <uuid> | <file-system-label>
+  (mount-point           file-system-mount-point)          ; string
+  (type                  file-system-type)                 ; string
+  (flags                 file-system-flags                 ; list of symbols
+                         (default '())
+                         (sanitize validate-file-system-flags))
+  (options               file-system-options               ; string or #f
+                         (default #f))
+  (mount?                file-system-mount?                ; Boolean
+                         (default #t))
+  (mount-may-fail?       file-system-mount-may-fail?       ; Boolean
+                         (default #f))
+  (needed-for-boot?      %file-system-needed-for-boot?     ; Boolean
+                         (default #f))
+  (check?                file-system-check?                ; Boolean
+                         (default #t))
+  (skip-check-if-clean?  file-system-skip-check-if-clean?  ; Boolean
+                         (default #t))
+  (repair                file-system-repair                ; symbol or #f
+                         (default 'preen))
+  (create-mount-point?   file-system-create-mount-point?   ; Boolean
+                         (default #f))
+  (dependencies          file-system-dependencies          ; list of <file-system>
+                         (default '()))                    ; or <mapped-device>
+  (shepherd-requirements file-system-shepherd-requirements ; list of symbols
+                         (default '()))
+  (location              file-system-location
+                         (default (current-source-location))
+                         (innate)))
 
 ;; A file system label for use in the 'device' field.
 (define-record-type <file-system-label>
-- 
2.41.0

[bug#70542] [PATCH v3 2/3] file-systems: Add host-to-ip nested function

[Richard Sent]

* gnu/build/file-systems (mount-file-system): Split out getaddrinfo logic into a
dedicated function, (host-to-ip)

Change-Id: I522d70a10651ca79533a4fc60b96b884243a3526
---
 gnu/build/file-systems.scm | 15 ++++++++++-----
 1 file changed, 10 insertions(+), 5 deletions(-)

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index 78d779f398..e47ac39ab0 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -1156,6 +1156,14 @@ (define* (mount-file-system fs #:key (root "/root")
                             (repair (file-system-repair fs)))
   "Mount the file system described by FS, a <file-system> object, under ROOT."
 
+  (define* (host-to-ip host #:optional service)
+    "Return the IP address for host, which may be an IP address or a hostname."
+    (let* ((aa (match (getaddrinfo host service) ((x . _) x)))
+           (sa (addrinfo:addr aa))
+           (inet-addr (inet-ntop (sockaddr:fam sa)
+                                 (sockaddr:addr sa))))
+      inet-addr))
+
   (define (mount-nfs source mount-point type flags options)
     (let* ((idx (string-rindex source #\:))
            (host-part (string-take source idx))
@@ -1163,11 +1171,7 @@ (define* (mount-file-system fs #:key (root "/root")
            (host (match (string-split host-part (string->char-set "[]"))
                  (("" h "") h)
                  ((h) h)))
-           (aa (match (getaddrinfo host "nfs") ((x . _) x)))
-           (sa (addrinfo:addr aa))
-           (inet-addr (inet-ntop (sockaddr:fam sa)
-                                 (sockaddr:addr sa))))
-
+           (inet-addr (host-to-ip host "nfs")))
       ;; Mounting an NFS file system requires passing the address
       ;; of the server in the addr= option
       (mount source mount-point type flags
@@ -1176,6 +1180,7 @@ (define* (mount-file-system fs #:key (root "/root")
                             (if options
                                 (string-append "," options)
                                 "")))))
+
   (let* ((type    (file-system-type fs))
          (source  (canonicalize-device-spec (file-system-device fs)))
          (target  (string-append root "/"
-- 
2.41.0

[bug#70542] [PATCH v3 3/3] file-systems: Add support for mounting CIFS file systems

[Richard Sent]

* gnu/build/file-systems (canonicalize-device-name): Do not attempt to resolve
CIFS formatted device specifications.
(mount-file-systems): Add mount-cifs nested function.
* gnu/machine/ssh.scm (machine-check-file-system-availability): Skip checking
for CIFS availability, similar to NFS.
* guix/scripts/system.scm (check-file-system-availability): Likewise.

Change-Id: I182e290eba64bbe5d1332815eb93bb68c01e0c3c
---
 gnu/build/file-systems.scm | 45 ++++++++++++++++++++++++++++++++++++--
 gnu/machine/ssh.scm        |  3 ++-
 guix/scripts/system.scm    |  3 ++-
 3 files changed, 47 insertions(+), 4 deletions(-)

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index e47ac39ab0..ae29b36c4e 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -8,6 +8,7 @@
 ;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2022 Oleg Pykhalov <go.wigust@gmail.com>
 ;;; Copyright © 2024 Nicolas Graves <ngraves@ngraves.fr>
+;;; Copyright © 2024 Richard Sent <richard@freakingpenguin.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -37,6 +38,7 @@ (define-module (gnu build file-systems)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 regex)
   #:use-module (system foreign)
   #:autoload   (system repl repl) (start-repl)
   #:use-module (srfi srfi-1)
@@ -1047,8 +1049,11 @@ (define (canonicalize-device-spec spec)
 
   (match spec
     ((? string?)
-     (if (or (string-contains spec ":/") (string=? spec "none"))
-         spec                  ; do not resolve NFS / tmpfs devices
+     (if (or (string-contains spec ":/") ;nfs
+             (and (>= (string-length spec) 2)
+                  (equal? (string-take spec 2) "//")) ;cifs
+             (string=? spec "none"))
+         spec                  ; do not resolve NFS / CIFS / tmpfs devices
          ;; Nothing to do, but wait until SPEC shows up.
          (resolve identity spec identity)))
     ((? file-system-label?)
@@ -1181,6 +1186,40 @@ (define* (mount-file-system fs #:key (root "/root")
                                 (string-append "," options)
                                 "")))))
 
+  (define (mount-cifs source mount-point type flags options)
+    ;; Source is of form "//<server-ip-or-host>/<service>"
+    (let* ((regex-match (string-match "//([^/]+)/(.+)" source))
+           (server (match:substring regex-match 1))
+           (share (match:substring regex-match 2))
+           ;; Match ",guest,", ",guest$", "^guest,", or "^guest$," not
+           ;; e.g. user=foo,pass=notaguest
+           (guest? (string-match "(^|,)(guest)($|,)" options))
+           ;; Perform DNS resolution now instead of attempting kernel dns
+           ;; resolver upcalling. /sbin/request-key does not exist and the
+           ;; kernel hardcodes the path.
+           ;;
+           ;; (getaddrinfo) doesn't support cifs service, so omit it.
+           (inet-addr (host-to-ip server)))
+      (mount source mount-point type flags
+             (string-append "ip="
+                            inet-addr
+                            ;; As of Linux af1a3d2ba9 (v5.11) unc is ignored
+                            ;; and source is parsed by the kernel
+                            ;; directly. Pass it for compatibility.
+                            ",unc="
+                            ;; Match format of mount.cifs's mount syscall.
+                            "\\\\" server "\\" share
+                            (if guest?
+                                ",user=,pass="
+                                "")
+                            (if options
+                                ;; No need to delete "guest" from options.
+                                ;; linux/fs/smb/client/fs_context.c explicitly
+                                ;; ignores it. Also, avoiding excess commas
+                                ;; when deleting is a pain.
+                                (string-append "," options)
+                                "")))))
+
   (let* ((type    (file-system-type fs))
          (source  (canonicalize-device-spec (file-system-device fs)))
          (target  (string-append root "/"
@@ -1215,6 +1254,8 @@ (define* (mount-file-system fs #:key (root "/root")
         (cond
          ((string-prefix? "nfs" type)
           (mount-nfs source target type flags options))
+         ((string-prefix? "cifs" type)
+          (mount-cifs source target type flags options))
          ((memq 'shared (file-system-flags fs))
           (mount source target type flags options)
           (mount "none" target #f MS_SHARED))
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index b47ce7c225..0be9ebbc0d 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -222,7 +222,8 @@ (define (machine-check-file-system-availability machine)
                    (not (member (file-system-type fs)
                                 %pseudo-file-system-types))
                    ;; Don't try to validate network file systems.
-                   (not (string-prefix? "nfs" (file-system-type fs)))
+                   (not (or (string-prefix? "nfs" (file-system-type fs))
+                            (string-prefix? "cifs" (file-system-type fs))))
                    (not (memq 'bind-mount (file-system-flags fs)))))
             (operating-system-file-systems (machine-operating-system machine))))
 
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 2260bcf985..99c58f3812 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -591,7 +591,8 @@ (define (check-file-system-availability file-systems)
                    (not (member (file-system-type fs)
                                 %pseudo-file-system-types))
                    ;; Don't try to validate network file systems.
-                   (not (string-prefix? "nfs" (file-system-type fs)))
+                   (not (or (string-prefix? "nfs" (file-system-type fs))
+                            (string-prefix? "cifs" (file-system-type fs))))
                    (not (memq 'bind-mount (file-system-flags fs)))))
             file-systems))
 
-- 
2.41.0

bug#70542: [PATCH v3 0/3] Improve Shepherd service support for networked file systems

[Ludovic Courtès]

Hi Richard,

Richard Sent <richard@freakingpenguin.com> skribis:

> Since there hasn't been any discussion on this patch and it fell off QA
> recently, I figured I'd resubmit with a small change.
>
> file-system-requirements was changed to file-system-shepherd-requirements to
> be more consistent with other services.
>
> I still feel like shepherd-requirements shouldn't be merged with dependencies
> due to functional differences, but if there's consensus otherwise I can change
> it.
>
> I believe all other feedback so far has been addressed. :)

Thanks for the heads-up, I had forgotten about this patch set…

>   services: base: Add optional delayed mount of file-systems
>   file-systems: Add host-to-ip nested function
>   file-systems: Add support for mounting CIFS file systems

LGTM, applied.  Thank you!

Ludo’.