ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 13:28:12 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

gnu: Allow nfs file systems to be automatically mounted.

Browse source 
* gnu/build/file-systems.scm (mount-file-system): Append target addr= when
mounting nfs filesystems.
This commit is contained in:
John Darrington 2016-11-26 10:29:23 +01:00
parent 7c635ed6f7
commit 0c85db79f7
No known key found for this signature in database
GPG key ID: 8A67719C2DE827B3
1 changed files with 26 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
gnu/build/file-systems.scm
View file

@ -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
;; <http://lwn.net/Articles/281157/>, which still applies to Linux 4.0.