diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index dcca5fc..8262e0b 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2014, 2015 Ludovic Courtès ;;; Copyright © 2015 David Thompson +;;; Copyright © 2015 Rohan Prinja ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,6 +22,7 @@ #:use-module (system foreign) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) #:use-module (ice-9 rdelim) #:use-module (ice-9 regex) #:use-module (ice-9 match) @@ -57,6 +59,26 @@ clone setns + getifaddrs + + + interface-address? + interface-address-name + interface-address-flags + interface-address-data + + interface-address-addr + interface-address-netmask + interface-address-broadaddr + + ;; Wrappers around the above three functions. Each + ;; of these returns either a socket address or #f. + interface-address-address + interface-address-broadcast-addr + interface-address-netmask-addr + + remove-if-netmask-null + IFF_UP IFF_BROADCAST IFF_LOOPBACK @@ -478,6 +500,202 @@ the C structure with the given TYPES." (address (int128 ~ big)) (scopeid int32)) +(define-c-struct ifaddrs ; + read-ifaddrs + write-ifaddrs! + (ifa-next '*) + (ifa-name '*) + (ifa-flags unsigned-int) + (ifa-addr '*) + (ifa-netmask '*) + (ifu-broadcastaddr '*) + (ifa-data '*)) + +(define-record-type + (make-interface-address name flags addr netmask broadaddr data) + interface-address? + (name interface-address-name) + (flags interface-address-flags) + (addr interface-address-addr) + (netmask interface-address-netmask) + (broadaddr interface-address-broadaddr) + (data interface-address-data)) + +(define (bytevector-slice bv start len) + "Return a new bytevector (not a view into the old one) +containing the elements from BV from index START upto +index START + LEN - 1" + (let* ((res (make-bytevector len 0))) + (bytevector-copy! bv start res 0 len) + res)) + +;; FFI type for 'struct ifaddrs'. +(define %struct-ifaddrs-type + `(* * ,unsigned-int * * * *)) + +;; Size of 'struct sockaddr' in bytes. +;; See also: bind (2). +(define %sizeof-struct-sockaddr + (+ 14 (sizeof unsigned-short))) + +(define (ifaddrs-pointer->bv ptr) + "Return a bytevector aliasing the memory pointed to by a +'struct ifaddrs' pointer, passed as a pointer object PTR." + (pointer->bytevector ptr (sizeof %struct-ifaddrs-type))) + +;; Initializer for 'struct ifaddrs'. +(define %struct-ifaddrs-init + (list %null-pointer + %null-pointer + 0 + %null-pointer + %null-pointer + %null-pointer + %null-pointer)) + +(define (next-ifaddr-ptr bv) + "Return a bytevector aliasing the memory pointed to by the +ifa_next field of a struct ifaddrs* pointer passed as a +bytevector BV." + (let* ((ptr-size (sizeof '*)) + (address (cond ((= ptr-size 4) (bytevector-u32-native-ref bv 0)) + ((= ptr-size 8) (bytevector-u64-native-ref bv 0))))) + (make-pointer address))) + +;; Return the bytevector aliasing the memory pointed to by +;; the ifa-next field in a 'struct ifaddrs' pointer passed in +;; as a bytevector. +(define next-ifaddr + (compose ifaddrs-pointer->bv + next-ifaddr-ptr)) + +(define %getifaddrs + (let* ((func-ptr (dynamic-func "getifaddrs" (dynamic-link))) + (proc (pointer->procedure int func-ptr (list '*)))) + (lambda () + "Wrapper around getifaddrs (3)." + (let* ((ptr (make-c-struct %struct-ifaddrs-type + %struct-ifaddrs-init)) + (ret (proc ptr)) + (err (errno))) + (if (zero? ret) + (next-ifaddr (ifaddrs-pointer->bv ptr)) + (throw 'system-error "getifaddrs" "~S: ~A" + (list ptr (strerror err)) + (list err))))))) + +(define (make-ifaddrs bv) + "Convert a bytevector aliasing the memory pointed to by a +'struct ifaddrs' pointer into a record." + (match (read-ifaddrs bv 0) + ((next name-ptr flags addr netmask broadaddr data) + (make-interface-address (pointer->string (make-pointer name-ptr)) + flags + (make-pointer addr) + (make-pointer netmask) + (make-pointer broadaddr) + (make-pointer data))))) + +;; Is an interface the last in the intrusive linked list of struct ifaddrs? +;; Here, the only argument is a bytevector aliasing the memory pointed to by +;; a 'struct ifaddrs' pointer. +(define last-interface? + (compose null-pointer? next-ifaddr-ptr)) + +(define (pack-ifaddrs bv) + "Strip out the needless 4-byte padding after the +unsigned-int ifa-flags field" + (if (and (= 8 (sizeof '*)) + (= 4 (sizeof unsigned-int))) + (let* ((res (make-bytevector 52 0))) + (bytevector-copy! bv 0 res 0 20) + (bytevector-copy! bv 24 res 20 32) + res) + bv)) + +(define (getifaddrs) + "Return the list of network interfaces on the local system." + (let ((ifaddrs (%getifaddrs))) + (let loop ((curr ifaddrs) (res '())) + (if (last-interface? curr) + (map (compose make-ifaddrs pack-ifaddrs) + (reverse res)) + (loop (next-ifaddr curr) + (cons curr res)))))) + +;; Given a bytevector aliasing the memory pointed to by +;; a 'struct sockaddr' pointer, return a socket address. +(define-syntax-rule (bytevector->sockaddr bv) + (match (read-sockaddr-in bv 0) + ((family port address) + (if (member family (list AF_INET AF_INET6 AF_UNIX)) + (inet-ntop family address) + #f)))) + +;; Note: getifaddrs returns multiple interfaces with the same +;; e.g. on my system I see multiple "eth0"s. The difference is +;; that for one of the eth0's, the family of the address +;; pointed to by the ifu.ifa-broadaddr field is 17, which is +;; not an AF_* constant. Hence the check for "(member family ...)". + +(define (extract-address-field iface field) + "Extract a field corresponding to an IPv4 address from a 'struct +sockaddr' from an record type." + (let* ((addr (field iface)) + (bv (pointer->bytevector addr %sizeof-struct-sockaddr))) + (bytevector->sockaddr bv))) + +;; Note: address fields in 'struct getifaddrs' are pointers to +;; 'struct sockaddr'. In 'extract-address-field' we are +;; implicitly typecasting this 'sockaddr' pointer to a +;; 'sockaddr_in' pointer. + +;; Utility macro to remove all ifaces from the output IFACES of +;; (getifaddrs) that have a null-pointer in the 'netmask' field. +(define-syntax-rule (remove-if-netmask-null ifaces) + (remove (compose null-pointer? interface-address-netmask) ifaces)) + +;; Given an record IFACE, return its +;; address field as a sockaddr if it exists, otherwise return #f. +(define (interface-address-address iface) + (extract-address-field iface interface-address-addr)) + +;; Given an record IFACE, return its broadcast +;; address field as a sockaddr if it exists, otherwise return #f. +(define (interface-address-broadcast-addr iface) + (extract-address-field iface interface-address-broadaddr)) + +;; Given an record IFACE, return its netmask +;; address field as a sockaddr if it exists, otherwise return #f. +(define (interface-address-netmask-addr iface) + (extract-address-field iface interface-address-netmask)) + +;; Retrieve the ifa-next-ptr field from a 'struct ifaddrs' +;; pointer passed in as a bytevector BV. +(define-syntax-rule (ifaddr-next-ptr bv) + (match (read-ifaddrs bv 0) + ((next name-ptr flags addr netmask broadaddr data) + next))) + +;; Retrieve the bytes corresponding to the ifa-name field +;; from a 'struct ifaddrs' pointer passed in as a bytevector BV. +(define-syntax-rule (ifaddr-name-bytes bv) + (match (read-ifaddrs bv 0) + ((next name-ptr flags addr netmask broadaddr data) + name-ptr))) + +;; Retrieve the string pointed to by the ifa-name field +;; from a 'struct ifaddrs' pointer passed in as a bytevector BV. +(define-syntax-rule (ifaddr-name bv) + (pointer->string (make-pointer (ifaddr-name-bytes bv)))) + +;; Retrieve the ifa-flags field from a 'struct ifaddrs' +;; pointer passed in as a bytevector BV. +(define-syntax-rule (ifaddr-flags bv) + (match (read-ifaddrs bv 0) + ((next name-ptr flags addr netmask broadaddr data) + flags))) + (define (write-socket-address! sockaddr bv index) "Write SOCKADDR, a socket address as returned by 'make-socket-address', to bytevector BV at INDEX." diff --git a/tests/syscalls.scm b/tests/syscalls.scm index 6b614a5..73105a5 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -23,11 +23,98 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-64) - #:use-module (ice-9 match)) + #:use-module (ice-9 match) + #:use-module ((ice-9 popen) #:select (open-pipe*)) + #:use-module ((ice-9 rdelim) #:select (read-line)) + #:use-module ((ice-9 regex) #:select (string-match match:substring)) + #:use-module (rnrs bytevectors) + #:use-module (system foreign) + #:use-module ((rnrs io ports) #:select (port-eof?))) ;; Test the (guix build syscalls) module, although there's not much that can ;; actually be tested without being root. +;; Is the first character of a string #\space? +(define-syntax-rule (first-char-is-space? string) + (eq? #\space (string-ref string 0))) + +;; In the output produced by ifconfig (8), is a line +;; one that starts a new interface description? +(define-syntax-rule (line-contains-iface-name? line) + (not (or (string-null? line) + (first-char-is-space? line)))) + +(define (ifconfig-find-all-interfaces) + "List all the network interfaces as identified +by ifconfig (8)." + (let ((pipe (open-pipe* OPEN_READ "ifconfig"))) + (let lp ((line (read-line pipe)) + (res '())) + (cond ((port-eof? pipe) (reverse res)) + ((line-contains-iface-name? line) + (let* ((trimmed-line (string-trim-both line)) + (split-line (string-split trimmed-line #\space)) + (iface-name (car split-line))) + (lp (read-line pipe) + (cons iface-name res)))) + (else (lp (read-line pipe) res)))))) + +(define (extract-iface-name line) + "Extract the name of the interface from a line in the output of +ifconfig (8) which is known to be the first line describing said +interface." + (let ((str-ls (string->list line))) + (let lp ((ls str-ls) (res '())) + (if (eq? #\space (car ls)) + (apply string (reverse res)) + (lp (cdr ls) (cons (car ls) res)))))) + +(define (ifconfig-extract-addr-of iface-name type) + "Call ifconfig (8) to find out the broadcast address of the +interface whose name is a prefix of the string IFACE-NAME. The +broadcast address is returned as a printable string." + (let ((pipe (open-pipe* OPEN_READ "ifconfig"))) + (let lp ((line (read-line pipe))) + (if (eof-object? line) + #f + (if (and (line-contains-iface-name? line) + (string-prefix? iface-name + (extract-iface-name line))) + (let* ((next-line (read-line pipe)) + (search-string (cond ((eq? type 'broadcast) "Bcast:") + ((eq? type 'netmask) "Mask:") + (else "inet addr:"))) + (str-byte "[0-9]([0-9][0-9])?") + (ipaddr-regex (string-append search-string + str-byte "\\." + str-byte "\\." + str-byte "\\." + str-byte)) + (match (string-match ipaddr-regex next-line))) + (if match + (string-drop (match:substring match) (cond ((eq? type 'broadcast) 6) + ((eq? type 'netmask) 5) + (else 10))) + (lp (read-line pipe)))) + (lp (read-line pipe))))))) + +(define (prefix? ls1 ls2) + "Is list LS1 a prefix of list LS2?. This procedure +assumes that (length ls1) <= (length ls2)." + (or (null? ls1) + (and (equal? (car ls1) (car ls2)) + (prefix? (cdr ls1) (cdr ls2))))) + +(define (remove-duplicates ls) + "Remove consecutive duplicate elements from a list LS. +For example, (4 2 2 2 2 1 3 3) => (4 2 1 3)." + (cond ((< (length ls) 2) + ls) + ((equal? (car ls) (cadr ls)) + (remove-duplicates (cdr ls))) + (else + (cons (car ls) (remove-duplicates (cdr ls)))))) + (test-begin "syscalls") (test-equal "mount, ENOENT" @@ -211,6 +298,51 @@ ;; We get EPERM with Linux 3.18ish and EACCES with 2.6.32. (memv (system-error-errno args) (list EPERM EACCES)))))) +(test-assert "getifaddrs" + (let* ((ifaddrs (getifaddrs)) + (names (map interface-address-name ifaddrs))) + (member "lo" names))) + +(test-assert "ifconfig-result-is-subset-of-getifaddrs-result" + (let* ((ifaddrs (getifaddrs)) + (names (map interface-address-name ifaddrs)) + (sorted-names (sort names string