syscalls: Add 'network-interfaces'.
* guix/build/syscalls.scm (SIOCGIFCONF, ifconf-struct, ifreq-struct-size): New variables. (%ioctl, bytevector->string-list, network-interfaces): New procedures. * tests/syscalls.scm ("network-interfaces"): New test.
This commit is contained in:
parent
150d8e6414
commit
7585016f53
|
@ -30,7 +30,8 @@
|
||||||
MS_MOVE
|
MS_MOVE
|
||||||
mount
|
mount
|
||||||
umount
|
umount
|
||||||
processes))
|
processes
|
||||||
|
network-interfaces))
|
||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
;;;
|
;;;
|
||||||
|
@ -180,4 +181,68 @@ user-land process."
|
||||||
(scandir "/proc"))
|
(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
|
;;; syscalls.scm ends here
|
||||||
|
|
|
@ -18,7 +18,8 @@
|
||||||
|
|
||||||
(define-module (test-syscalls)
|
(define-module (test-syscalls)
|
||||||
#:use-module (guix build 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
|
;; Test the (guix build syscalls) module, although there's not much that can
|
||||||
;; actually be tested without being root.
|
;; actually be tested without being root.
|
||||||
|
@ -42,6 +43,11 @@
|
||||||
;; Both return values have been encountered in the wild.
|
;; Both return values have been encountered in the wild.
|
||||||
(memv (system-error-errno args) (list EPERM ENOENT)))))
|
(memv (system-error-errno args) (list EPERM ENOENT)))))
|
||||||
|
|
||||||
|
(test-assert "network-interfaces"
|
||||||
|
(match (network-interfaces)
|
||||||
|
(((? string? names) ..1)
|
||||||
|
(member "lo" names))))
|
||||||
|
|
||||||
(test-end)
|
(test-end)
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue