;;; GNU Guix DHCP Client. ;;; ;;; Copyright © 2015 Rohan Prinja ;;; ;;; 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 . (define-module (dhcp interfaces) #:use-module (dhcp dhcp) #:use-module (system foreign) #:use-module (srfi srfi-9) #:use-module (guix build syscalls) #:use-module (rnrs base) #:use-module (rnrs bytevectors) #:export ( hardware-address hardware-family retain-ethernet-interfaces print-hardware-address hardware-address-to-string make-net-iface make-network-interface ; wrapper for make-net-iface net-iface? net-iface-name net-iface-flags set-net-iface-flags! net-iface-ipaddr set-net-iface-ipaddr! net-iface-netmask set-net-iface-netmask! net-iface-gateway set-net-iface-gateway! net-iface-hwaddr set-net-iface-hwaddr! net-iface-dhcp)) ;;; 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)) ;; 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 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") 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-iface name flags #vu8(0 0 0 0) #vu8(0 0 0 0) #vu8(0 0 0 0) (cons #f #f)) 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 (hardware-address-to-string bv) "Convert a hardware address BV given as a 6-length bytevector to a string" (assert (= 6 (bytevector-length bv))) (let loop ((i 0) (ls '())) (if (< i 6) (let* ((byte (bytevector-u8-ref bv i)) (s (format #f "~2,'0x" byte))) (loop (1+ i) (cons ":" (cons s ls)))) (string-concatenate (reverse (cdr ls)))))) (define (retain-ethernet-interfaces ifaces) "Find all ethernet interfaces from a list of interface names" (filter (lambda (name) (string-prefix? "eth" name)) ifaces)) ;; Record type for network interfaces. ;; See also: getifaddrs (3). (define-record-type (make-net-iface name flags ipaddr netmask gateway hwaddr dhcp) net-iface? (name net-iface-name) (flags net-iface-flags set-net-iface-flags!) (ipaddr net-iface-ipaddr set-net-iface-ipaddr!) (netmask net-iface-netmask set-net-iface-netmask!) (gateway net-iface-gateway set-net-iface-gateway!) (hwaddr net-iface-hwaddr set-net-iface-hwaddr!) (dhcp net-iface-dhcp)) ;; Note: DHCP in is an instance of ;; the record type 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). ;; Create a record for the ;; interface NAME (define-syntax-rule (make-network-interface name init-state) (let* ((_ (assert (or (eq? init-state 'DHCP-INIT) (eq? init-state 'DHCP-INIT-REBOOT)))) (hwaddr (hardware-address name)) (htype (hardware-family name)) (pair (cons hwaddr htype))) (make-net-iface name 0 #vu8(0 0 0 0) #vu8(0 0 0 0) #vu8(0 0 0 0) pair (make-dhcp (generate-random-xid) init-state 0 0 0 0 0 #vu8(0 0 0 0) #vu8(0 0 0 0) #vu8(0 0 0 0)))))