From 7585016f53e2e8be1f82ed303ae084464422c2a8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Sun, 14 Sep 2014 21:39:51 +0200
Subject: [PATCH] syscalls: Add 'network-interfaces'.

* guix/build/syscalls.scm (SIOCGIFCONF, ifconf-struct,
  ifreq-struct-size): New variables.
  (%ioctl, bytevector->string-list, network-interfaces): New
  procedures.
* tests/syscalls.scm ("network-interfaces"): New test.
---
 guix/build/syscalls.scm | 67 ++++++++++++++++++++++++++++++++++++++++-
 tests/syscalls.scm      |  8 ++++-
 2 files changed, 73 insertions(+), 2 deletions(-)

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 7a1bad7331..cd2797219f 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -30,7 +30,8 @@
             MS_MOVE
             mount
             umount
-            processes))
+            processes
+            network-interfaces))
 
 ;;; Commentary:
 ;;;
@@ -180,4 +181,68 @@ user-land process."
                     (scandir "/proc"))
         <))
 
+
+;;;
+;;; Network interfaces.
+;;;
+
+(define SIOCGIFCONF                               ;from <bits/ioctls.h>
+  (if (string-contains %host-type "linux")
+      #x8912                                      ;GNU/Linux
+      #xf00801a4))                                ;GNU/Hurd
+
+(define ifconf-struct
+  ;; 'struct ifconf', from <net/if.h>.
+  (list int                                       ;int ifc_len
+        '*))                                      ;struct ifreq *ifc_ifcu
+
+(define ifreq-struct-size
+  ;; 'struct ifreq' begins with a char array containing the interface name,
+  ;; followed by a bunch of stuff.  This is its size in bytes.
+  (if (= 8 (sizeof '*))
+      40
+      32))
+
+(define %ioctl
+  ;; The most terrible interface, live from Scheme.
+  (pointer->procedure int
+                      (dynamic-func "ioctl" (dynamic-link))
+                      (list int unsigned-long '*)))
+
+(define (bytevector->string-list bv stride len)
+  "Return the null-terminated strings found in BV every STRIDE bytes.  Read at
+most LEN bytes from BV."
+  (let loop ((bytes  (take (bytevector->u8-list bv)
+                           (min len (bytevector-length bv))))
+             (result '()))
+    (match bytes
+      (()
+       (reverse result))
+      (_
+       (loop (drop bytes stride)
+             (cons (list->string (map integer->char
+                                      (take-while (negate zero?) bytes)))
+                   result))))))
+
+(define* (network-interfaces #:optional sock)
+  "Return the list of existing network interfaces."
+  (let* ((close? (not sock))
+         (sock   (or sock (socket SOCK_STREAM AF_INET 0)))
+         (len    (* ifreq-struct-size 10))
+         (reqs   (make-bytevector len))
+         (conf   (make-c-struct ifconf-struct
+                                (list len (bytevector->pointer reqs))))
+         (ret    (%ioctl (fileno sock) SIOCGIFCONF conf))
+         (err    (errno)))
+    (when close?
+      (close-port sock))
+    (if (zero? ret)
+        (bytevector->string-list reqs ifreq-struct-size
+                                 (match (parse-c-struct conf ifconf-struct)
+                                   ((len . _) len)))
+        (throw 'system-error "network-interface-list"
+               "network-interface-list: ~A"
+               (list (strerror err))
+               (list err)))))
+
 ;;; syscalls.scm ends here
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index ab34fc825b..fa6b67bf39 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -18,7 +18,8 @@
 
 (define-module (test-syscalls)
   #:use-module (guix build syscalls)
-  #:use-module (srfi srfi-64))
+  #:use-module (srfi srfi-64)
+  #:use-module (ice-9 match))
 
 ;; Test the (guix build syscalls) module, although there's not much that can
 ;; actually be tested without being root.
@@ -42,6 +43,11 @@
       ;; Both return values have been encountered in the wild.
       (memv (system-error-errno args) (list EPERM ENOENT)))))
 
+(test-assert "network-interfaces"
+  (match (network-interfaces)
+    (((? string? names) ..1)
+     (member "lo" names))))
+
 (test-end)