diff options
| author | Richard Sent <richard@freakingpenguin.com> | 2024-06-01 19:26:17 -0400 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2024-06-04 12:08:34 +0200 |
| commit | 9d6c4f5160c872bf8813d9e75f80a9f0157bf769 (patch) | |
| tree | daf7355937014a0209e9e87bfa1f91a652b29ff4 /gnu/build | |
| parent | 579df5bc80fbedc59dc1b99751dcc49deab8f488 (diff) | |
| download | guix-9d6c4f5160c872bf8813d9e75f80a9f0157bf769.tar guix-9d6c4f5160c872bf8813d9e75f80a9f0157bf769.tar.gz | |
file-systems: Add host-to-ip nested function
* gnu/build/file-systems (mount-file-system): Split out getaddrinfo logic into a
dedicated function, (host-to-ip)
Change-Id: I522d70a10651ca79533a4fc60b96b884243a3526
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Diffstat (limited to 'gnu/build')
| -rw-r--r-- | gnu/build/file-systems.scm | 15 |
1 files changed, 10 insertions, 5 deletions
diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm index 78d779f398..e47ac39ab0 100644 --- a/gnu/build/file-systems.scm +++ b/gnu/build/file-systems.scm @@ -1156,6 +1156,14 @@ corresponds to the symbols listed in FLAGS." (repair (file-system-repair fs))) "Mount the file system described by FS, a <file-system> object, under ROOT." + (define* (host-to-ip host #:optional service) + "Return the IP address for host, which may be an IP address or a hostname." + (let* ((aa (match (getaddrinfo host service) ((x . _) x))) + (sa (addrinfo:addr aa)) + (inet-addr (inet-ntop (sockaddr:fam sa) + (sockaddr:addr sa)))) + inet-addr)) + (define (mount-nfs source mount-point type flags options) (let* ((idx (string-rindex source #\:)) (host-part (string-take source idx)) @@ -1163,11 +1171,7 @@ corresponds to the symbols listed in FLAGS." (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)))) - + (inet-addr (host-to-ip host "nfs"))) ;; Mounting an NFS file system requires passing the address ;; of the server in the addr= option (mount source mount-point type flags @@ -1176,6 +1180,7 @@ corresponds to the symbols listed in FLAGS." (if options (string-append "," options) ""))))) + (let* ((type (file-system-type fs)) (source (canonicalize-device-spec (file-system-device fs))) (target (string-append root "/" |