From 1bdbd195d7979fe2058b88d7033eaeb93b524fb7 Mon Sep 17 00:00:00 2001
From: Rohan Prinja
Date: Thu, 2 Jul 2015 16:28:24 +0530
Subject: [PATCH] guix/build/syscalls.scm: refactor according to code review
---
guix/build/syscalls.scm | 150 ++++++++++++++++++++++++++++++++----------------
1 file changed, 101 insertions(+), 49 deletions(-)
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index e5d296a..5afdd47 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015 Ludovic Courtès
+;;; Copyright © 2015 Rohan Prinja
;;;
;;; This file is part of GNU Guix.
;;;
@@ -20,6 +21,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)
@@ -36,7 +38,12 @@
swapon
swapoff
processes
- getifaddrs
+ getifaddrs
+
+
+ interface-address?
+ interface-address-name
+ interface-address-flags
IFF_UP
IFF_BROADCAST
@@ -382,8 +389,6 @@ the C structure with the given TYPES."
(address (int128 ~ big))
(scopeid int32))
-;; TODO: no support for unions yet.
-;; This only supports broadcast addrs.
(define-c-struct ifaddrs ;
read-ifaddrs
write-ifaddrs!
@@ -395,67 +400,114 @@ the C structure with the given TYPES."
(ifu-broadcastaddr '*)
(ifa-data '*))
-(define-syntax-rule (bytevector-slice bv start len)
- (let* ((res (make-bytevector len 0))
- (_ (bytevector-copy! bv start res 0 len)))
+(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))
-;; See getifaddrs (3) for a description of
-;; struct ifaddrs.
+;; FFI type for 'struct ifaddrs'.
(define %struct-ifaddrs-type
`(* * ,unsigned-int * * * *))
+;; Initializer for 'struct ifaddrs'.
+(define %struct-ifaddrs-init
+ (list %null-pointer
+ %null-pointer
+ 0
+ %null-pointer
+ %null-pointer
+ %null-pointer
+ %null-pointer))
+
(define %getifaddrs
- (let* ((ptr (dynamic-func "getifaddrs" (dynamic-link)))
- (proc (pointer->procedure int ptr (list '*)))
- (struct-init (list %null-pointer
- %null-pointer
- 0
- %null-pointer
- %null-pointer
- %null-pointer
- %null-pointer)))
+ (let* ((func-ptr (dynamic-func "getifaddrs" (dynamic-link)))
+ (proc (pointer->procedure int func-ptr (list '*))))
(lambda ()
"Wrapper around getifaddrs (3)."
- (let* ((ifap (make-c-struct %struct-ifaddrs-type
- struct-init))
- (ifapp (scm->pointer ifap)) ; ifap ptr
- (ret (proc ifapp))
- (err (errno)))
- (if (zero? ret)
- (next-ifaddr (parse-ifaddrs ifapp))
- (throw 'system-error "getifaddrs" "~S: ~A"
- (list ifap (strerror err))
- (list err)))))))
+ (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)
+ netmask
+ (make-pointer broadaddr)
+ (make-pointer data)))))
(define (getifaddrs)
- "Obtain a list of network interfaces on the local system."
+ "Return the list of network interfaces on the local system."
(let ((ifaddrs (%getifaddrs)))
- (let lp ((curr ifaddrs) (res '()))
+ (let loop ((curr ifaddrs) (res '()))
(if (last-interface? curr)
- (reverse res)
- (lp (next-ifaddr curr) (cons curr res))))))
-
-;; Given a pointer to a struct ifaddrs, parse it into a list.
-(define-syntax-rule (parse-ifaddrs ptr)
- (parse-c-struct ptr %struct-ifaddrs-type))
-
-;; Retrieve a bytevector aliasing the memory pointed to by the
-;; ifa_next struct ifaddrs* pointer.
-(define-syntax-rule (next-ifaddr ifaddrs)
- (parse-c-struct (car ifaddrs) %struct-ifaddrs-type))
-
-;; Retrieve interface name.
-(define-syntax-rule (ifaddr-name ifaddrs)
- (pointer->string (cadr ifaddrs)))
-
-;; Retrieve interface flags.
-(define-syntax-rule (ifaddr-flags ifaddrs)
- (list-ref ifaddrs 2))
+ (map make-ifaddrs (reverse res))
+ (loop (next-ifaddr curr)
+ (cons curr res))))))
+
+;; Retrieve the ifa-name field from a 'struct ifaddrs'
+;; pointer passed in as a bytevector BV.
+(define-syntax-rule (ifaddr-name bv)
+ (match (read-ifaddrs bv 0)
+ ((next name-ptr flags addr netmask broadaddr data)
+ (pointer->string (make-pointer name-ptr)))))
+
+;; 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 (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? (car 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
--
1.9.1