unofficial mirror of guix-devel@gnu.org 
 help / color / mirror / code / Atom feed
From: John Darrington <jmd@gnu.org>
To: guix-devel@gnu.org
Cc: John Darrington <jmd@gnu.org>
Subject: [PATCH] gnu: Allow nfs file systems to be automatically mounted.
Date: Sat, 26 Nov 2016 10:36:30 +0100	[thread overview]
Message-ID: <1480152990-7080-1-git-send-email-jmd@gnu.org> (raw)
In-Reply-To: <8760nc6et6.fsf@gnu.org>

* 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	other threads:[~2016-11-26  9:36 UTC|newest]

Thread overview: 32+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2016-11-10 21:14 [PATCH 1/4] gnu: Separate util-linux into three packages John Darrington
2016-11-10 21:14 ` [PATCH 2/4] gnu: nfs-utils: Change input from util-linux to util-linux/mount John Darrington
2016-11-10 21:14 ` [PATCH 3/4] gnu: Move util-linux/mount to new file and deal with the effects John Darrington
2016-11-10 21:14 ` [PATCH 4/4] Add fs-search paths to util-linux John Darrington
2016-11-11 14:43 ` [PATCH 1/4] gnu: Separate util-linux into three packages Hartmut Goebel
2016-11-11 16:03   ` John Darrington
2016-11-11 16:40     ` Hartmut Goebel
2016-11-11 19:36       ` John Darrington
2016-11-12 14:53 ` Ludovic Courtès
2016-11-12 15:28   ` John Darrington
2016-11-12 17:09     ` John Darrington
2016-11-12 22:55       ` Ludovic Courtès
2016-11-13  8:21         ` John Darrington
2016-11-13 11:59           ` Ludovic Courtès
2016-11-13 14:06             ` John Darrington
2016-11-14  9:48               ` Ludovic Courtès
2016-11-14 17:46                 ` John Darrington
2016-11-15 10:46                   ` Ludovic Courtès
2016-11-16 21:06                     ` mount syscall John Darrington
2016-11-17  9:47                       ` Ludovic Courtès
2016-11-22 19:15                         ` [PATCH] gnu: Allow nfs filesystems to be automatically mounted John Darrington
2016-11-23 22:07                           ` Ludovic Courtès
2016-11-23 23:32                             ` John Darrington
2016-11-24 16:08                               ` Ludovic Courtès
2016-11-26  9:36                                 ` John Darrington [this message]
2016-11-26 18:37                                   ` [PATCH] gnu: Allow nfs file systems " Ludovic Courtès
2016-11-26 19:33                                     ` John Darrington
2016-11-28 13:59                                       ` Ludovic Courtès
2016-11-28 14:07                                         ` John Darrington
2016-11-28 21:05                                           ` Ludovic Courtès
2016-11-29  6:27                                             ` John Darrington
2016-11-29 21:51                                               ` Ludovic Courtès

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=1480152990-7080-1-git-send-email-jmd@gnu.org \
    --to=jmd@gnu.org \
    --cc=guix-devel@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).