diff options
| -rw-r--r-- | guix/build/syscalls.scm | 67 | ||||
| -rw-r--r-- | tests/syscalls.scm | 8 |
2 files changed, 73 insertions, 2 deletions
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 7a1bad7331..cd2797219f 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -30,7 +30,8 @@ MS_MOVE mount umount - processes)) + processes + network-interfaces)) ;;; Commentary: ;;; @@ -180,4 +181,68 @@ user-land process." (scandir "/proc")) <)) + +;;; +;;; Network interfaces. +;;; + +(define SIOCGIFCONF ;from <bits/ioctls.h> + (if (string-contains %host-type "linux") + #x8912 ;GNU/Linux + #xf00801a4)) ;GNU/Hurd + +(define ifconf-struct + ;; 'struct ifconf', from <net/if.h>. + (list int ;int ifc_len + '*)) ;struct ifreq *ifc_ifcu + +(define ifreq-struct-size + ;; 'struct ifreq' begins with a char array containing the interface name, + ;; followed by a bunch of stuff. This is its size in bytes. + (if (= 8 (sizeof '*)) + 40 + 32)) + +(define %ioctl + ;; The most terrible interface, live from Scheme. + (pointer->procedure int + (dynamic-func "ioctl" (dynamic-link)) + (list int unsigned-long '*))) + +(define (bytevector->string-list bv stride len) + "Return the null-terminated strings found in BV every STRIDE bytes. Read at +most LEN bytes from BV." + (let loop ((bytes (take (bytevector->u8-list bv) + (min len (bytevector-length bv)))) + (result '())) + (match bytes + (() + (reverse result)) + (_ + (loop (drop bytes stride) + (cons (list->string (map integer->char + (take-while (negate zero?) bytes))) + result)))))) + +(define* (network-interfaces #:optional sock) + "Return the list of existing network interfaces." + (let* ((close? (not sock)) + (sock (or sock (socket SOCK_STREAM AF_INET 0))) + (len (* ifreq-struct-size 10)) + (reqs (make-bytevector len)) + (conf (make-c-struct ifconf-struct + (list len (bytevector->pointer reqs)))) + (ret (%ioctl (fileno sock) SIOCGIFCONF conf)) + (err (errno))) + (when close? + (close-port sock)) + (if (zero? ret) + (bytevector->string-list reqs ifreq-struct-size + (match (parse-c-struct conf ifconf-struct) + ((len . _) len))) + (throw 'system-error "network-interface-list" + "network-interface-list: ~A" + (list (strerror err)) + (list err))))) + ;;; syscalls.scm ends here diff --git a/tests/syscalls.scm b/tests/syscalls.scm index ab34fc825b..fa6b67bf39 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -18,7 +18,8 @@ (define-module (test-syscalls) #:use-module (guix build syscalls) - #:use-module (srfi srfi-64)) + #:use-module (srfi srfi-64) + #:use-module (ice-9 match)) ;; Test the (guix build syscalls) module, although there's not much that can ;; actually be tested without being root. @@ -42,6 +43,11 @@ ;; Both return values have been encountered in the wild. (memv (system-error-errno args) (list EPERM ENOENT))))) +(test-assert "network-interfaces" + (match (network-interfaces) + (((? string? names) ..1) + (member "lo" names)))) + (test-end) |