[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[dhcp] 07/12: dhcp: code to read info about network interfaces, untested
From: |
Rohan Prinja |
Subject: |
[dhcp] 07/12: dhcp: code to read info about network interfaces, untested |
Date: |
Sat, 06 Jun 2015 18:16:57 +0000 |
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
+
- [dhcp] branch master updated (30d7a60 -> d6b11dd), Rohan Prinja, 2015/06/06
- [dhcp] 02/12: dhcp: tell git to ignore log files, Rohan Prinja, 2015/06/06
- [dhcp] 05/12: dhcp: add in deprecated time-offset option, Rohan Prinja, 2015/06/06
- [dhcp] 01/12: dhcp: arp hardware address identifiers, Rohan Prinja, 2015/06/06
- [dhcp] 04/12: dhcp: change module names to reflect directory structure, Rohan Prinja, 2015/06/06
- [dhcp] 08/12: dhcp: code for sending packets, incomplete, untested, Rohan Prinja, 2015/06/06
- [dhcp] 10/12: dhcp: source for .so, used by some now-redundant functions in interfaces.scm, Rohan Prinja, 2015/06/06
- [dhcp] 06/12: dhcp: packet objects, untested, Rohan Prinja, 2015/06/06
- [dhcp] 03/12: dhcp: add unused and private-use options, fix some other mistakes, Rohan Prinja, 2015/06/06
- [dhcp] 09/12: dhcp: dhcp configuration objects, Rohan Prinja, 2015/06/06
- [dhcp] 07/12: dhcp: code to read info about network interfaces, untested,
Rohan Prinja <=
- [dhcp] 12/12: dhcp: client code, incomplete, Rohan Prinja, 2015/06/06
- [dhcp] 11/12: dhcp: tests for the (dhcp *) modules, incomplete, Rohan Prinja, 2015/06/06