Re: [PATCH] getifaddrs wrapper

[Rohan Prinja <rohan.prinja@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 4822 bytes --]

PTAL, tests to follow soon.

Thank you.

On 19 June 2015 at 17:33, Ludovic Courtès <ludo@gnu.org> wrote:
> Rohan Prinja <rohan.prinja@gmail.com> skribis:
>
>> From 668910afbe979145a7699708817e28d219ec0750 Mon Sep 17 00:00:00 2001
>> From: Rohan Prinja <rohan.prinja@gmail.com>
>> Date: Fri, 19 Jun 2015 12:05:05 +0530
>> Subject: [PATCH] add wrapper for getifaddrs (3) to guix/build/syscalls.scm
>
> Nice!
>
> I have a few comments, but nothing major.
>
> Please add a copyright line for yourself in the file.
>
> Please do not use tabs at all in the file.
>
> Could you add a test in the tests/syscalls.scm file?  Basically
> something that makes sure that ‘getifaddrs’ returns a (possibly empty)
> list, with relevant values.
>
>> +;; TODO: no support for unions yet.
>
> It’s not clear what’s “to be done” here.  Could you rephrase it maybe?
>
>> +;; This only supports broadcast addrs.
>
> Ditto.
>
>> +(define-c-struct ifaddrs                          ;<ifaddrs.h>
>> +  read-ifaddrs
>> +  write-ifaddrs!
>> +  (ifa-next '*)
>> +  (ifa-name '*)
>> +  (ifa-flags unsigned-int)
>> +  (ifa-addr '*)
>> +  (ifa-netmask '*)
>> +  (ifu-broadcastaddr '*)
>> +  (ifa-data '*))
>
> Currently ‘read-ifaddrs’ and ‘write-ifaddrs!’ are unused, but they
> should be used (see below.)
>
>> +(define-syntax-rule (bytevector-slice bv start len)
>
> Please change ‘define-syntax-rule’ to ‘define’ and add a docstring.
>
>> +  (let* ((res (make-bytevector len 0))
>> +      (_ (bytevector-copy! bv start res 0 len)))
>> +    res))
>
> Rather:
>
>   (let ((result (make-bytevector len)))
>     (bytevector-copy! bv start result 0 len)
>     result)
>
>> +;; See getifaddrs (3) for a description of
>> +;; struct ifaddrs.
>> +(define %struct-ifaddrs-type
>> +  `(* * ,unsigned-int * * * *))
>
> The comment should be “FFI type for ‘struct ifaddr’.”
>
>> +(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)))
>> +    (lambda ()
>> +      "Wrapper around getifaddrs (3)."
>> +      (let* ((ifap (make-c-struct %struct-ifaddrs-type
>> +                               struct-init))
>> +          (ifapp (scm->pointer ifap)) ; ifap ptr
>
> s/ifapp/ptr/ and s/scm->pointer/pointer-address/ because ‘make-c-struct’
> returns a pointer object.
>
>> +          (ret (proc ifapp))
>> +          (err (errno)))
>> +     (if (zero? ret)
>> +         (next-ifaddr (parse-ifaddrs ifapp))
>
> Use ‘read-ifaddrs’ instead of ‘parse-ifaddrs’.
>
>> +(define (getifaddrs)
>> +  "Obtain a list of network interfaces on the local system."
>
> s/Obtain a/Return the/
>
>> +  (let ((ifaddrs (%getifaddrs)))
>> +    (let lp ((curr ifaddrs) (res '()))
>> +      (if (last-interface? curr)
>> +       (reverse res)
>> +       (lp (next-ifaddr curr) (cons curr res))))))
>
> s/lp/loop/ for consistency
>
> This is OK, but the problem is that each object in the list that is
> returned is a tuple, so it’s not very convenient.
>
> What about defining a <interface-address> record type, and converting
> the tuples to that, so that users of ‘getifaddrs’ directly get this more
> convenient interface?  Like:
>
>   (define-record-type <interface-address>
>     (interface-address name flags)
>     interface-address?
>     (name   interface-address-name)
>     (flags  interface-address-flags))
>
> The type predicate and accessors need to be exported, of course.
>
>> +;; 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))
>
> No longer needed.
>
>> +;; 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))
>
> s/define-syntax-rule/define/
>
> Use ‘match’ instead of ‘car’; same for the following macros.
>
>> +;; 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))
>
> These become unneeded once <interface-address> is added.
>
> Could you send an updated patch?
>
> If something is unclear, please let me know!
>
> Thank you!
>
> Ludo’.

[-- Attachment #2: 0001-guix-build-syscalls.scm-refactor-according-to-code-r.patch --]
[-- Type: text/x-patch, Size: 7445 bytes --]

From 1bdbd195d7979fe2058b88d7033eaeb93b524fb7 Mon Sep 17 00:00:00 2001
From: Rohan Prinja <rohan.prinja@gmail.com>
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 <ludo@gnu.org>
+;;; Copyright © 2015 Rohan Prinja <rohan.prinja@gmail.com>
 ;;;
 ;;; 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?
+            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                          ;<ifaddrs.h>
   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 <interface-address>
+  (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 <interface-address> 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