aboutsummaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-07-25 13:06:01 +0200
committerLudovic Courtès <ludo@gnu.org>2015-07-25 14:43:45 +0200
commite7f5691d4540e2cbcbc9f22f8b593f15890057b3 (patch)
tree8428f0d6c6d255c684cc99ca8f26d7876f6f98f8 /guix
parent573b4c1ff3409fb4417ec676091f6bbc09219f19 (diff)
downloadgnu-guix-e7f5691d4540e2cbcbc9f22f8b593f15890057b3.tar
gnu-guix-e7f5691d4540e2cbcbc9f22f8b593f15890057b3.tar.gz
syscalls: Add 'network-interfaces', which wraps libc's 'getifaddrs'.
Based on discussions with Rohan Prinja <rohan.prinja@gmail.com>. * guix/build/syscalls.scm (<interface>): New record type. (write-interface, values->interface, unfold-interface-list, network-interfaces, free-ifaddrs): New procedures. (ifaddrs): New C struct. (%struct-ifaddrs-type, %sizeof-ifaddrs): New macros. * tests/syscalls.scm ("network-interfaces returns one or more interfaces", "network-interfaces returns \"lo\""): New tests.
Diffstat (limited to 'guix')
-rw-r--r--guix/build/syscalls.scm116
1 files changed, 115 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