diff options
| -rw-r--r-- | guix/build/syscalls.scm | 116 | ||||
| -rw-r--r-- | tests/syscalls.scm | 23 |
2 files changed, 138 insertions, 1 deletions
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index ca26824dc5..68f340ce7b 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -21,6 +21,8 @@ #:use-module (system foreign) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-9 gnu) #:use-module (ice-9 rdelim) #:use-module (ice-9 regex) #:use-module (ice-9 match) @@ -70,7 +72,15 @@ set-network-interface-flags set-network-interface-address set-network-interface-up - configure-network-interface)) + configure-network-interface + + interface? + interface-name + interface-flags + interface-address + interface-netmask + interface-broadcast-address + network-interfaces)) ;;; Commentary: ;;; @@ -713,4 +723,108 @@ the same type as that returned by 'make-socket-address'." (lambda () (close-port sock))))) + +;;; +;;; Details about network interfaces---aka. 'getifaddrs'. +;;; + +;; Network interfaces. XXX: We would call it <network-interface> but that +;; would collide with the ioctl wrappers above. +(define-record-type <interface> + (make-interface name flags address netmask broadcast-address) + interface? + (name interface-name) ;string + (flags interface-flags) ;or'd IFF_* values + (address interface-address) ;sockaddr | #f + (netmask interface-netmask) ;sockaddr | #f + (broadcast-address interface-broadcast-address)) ;sockaddr | #f + +(define (write-interface interface port) + (match interface + (($ <interface> name flags address) + (format port "#<interface ~s " name) + (unless (zero? (logand IFF_UP flags)) + (display "up " port)) + (if (member (sockaddr:fam address) (list AF_INET AF_INET6)) + (format port "~a " (inet-ntop (sockaddr:fam address) + (sockaddr:addr address))) + (format port "family:~a " (sockaddr:fam address))) + (format port "~a>" (number->string (object-address interface) 16))))) + +(set-record-type-printer! <interface> write-interface) + +(define (values->interface next name flags address netmask + broadcast-address data) + "Given the raw field values passed as arguments, return a pair whose car is +an <interface> object, and whose cdr is the pointer NEXT." + (define (maybe-socket-address pointer) + (if (null-pointer? pointer) + #f + (read-socket-address (pointer->bytevector pointer 50)))) ;XXX: size + + (cons (make-interface (if (null-pointer? name) + #f + (pointer->string name)) + flags + (maybe-socket-address address) + (maybe-socket-address netmask) + (maybe-socket-address broadcast-address) + ;; Ignore DATA. + ) + next)) + +(define-c-struct ifaddrs ;<ifaddrs.h> + values->interface + read-ifaddrs + write-ifaddrs! + (next '*) + (name '*) + (flags unsigned-int) + (addr '*) + (netmask '*) + (broadcastaddr '*) + (data '*)) + +(define-syntax %struct-ifaddrs-type + (identifier-syntax + `(* * ,unsigned-int * * * *))) + +(define-syntax %sizeof-ifaddrs + (identifier-syntax + (sizeof* %struct-ifaddrs-type))) + +(define (unfold-interface-list ptr) + "Call 'read-ifaddrs' on PTR and all its 'next' fields, recursively, and +return the list of resulting <interface> objects." + (let loop ((ptr ptr) + (result '())) + (if (null-pointer? ptr) + (reverse result) + (match (read-ifaddrs (pointer->bytevector ptr %sizeof-ifaddrs) + 0) + ((ifaddr . ptr) + (loop ptr (cons ifaddr result))))))) + +(define network-interfaces + (let* ((ptr (dynamic-func "getifaddrs" (dynamic-link))) + (proc (pointer->procedure int ptr (list '*)))) + (lambda () + "Return a list of <interface> objects, each denoting a configured +network interface. This is implemented using the 'getifaddrs' libc function." + (let* ((ptr (bytevector->pointer (make-bytevector (sizeof* '*)))) + (ret (proc ptr)) + (err (errno))) + (if (zero? ret) + (let* ((ptr (dereference-pointer ptr)) + (result (unfold-interface-list ptr))) + (free-ifaddrs ptr) + result) + (throw 'system-error "network-interfaces" "~A" + (list (strerror err)) + (list err))))))) + +(define free-ifaddrs + (let ((ptr (dynamic-func "freeifaddrs" (dynamic-link)))) + (pointer->procedure void ptr '(*)))) + ;;; syscalls.scm ends here diff --git a/tests/syscalls.scm b/tests/syscalls.scm index 3b71cd7b1c..090e1e7858 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -211,6 +211,29 @@ ;; We get EPERM with Linux 3.18ish and EACCES with 2.6.32. (memv (system-error-errno args) (list EPERM EACCES)))))) +(test-equal "network-interfaces returns one or more interfaces" + '(#t #t #t) + (match (network-interfaces) + ((interfaces ..1) + (list (every interface? interfaces) + (every string? (map interface-name interfaces)) + (every vector? (map interface-address interfaces)))))) + +(test-equal "network-interfaces returns \"lo\"" + (list #t (make-socket-address AF_INET (inet-pton AF_INET "127.0.0.1") 0)) + (match (filter (lambda (interface) + (string=? "lo" (interface-name interface))) + (network-interfaces)) + ((loopbacks ..1) + (list (every (lambda (lo) + (not (zero? (logand IFF_LOOPBACK (interface-flags lo))))) + loopbacks) + (match (find (lambda (lo) + (= AF_INET (sockaddr:fam (interface-address lo)))) + loopbacks) + (#f #f) + (lo (interface-address lo))))))) + (test-end) |