guix-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[PATCH] gnu: Allow nfs file systems to be automatically mounted.


From: John Darrington
Subject: [PATCH] gnu: Allow nfs file systems to be automatically mounted.
Date: Sat, 26 Nov 2016 10:36:30 +0100

* gnu/build/file-systems.scm (mount-file-system): Append target addr= when
mounting nfs filesystems.
---
 gnu/build/file-systems.scm | 36 +++++++++++++++++++++---------------
 1 file changed, 21 insertions(+), 15 deletions(-)

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index c6fc784..ca788ec 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -464,6 +464,22 @@ form:
 DEVICE, MOUNT-POINT, and TYPE must be strings; OPTIONS can be a string or #f;
 FLAGS must be a list of symbols.  CHECK? is a Boolean indicating whether to
 run a file system check."
+
+  (define (mount-nfs source mount-point type flags options)
+    (let* ((host (match (string-split source #\:) ((h _) h)))
+           (aa (car (getaddrinfo host "nfs")))
+           (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)
+                                "")))))
   (match spec
     ((source title mount-point type (flags ...) options check?)
      (let ((source      (canonicalize-device-spec source title))
@@ -481,21 +497,11 @@ run a file system check."
              (call-with-output-file mount-point (const #t)))
            (mkdir-p mount-point))
 
-       (mount source mount-point type flags
-              (cond
-               ((string-match "^nfs.*" type)
-                (let* ((host (car (string-split source #\:)))
-                       (aa (car (getaddrinfo host #f)))
-                       (sa (addrinfo:addr aa))
-                       (inet-addr (inet-ntop (sockaddr:fam sa)
-                                             (sockaddr:addr sa))))
-                  (string-append "addr="
-                                 inet-addr
-                                 (if options
-                                     (string-append "," options)
-                                     ""))))
-               (else
-                options)))
+       (cond
+        ((string-match "^nfs.*" type)
+         (mount-nfs source mount-point type flags options))
+        (else
+         (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.1.4




reply via email to

[Prev in Thread] Current Thread [Next in Thread]