[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#70542] [PATCH v3 2/3] file-systems: Add host-to-ip nested function
From: |
Richard Sent |
Subject: |
[bug#70542] [PATCH v3 2/3] file-systems: Add host-to-ip nested function |
Date: |
Sat, 1 Jun 2024 19:26:17 -0400 |
* gnu/build/file-systems (mount-file-system): Split out getaddrinfo logic into a
dedicated function, (host-to-ip)
Change-Id: I522d70a10651ca79533a4fc60b96b884243a3526
---
gnu/build/file-systems.scm | 15 ++++++++++-----
1 file 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 @@ (define* (mount-file-system fs #:key (root "/root")
(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 @@ (define* (mount-file-system fs #:key (root "/root")
(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 @@ (define* (mount-file-system fs #:key (root "/root")
(if options
(string-append "," options)
"")))))
+
(let* ((type (file-system-type fs))
(source (canonicalize-device-spec (file-system-device fs)))
(target (string-append root "/"
--
2.41.0