bug#39770: mount-file-system fails to mount NFS file system

[Maxim Cournoyer <maxim.cournoyer@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 727 bytes --]

Hi,

maxim.cournoyer@gmail.com writes:

[...]

> It seems we're missing either a "vers" (doubtful) or more likely the
> "clientaddr" option.

It turns out that the "vers" (or more specifically, "nfsvers") option
was mandatory to resolve this error.  What "mount.nfs" from
nfs-utils seems to do is start with "4.2", then retry upon errors lesser
versions.

The attached patch adds the required "nfsvers=4.2" option by default, or
honors a user specified one.  No retry is done.  Note that it currently
uses file system options represented as an alist, but this is likely to
change as the code review on "allow booting from a Btrfs subvolume"
progresses (the current patch is based atop of
<https://bugs.gnu.org/37305>).

Maxim


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-build-file-systems-Specify-a-nfsvers-option-by-defau.patch --]
[-- Type: text/x-patch, Size: 4614 bytes --]

From 6cbae0746dbeb736dc8c037183038eca2f7867fd Mon Sep 17 00:00:00 2001
From: Maxim Cournoyer <maxim.cournoyer@gmail.com>
Date: Mon, 24 Feb 2020 16:09:10 -0500
Subject: [PATCH] build: file-systems: Specify a "nfsvers" option by default
 for NFS.

Without it, the mount system call fails with an ECONNREFUSED (Connection
refused) error.

* gnu/build/file-systems.scm (nfs-source->ip-address): Add procedure, with
code moved from...
(mount-file-system): ...the inner `mount-nfs' procedure, now removed.  The NFS
specific required options default values are now computed and added to the
regular options.  Honor any user given "addr", "nfsvers" or "vers" option."
Remove the call to `mount-nfs', no longer needed.
---
 gnu/build/file-systems.scm | 59 +++++++++++++++++++++-----------------
 1 file changed, 33 insertions(+), 26 deletions(-)

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index 76c143654d..fdeb12e825 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -640,36 +640,45 @@ corresponds to the symbols listed in FLAGS."
       (()
        0))))
 
+(define (nfs-source->ip-address source)
+  "Return the IP address from the source component of a network file-system."
+  (let* ((idx (string-rindex source #\:))
+         (host-part (string-take source idx))
+         ;; Strip [] from around host if present
+         (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-ntop (sockaddr:fam sa)
+               (sockaddr:addr sa))))
+
 (define* (mount-file-system fs #:key (root "/root"))
   "Mount the file system described by FS, a <file-system> object, under ROOT."
 
-  (define (mount-nfs source mount-point type flags options)
-    (let* ((idx (string-rindex source #\:))
-           (host-part (string-take source idx))
-           ;; Strip [] from around host if present
-           (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))))
-
-      ;; Mounting an NFS file system requires passing the address
-      ;; of the server in the addr= option
-      (mount source mount-point type flags
-             (string-append "addr="
-                            inet-addr
-                            (if options
-                                (string-append "," options)
-                                "")))))
   (let* ((type        (file-system-type fs))
          (nfs? (string-prefix? "nfs" type))
+         (source      (canonicalize-device-spec (file-system-device fs)))
          (fs-options (file-system-options fs))
-         (options (if (null? fs-options)
+         (fs-options*
+          (if nfs?
+              ;; Do not override user specified "addr", "nfsvers" or "vers",
+              ;; but provide default values as otherwise mount fails to
+              ;; connect.
+              `(,@fs-options
+                ,@(if (member "addr" fs-options)
+                      '()
+                      (list (format #f "addr=~a"
+                                    (nfs-source->ip-address source))))
+                ,@(if (or (assoc-ref fs-options "nfsvers")
+                          (assoc-ref fs-options "vers"))
+                      '()
+                      (list "nfsvers=4.2")))
+              fs-options))
+         (options (if (null? fs-options*)
                       #f
-                      (file-system-options->string fs-options)))
-         (source      (canonicalize-device-spec (file-system-device fs)))
+                      (file-system-options->string fs-options*)))
+
          (mount-point (string-append root "/"
                                      (file-system-mount-point fs)))
          (flags       (mount-flags->bit-mask (file-system-flags fs))))
@@ -685,9 +694,7 @@ corresponds to the symbols listed in FLAGS."
           (call-with-output-file mount-point (const #t)))
         (mkdir-p mount-point))
 
-    (if nfs?
-        (mount-nfs source mount-point type flags options)
-        (mount source mount-point type flags options))
+    (mount source mount-point type flags options)
 
     ;; For read-only bind mounts, an extra remount is needed, as per
     ;; <http://lwn.net/Articles/281157/>, which still applies to Linux 4.0.
-- 
2.25.0