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 | |
| parent | 579df5bc80fbedc59dc1b99751dcc49deab8f488 (diff) | |
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')
| -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 78d779f398a..e47ac39ab0e 100644 --- a/gnu/build/file-systems.scm +++ b/gnu/build/file-systems.scm | |||
| @@ -1156,6 +1156,14 @@ corresponds to the symbols listed in FLAGS." | |||
| 1156 | (repair (file-system-repair fs))) | 1156 | (repair (file-system-repair fs))) |
| 1157 | "Mount the file system described by FS, a <file-system> object, under ROOT." | 1157 | "Mount the file system described by FS, a <file-system> object, under ROOT." |
| 1158 | 1158 | ||
| 1159 | (define* (host-to-ip host #:optional service) | ||
| 1160 | "Return the IP address for host, which may be an IP address or a hostname." | ||
| 1161 | (let* ((aa (match (getaddrinfo host service) ((x . _) x))) | ||
| 1162 | (sa (addrinfo:addr aa)) | ||
| 1163 | (inet-addr (inet-ntop (sockaddr:fam sa) | ||
| 1164 | (sockaddr:addr sa)))) | ||
| 1165 | inet-addr)) | ||
| 1166 | |||
| 1159 | (define (mount-nfs source mount-point type flags options) | 1167 | (define (mount-nfs source mount-point type flags options) |
| 1160 | (let* ((idx (string-rindex source #\:)) | 1168 | (let* ((idx (string-rindex source #\:)) |
| 1161 | (host-part (string-take source idx)) | 1169 | (host-part (string-take source idx)) |
| @@ -1163,11 +1171,7 @@ corresponds to the symbols listed in FLAGS." | |||
| 1163 | (host (match (string-split host-part (string->char-set "[]")) | 1171 | (host (match (string-split host-part (string->char-set "[]")) |
| 1164 | (("" h "") h) | 1172 | (("" h "") h) |
| 1165 | ((h) h))) | 1173 | ((h) h))) |
| 1166 | (aa (match (getaddrinfo host "nfs") ((x . _) x))) | 1174 | (inet-addr (host-to-ip host "nfs"))) |
| 1167 | (sa (addrinfo:addr aa)) | ||
| 1168 | (inet-addr (inet-ntop (sockaddr:fam sa) | ||
| 1169 | (sockaddr:addr sa)))) | ||
| 1170 | |||
| 1171 | ;; Mounting an NFS file system requires passing the address | 1175 | ;; Mounting an NFS file system requires passing the address |
| 1172 | ;; of the server in the addr= option | 1176 | ;; of the server in the addr= option |
| 1173 | (mount source mount-point type flags | 1177 | (mount source mount-point type flags |
| @@ -1176,6 +1180,7 @@ corresponds to the symbols listed in FLAGS." | |||
| 1176 | (if options | 1180 | (if options |
| 1177 | (string-append "," options) | 1181 | (string-append "," options) |
| 1178 | ""))))) | 1182 | ""))))) |
| 1183 | |||
| 1179 | (let* ((type (file-system-type fs)) | 1184 | (let* ((type (file-system-type fs)) |
| 1180 | (source (canonicalize-device-spec (file-system-device fs))) | 1185 | (source (canonicalize-device-spec (file-system-device fs))) |
| 1181 | (target (string-append root "/" | 1186 | (target (string-append root "/" |
