From 0c85db79f7a8abc3bcdbf8931d959fe94306a5a1 Mon Sep 17 00:00:00 2001 From: John Darrington Date: Sat, 26 Nov 2016 10:29:23 +0100 Subject: gnu: Allow nfs file systems to be automatically mounted. * gnu/build/file-systems.scm (mount-file-system): Append target addr= when mounting nfs filesystems. --- gnu/build/file-systems.scm | 27 ++++++++++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) (limited to 'gnu') diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm index 0d55e91978..431b287d0c 100644 --- a/gnu/build/file-systems.scm +++ b/gnu/build/file-systems.scm @@ -464,6 +464,27 @@ (define* (mount-file-system spec #:key (root "/root")) 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* ((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) + ""))))) (match spec ((source title mount-point type (flags ...) options check?) (let ((source (canonicalize-device-spec source title)) @@ -481,7 +502,11 @@ (define* (mount-file-system spec #:key (root "/root")) (call-with-output-file mount-point (const #t))) (mkdir-p mount-point)) - (mount source mount-point type flags options) + (cond + ((string-prefix? "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 ;; , which still applies to Linux 4.0. -- cgit v1.2.3