[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