[dhcp] 07/12: dhcp: code to read info about network interfaces, untested

[Rohan Prinja]

wenderen pushed a commit to branch master
in repository dhcp.

commit 55f02e34250ce9d24aa8cccbd5a2d848dd8c44a5
Author: Rohan Prinja <address@hidden>
Date:   Sat Jun 6 23:43:26 2015 +0530

    dhcp: code to read info about network interfaces, untested
---
 dhcp/interfaces.scm |  248 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 files changed, 248 insertions(+), 0 deletions(-)

diff --git a/dhcp/interfaces.scm b/dhcp/interfaces.scm
new file mode 100644
index 0000000..4b23389
--- /dev/null
+++ b/dhcp/interfaces.scm
@@ -0,0 +1,248 @@
+;;; GNU Guix DHCP Client.
+;;;
+;;; Copyright 2015 Free Software Foundation, Inc.
+;;;
+;;; This program is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (dhcp interfaces)
+  #:export (<net-interface>
+           hardware-address
+           hardware-family
+           retain-ethernet-interfaces
+           print-hardware-address
+           make-network-interface))
+
+(use-modules (system foreign)
+            (oop goops)
+            (guix build syscalls)
+            (rnrs base)
+            (rnrs bytevectors))
+
+;;; Taken/modified from (guix build syscalls) begin
+
+(define SIOCGIFHWADDR
+  (if (string-contains %host-type "linux")
+      #x8927 ; GNU/Linux
+      -1))
+
+; Maximum interface name size
+(define IF_NAMESIZE 16)
+
+(define ifreq-struct-size
+  ;; 'struct ifreq' begins with an array of IF_NAMESIZE bytes containing the
+  ;; interface name (nul-terminated), 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 '*)))
+
+;;; Taken from (guix build syscalls) end
+
+(define *libinterfaces* (dynamic-link "../lib/libinterfaces.so"))
+
+(define-syntax-rule (link-fn c-fn-name lib ret-type c-fn-args arg ...)
+  "FFI wrapper for a function defined in a .so library"
+  (let ((f (pointer->procedure ret-type
+                              (dynamic-func c-fn-name lib)
+                              c-fn-args)))
+    (f arg ...)))
+
+; Obtain a list of interfaces from getifaddrs (3)
+(define-syntax-rule (get-first-interface-ptr)
+  (link-fn "get_first_interface_ptr" *libinterfaces* '* '()))
+
+; Free the memory allocated by (find-interfaces)
+(define-syntax-rule (free-interfaces ifaddrs)
+  (link-fn "free_interfaces" *libinterfaces* void '(*) ifaddrs))
+
+; Print some information about the interfaces.
+(define-syntax-rule (print-interfaces)
+  (link-fn "print_interfaces" *libinterfaces* void '()))
+
+; Get address data for a given ifaddr
+;; (define-syntax-rule (get-sockaddr-data ifaddrs)
+;;   (pointer->string
+;;    (link-fn "get_sockaddr_data" *libinterfaces* '* '(*) ifaddrs)))
+
+; Struct type for struct ifaddrs. See also: getifaddrs (3)
+(define *ifaddrs-struct-type* (list '* '* unsigned-int '* '* '* '*))
+
+; Struct type for struct sockaddr. See also: bind (2)
+(define *sockaddr-struct-type* (list unsigned-short '*))
+
+; Given a pointer to a struct ifaddrs, parse it using
+; parse-c-struct.
+(define-syntax-rule (parse-ifaddr ifaddrs)
+  (parse-c-struct ifaddrs *ifaddrs-struct-type*))
+
+; Given a pointer to a struct sockaddr, parse it using
+; parse-c-struct.
+(define-syntax-rule (parse-sockaddr sockaddr)
+  (parse-c-struct sockaddr *sockaddr-struct-type*))
+
+; Note: In the <ifaddrs.h> library, struct ifaddrs is
+; an intrusive linked list of interface addresses.
+
+; Given a struct ifaddrs pointer which has been parsed
+; using parse-c-struct, obtain and parse the next ifaddrs
+; struct in the intrusive linked list. If we are already
+; at the end of the list, do not do anything.
+(define-syntax-rule (next-parsed-ifaddr parsed)
+  (let ((next-ptr (car parsed)))
+    (if (null-pointer? next-ptr)
+       '()
+       (parse-ifaddr (car parsed)))))
+
+(define-syntax-rule (af-inet? family)
+  "Is the family AF_INET or AF_INET6?"
+  (or (= family AF_INET) (= family AF_INET6)))
+
+(define (get-sockaddr-data sockaddr)
+  "Retrieve the data field from struct sockaddr. It might be NULL."
+  (let ((data-ptr (cadr sockaddr)))
+    (if (null-pointer? data-ptr)
+       ""
+       (pointer->string data-ptr))))
+
+(define-syntax-rule (make-dgram-sock)
+  "Create a UDP datagram socket."
+  (let ((sock (socket PF_INET SOCK_DGRAM IPPROTO_UDP)))
+    (if (= (fileno sock) -1)
+       (throw 'system-error "make-dgram-sock"
+              "make-dgram-sock on ~A: ~A"
+              (list name (strerror err))
+              (list err))
+       sock)))
+
+(define (find-interfaces ifaddrs)
+  "Find all AF_INET/AF_INET6 family network interfaces."
+  (define (helper parsed result)
+    (if (null? parsed)
+       result
+       (let* ((name (pointer->string (cadr parsed)))
+              (flags (caddr parsed))
+              (sockaddr-ptr (list-ref parsed 3))
+              (sockaddr (parse-sockaddr sockaddr-ptr))
+              (data (get-sockaddr-data sockaddr))
+              ;(_ (display (format #f "~a\n" sockaddr)))
+              (family (car sockaddr))
+              )
+         (if (af-inet? family)
+             (display (format #f "Name ~a, Family ~a\n" name family)))
+         (helper (next-parsed-ifaddr parsed)
+                 (cons (make <net-interface>
+                         #:name name
+                         #:flags flags)
+                       result)))))
+  (helper (parse-ifaddr ifaddrs) '()))
+
+(define (read-hardware-address bv idx)
+  "Read a socket address from bytevector BV at index
+IDX. BV is expected to correspond to a struct sockaddr"
+  (let* ((ushort-size (sizeof unsigned-short))
+        (start (+ ushort-size idx))
+        (hwaddr (make-bytevector 6 0))
+        (_ (bytevector-copy! bv start hwaddr 0 6)))
+    hwaddr))
+
+(define (read-hardware-family bv idx)
+  "Read the family type from bytevector BV at index
+IDX. BV is expected to correspond to a struct sockaddr"
+  (let* ((ushort-size (sizeof unsigned-short))
+        (start (+ ushort-size idx))
+        (family (bytevector-u8-ref bv idx)))
+    family))
+
+(define (hardware-property property name)
+  "Retrieve a hardware property of the interface NAME,
+like MAC address or hardware family type."
+  (let ((req (make-bytevector ifreq-struct-size))
+       (socket (make-dgram-sock)))
+    (bytevector-copy! (string->utf8 name) 0 req 0
+                      (min (string-length name) (- IF_NAMESIZE 1)))
+    (let* ((ret (%ioctl (fileno socket) SIOCGIFHWADDR
+                        (bytevector->pointer req)))
+           (err (errno)))
+      (if (zero? ret)
+         (cond ((eq? property 'address)
+                (read-hardware-address req IF_NAMESIZE))
+               ((eq? property 'family)
+                (read-hardware-family req IF_NAMESIZE)))
+         (throw 'system-error "hardware-address"
+                "hardware-address on ~A: ~A"
+                (list name (strerror err))
+                (list err))))))
+
+(define-syntax-rule (hardware-address name)
+  (hardware-property 'address name))
+
+(define-syntax-rule (hardware-family name)
+  (hardware-property 'family name))
+
+(define (print-hardware-address bv)
+  "Print a hardware address 'bv' given as a length-6 bytevector"
+  (assert (= 6 (bytevector-length bv)))
+  (let loop ((i 0))
+    (when (< i 6)
+      (format #t "~2,'0x" (bytevector-u8-ref bv i))
+      (if (< i 5) (format #t ":"))
+      (loop (1+ i))))
+  (newline))
+
+(define (retain-ethernet-interfaces ifaces)
+  "Find all ethernet interfaces from a list of
+interface names"
+  (filter (lambda (name)
+           (string-prefix? "eth" name))
+         ifaces))
+
+; Class for network interfaces.
+; See also: getifaddrs (3).
+(define-class <net-interface> ()
+  (name #:init-keyword #:name)
+  (flags #:init-keyword #:flags)
+  (ipaddr #:init-keyword #:ipaddr)
+  (netmask #:init-keyword #:netmask)
+  (gateway #:init-keyword #:gateway)
+  (hwaddr #:init-keyword #:hwaddr)
+  (dhcp #:init-keyword #:dhcp))
+
+; DHCP in <net-interface> is an instance of
+; the <dhcp> class storing the configuration
+; details for that particular interface.
+; HWADDR is a pair in which the first element
+; is the hardware address as a bytevector, and
+; the second element is the hardware type (see
+; arp/identifiers.scm).
+
+(define (make-network-interface name)
+  "Create a <network-interface> instance for the
+interface NAME"
+  (let* ((hwaddr (hardware-address name))
+        (htype (hardware-family name))
+        (pair (cons hwaddr htype)))
+    (make <net-interface>
+      #:name name
+      #:hwaddr pair)))
+
+; name = name of the network interface ("lo", "eth0", "wlan0", etc.)
+; addr = interface address
+; netmask = netmask of interface
+