A bug causing broadcast-addr and other fields AFTER the flags field in
'struct getifaddrs' to be accessed incorrectly has been fixed.
On 2 July 2015 at 17:53, Ludovic Courtès <l...@gnu.org> wrote:
> Rohan Prinja <rohan.pri...@gmail.com> skribis:
>
>> PTAL, tests to follow soon.
>
> It’s looking good now, thanks!
>
> Could you send the updated patch against master, that includes a simple
> test in tests/syscalls.scm that makes sure that ‘getifaddrs’ returns a
> possibly empty list of <interface-address>?
>
> TIA,
> Ludo’.
From a4158777607d871d028e6bacc9aeb3a1b8178f9d Mon Sep 17 00:00:00 2001
From: Rohan Prinja <rohan.pri...@gmail.com>
Date: Thu, 16 Jul 2015 13:01:36 +0530
Subject: [PATCH 1/5] guix/build/syscalls.scm: export the new functions
---
guix/build/syscalls.scm | 13 +++++++++++++
1 file changed, 13 insertions(+)
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 5afdd47..d155f49 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -44,6 +44,19 @@
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
+
+ make-ifaddrs
IFF_UP
IFF_BROADCAST
--
1.9.1
From 1a43f24c5e848f07c94e291637ef30210c87fbe5 Mon Sep 17 00:00:00 2001
From: Rohan Prinja <rohan.pri...@gmail.com>
Date: Thu, 16 Jul 2015 13:06:25 +0530
Subject: [PATCH 2/5] guix/build/syscalls.scm: add wrapper accessors for
netmask, addr and broadaddr
---
guix/build/syscalls.scm | 108 +++++++++++++++++++++++++++++++++++++++++++++---
1 file changed, 103 insertions(+), 5 deletions(-)
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index d155f49..800a3a8 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -435,6 +435,16 @@ index START + LEN - 1"
(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
@@ -445,6 +455,22 @@ index START + LEN - 1"
%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 '*))))
@@ -468,25 +494,97 @@ index START + LEN - 1"
(make-interface-address (pointer->string (make-pointer name-ptr))
flags
(make-pointer addr)
- netmask
+ (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 make-ifaddrs (reverse res))
+ (map (compose make-ifaddrs pack-ifaddrs)
+ (reverse res))
(loop (next-ifaddr curr)
(cons curr res))))))
-;; Retrieve the ifa-name field from a 'struct ifaddrs'
+;; 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: address fields in 'struct getifaddrs' are pointers to
+;; 'struct sockaddr'. In 'interface-address-broadcast-addr' we are
+;; implicitly typecasting this 'sockaddr' pointer to a
+;; 'sockaddr_in' pointer.
+
+;; 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 <interface-address> record type."
+ (let* ((addr (field iface))
+ (bv (pointer->bytevector addr %sizeof-struct-sockaddr)))
+ (bytevector->sockaddr bv)))
+
+;; Given an <interface-address> 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 <interface-address> 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 <interface-address> 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-name bv)
+(define-syntax-rule (ifaddr-next-ptr bv)
(match (read-ifaddrs bv 0)
((next name-ptr flags addr netmask broadaddr data)
- (pointer->string (make-pointer name-ptr)))))
+ 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.
--
1.9.1
From 881412da8f41ea4f4c7c621ea840feaba6fec919 Mon Sep 17 00:00:00 2001
From: Rohan Prinja <rohan.pri...@gmail.com>
Date: Thu, 16 Jul 2015 13:26:48 +0530
Subject: [PATCH 3/5] guix/build/syscalls.scm: remove unneeded low-level
accessor
---
guix/build/syscalls.scm | 27 ---------------------------
1 file changed, 27 deletions(-)
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 800a3a8..a50a9bf 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -593,33 +593,6 @@ sockaddr' from an <interface-address> record type."
((next name-ptr flags addr netmask broadaddr data)
flags)))
-(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)))
-
-;; 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 (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)))
-
-;; Is an interface the last in the intrusive linked list of struct ifaddrs?
-;; Here, IFADDRS is a bytevector aliasing the memory pointed to by
-;; a 'struct ifaddrs' pointer.
-(define-syntax-rule (last-interface? ifaddrs)
- (null-pointer? (next-ifaddr-ptr ifaddrs)))
-
(define (write-socket-address! sockaddr bv index)
"Write SOCKADDR, a socket address as returned by 'make-socket-address', to
bytevector BV at INDEX."
--
1.9.1
From 4a718e6f2f76616e06848d94022ee8d05a17bea1 Mon Sep 17 00:00:00 2001
From: Rohan Prinja <rohan.pri...@gmail.com>
Date: Thu, 16 Jul 2015 13:27:13 +0530
Subject: [PATCH 4/5] tests/syscalls.scm: add utility functions for testing
---
tests/syscalls.scm | 89 +++++++++++++++++++++++++++++++++++++++++++++++++++++-
1 file changed, 88 insertions(+), 1 deletion(-)
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index 706f3df..bf4f604 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -21,11 +21,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"
--
1.9.1
From a60e8083de3a6cec3b610be54f6bef77ce18a36d Mon Sep 17 00:00:00 2001
From: Rohan Prinja <rohan.pri...@gmail.com>
Date: Thu, 16 Jul 2015 13:27:34 +0530
Subject: [PATCH 5/5] tests/syscalls.scm: add getifaddrs tests
---
tests/syscalls.scm | 52 ++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 52 insertions(+)
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index bf4f604..3665575 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -213,6 +213,58 @@ For example, (4 2 2 2 2 1 3 3) => (4 2 1 3)."
;; 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<?))
+ (unique-names (remove-duplicates sorted-names))
+ (ifconfig (ifconfig-find-all-interfaces)))
+ (prefix?
+ (sort (ifconfig-find-all-interfaces) string<?)
+ unique-names)))
+
+(test-assert "getifaddrs-address"
+ (let* ((is-eth-iface? (lambda (i)
+ (string-prefix? "eth"
+ (interface-address-name i))))
+ (ifaddrs (getifaddrs))
+ (eth-ifaces (filter is-eth-iface? ifaddrs))
+ (getifaddrs-tmp (map interface-address-address eth-ifaces))
+ (getifaddrs-result (remove not getifaddrs-tmp))
+ (ifconfig-result (ifconfig-extract-addr-of "eth" 'address)))
+ (member ifconfig-result getifaddrs-result)))
+
+(test-assert "getifaddrs-broadcast-address"
+ (let* ((is-eth-iface? (lambda (i)
+ (string-prefix? "eth"
+ (interface-address-name i))))
+ (ifaddrs (getifaddrs))
+ (eth-ifaces (filter is-eth-iface? ifaddrs))
+ (getifaddrs-tmp (map interface-address-broadcast-addr eth-ifaces))
+ (getifaddrs-result (remove not getifaddrs-tmp))
+ (ifconfig-result (ifconfig-extract-addr-of "eth" 'broadcast)))
+ (member ifconfig-result getifaddrs-result)))
+
+(test-assert "getifaddrs-netmask-address"
+ (let* ((is-eth-iface? (lambda (i)
+ (string-prefix? "eth"
+ (interface-address-name i))))
+ (ifaddrs (getifaddrs))
+ (eth-ifaces (filter is-eth-iface? ifaddrs))
+ (getifaddrs-tmp (remove (lambda (i)
+ (null-pointer?
+ (interface-address-netmask i)))
+ eth-ifaces))
+ (getifaddrs-tmp (map interface-address-netmask-addr getifaddrs-tmp))
+ (getifaddrs-result (remove not getifaddrs-tmp))
+ (ifconfig-result (ifconfig-extract-addr-of "eth" 'netmask)))
+ (member ifconfig-result getifaddrs-result)))
+
(test-end)
--
1.9.1
