mirror of git://git.savannah.gnu.org/guix/dhcp.git
dhcp: switch to srfi-9 records + numerous small fixes to follow style guide
This commit is contained in:
Rohan Prinja
parent
a60c0f4e88
commit
f591e1fd4d
|
|
@ -20,7 +20,7 @@
|
|||
coding: utf-8
|
||||
!#
|
||||
|
||||
; DHCP client module
|
||||
;; DHCP client module
|
||||
(define-module (dhcp client)
|
||||
#:use-module (dhcp dhcp)
|
||||
#:use-module (ice-9 getopt-long)
|
||||
|
|
@ -59,5 +59,5 @@ dhcp-client [options]
|
|||
(begin
|
||||
(display "Hello, World!") (newline)))))
|
||||
|
||||
; Seed the random state.
|
||||
;; Seed the random state.
|
||||
(set! *random-state* (random-state-from-platform))
|
||||
|
|
|
|||
|
|
@ -17,7 +17,6 @@
|
|||
|
||||
(define-module (dhcp dhcp)
|
||||
#:use-module (dhcp messages)
|
||||
#:use-module (oop goops)
|
||||
#:use-module (rnrs base)
|
||||
#:use-module (ice-9 regex)
|
||||
#:use-module (srfi srfi-9)
|
||||
|
|
@ -27,6 +26,12 @@
|
|||
dhcp-state set-dhcp-state!
|
||||
dhcp-tries set-dhcp-tries!
|
||||
|
||||
dhcp-ip-addr set-dhcp-ip-addr!
|
||||
dhcp-sn-mask set-dhcp-sn-mask!
|
||||
dhcp-gw-addr set-dhcp-gw-addr!
|
||||
|
||||
dhcp-config-start set-dhcp-config-start!
|
||||
|
||||
dhcp-start
|
||||
dhcp-renew
|
||||
dhcp-release
|
||||
|
|
@ -37,8 +42,8 @@
|
|||
generate-different-xid
|
||||
generate-random-xid))
|
||||
|
||||
;; Class for DHCP objects.
|
||||
;; A <dhcp> object is held by an interface, and contains
|
||||
;; Record type for DHCP objects.
|
||||
;; A <dhcp> record is held by an interface, and contains
|
||||
;; information about the configuration process for that
|
||||
;; specific interface.
|
||||
(define-record-type <dhcp>
|
||||
|
|
@ -59,21 +64,21 @@
|
|||
(lease-ack dhcp-lease-ack) ; time since last DHCPACK
|
||||
|
||||
;; Offered IP address, subnet mask and gateway address.
|
||||
(ip-addr dhcp-ip-addr)
|
||||
(sn-mask dhcp-sn-mask)
|
||||
(gw-addr dhcp-gw-addr)
|
||||
(ip-addr dhcp-ip-addr set-dhcp-ip-addr!)
|
||||
(sn-mask dhcp-sn-mask set-dhcp-sn-mask!)
|
||||
(gw-addr dhcp-gw-addr set-dhcp-gw-addr!)
|
||||
|
||||
;; Time at which configuration process was started.
|
||||
(config-start dhcp-config-start set-dhcp-config-start!))
|
||||
|
||||
(define (generate-random-xid)
|
||||
"Generate a random 32-bit number to be used as
|
||||
a transaction id."
|
||||
;; Generate a random 32-bit number to be used as
|
||||
;; a transaction id.
|
||||
(define-syntax-rule (generate-random-xid)
|
||||
(random (expt 2 32)))
|
||||
|
||||
(define-method (generate-different-xid (dhcp <dhcp>))
|
||||
"Generate a new, different transaction id for
|
||||
a dhcp object. We simply increment the old one."
|
||||
;; Generate a new, different transaction id for
|
||||
;; a dhcp object. We simply increment the old one.
|
||||
(define-syntax-rule (generate-different-xid dhcp)
|
||||
(1+ (dhcp-xid dhcp)))
|
||||
|
||||
;; TODO: make a separate lease file for each interface rather than
|
||||
|
|
@ -146,7 +151,7 @@ interface NETIF."
|
|||
'DHCP-INIT-REBOOT
|
||||
'DHCP-INIT)))
|
||||
(display (format #f "start-config: entered ~a state\n" dhcp-state))
|
||||
(slot-set! (slot-ref netif 'dhcp) (current-time))
|
||||
(slot-set! (net-iface-dhcp netif) (current-time))
|
||||
(if (eq? dhcp-state 'INIT)
|
||||
(begin
|
||||
(wait-desync)
|
||||
|
|
|
|||
|
|
@ -18,16 +18,24 @@
|
|||
(define-module (dhcp interfaces)
|
||||
#:use-module (dhcp dhcp)
|
||||
#:use-module (system foreign)
|
||||
#:use-module (oop goops)
|
||||
#:use-module (srfi srfi-9)
|
||||
#:use-module (guix build syscalls)
|
||||
#:use-module (rnrs base)
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:export (<net-interface>
|
||||
#:export (<net-iface>
|
||||
hardware-address
|
||||
hardware-family
|
||||
retain-ethernet-interfaces
|
||||
print-hardware-address
|
||||
make-network-interface))
|
||||
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
|
||||
|
||||
|
|
@ -36,7 +44,7 @@
|
|||
#x8927 ; GNU/Linux
|
||||
-1))
|
||||
|
||||
; Maximum interface name size
|
||||
;; Maximum interface name size.
|
||||
(define IF_NAMESIZE 16)
|
||||
|
||||
(define ifreq-struct-size
|
||||
|
|
@ -55,7 +63,7 @@
|
|||
|
||||
;;; Taken from (guix build syscalls) end
|
||||
|
||||
(define *libinterfaces* (dynamic-link "../lib/libinterfaces.so"))
|
||||
(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"
|
||||
|
|
@ -64,46 +72,37 @@
|
|||
c-fn-args)))
|
||||
(f arg ...)))
|
||||
|
||||
; Obtain a list of interfaces from getifaddrs (3)
|
||||
;; 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)
|
||||
;; 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)
|
||||
;; 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)
|
||||
;; 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.
|
||||
;; 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.
|
||||
;; 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.
|
||||
;; 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.
|
||||
;; 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)
|
||||
|
|
@ -125,10 +124,7 @@
|
|||
"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))
|
||||
(throw 'system-error "make-dgram-sock")
|
||||
sock)))
|
||||
|
||||
(define (find-interfaces ifaddrs)
|
||||
|
|
@ -147,9 +143,11 @@
|
|||
(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)
|
||||
(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) '()))
|
||||
|
||||
|
|
@ -213,41 +211,48 @@ interface names"
|
|||
(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))
|
||||
;; Record type for network interfaces.
|
||||
;; See also: getifaddrs (3).
|
||||
(define-record-type <net-iface>
|
||||
(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))
|
||||
|
||||
; 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).
|
||||
;; Note: DHCP in <net-iface> is an instance of
|
||||
;; the <dhcp> 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).
|
||||
|
||||
(define (make-network-interface name init-state)
|
||||
"Create a <network-interface> instance for the
|
||||
interface NAME"
|
||||
;; Create a <net-iface> 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-interface>
|
||||
#:name name
|
||||
#:hwaddr pair
|
||||
#:ipaddr #vu8(0 0 0 0)
|
||||
#:dhcp (make <dhcp>
|
||||
#:state init-state
|
||||
#:xid (generate-random-xid)))))
|
||||
|
||||
; name = name of the network interface ("lo", "eth0", "wlan0", etc.)
|
||||
; addr = interface address
|
||||
; netmask = netmask of interface
|
||||
(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)))))
|
||||
|
|
|
|||
|
|
@ -21,11 +21,31 @@
|
|||
#:use-module (dhcp dhcp)
|
||||
#:use-module (dhcp options base)
|
||||
#:use-module (dhcp options names)
|
||||
#:use-module (oop goops)
|
||||
#:use-module (srfi srfi-9)
|
||||
#:use-module (rnrs base)
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:use-module (rnrs enums)
|
||||
#:export (<dhcp-message>
|
||||
#:export (<dhcp-msg>
|
||||
make-dhcp-msg
|
||||
|
||||
dhcp-msg?
|
||||
|
||||
dhcp-msg-op set-dhcp-msg-op!
|
||||
dhcp-msg-htype set-dhcp-msg-htype!
|
||||
dhcp-msg-hlen set-dhcp-msg-hlen!
|
||||
dhcp-msg-hops set-dhcp-msg-hops!
|
||||
dhcp-msg-xid set-dhcp-msg-xid!
|
||||
dhcp-msg-secs set-dhcp-msg-secs!
|
||||
dhcp-msg-flags set-dhcp-msg-flags!
|
||||
dhcp-msg-ciaddr set-dhcp-msg-ciaddr!
|
||||
dhcp-msg-yiaddr set-dhcp-msg-yiaddr!
|
||||
dhcp-msg-siaddr set-dhcp-msg-siaddr!
|
||||
dhcp-msg-giaddr set-dhcp-msg-giaddr!
|
||||
dhcp-msg-chaddr set-dhcp-msg-chaddr!
|
||||
dhcp-msg-sname set-dhcp-msg-sname!
|
||||
dhcp-msg-file set-dhcp-msg-file!
|
||||
dhcp-msg-options set-dhcp-msg-options
|
||||
|
||||
set-broadcast-bit
|
||||
unset-broadcast-bit
|
||||
option-value
|
||||
|
|
@ -35,12 +55,12 @@
|
|||
make-dhcpdiscover
|
||||
map-type-to-code))
|
||||
|
||||
; Magic cookie that starts off the 'options' field
|
||||
; in a DHCP message packet.
|
||||
;; Magic cookie that starts off the 'options' field
|
||||
;; in a DHCP message packet.
|
||||
(define *magic-cookie* #vu8(99 130 83 99))
|
||||
|
||||
; Valid types for a DHCP message.
|
||||
(define *dhcp-message-types*
|
||||
;; Valid types for a DHCP message.
|
||||
(define *dhcp-msg-types*
|
||||
(make-enumeration '(DHCPDISCOVER
|
||||
DHCPOFFER
|
||||
DHCPREQUEST
|
||||
|
|
@ -50,41 +70,56 @@
|
|||
DHCPRELEASE
|
||||
DHCPINFORM)))
|
||||
|
||||
; DHCP message object.
|
||||
; See page 8, RFC 2131 for the message format.
|
||||
(define-class <dhcp-message> ()
|
||||
(op #:init-keyword #:op)
|
||||
(htype #:init-keyword #:htype)
|
||||
(hlen #:init-keyword #:hlen)
|
||||
(hops #:init-form 0)
|
||||
(xid #:init-keyword #:xid)
|
||||
(secs #:init-keyword #:secs)
|
||||
(flags #:init-form 0)
|
||||
(ciaddr #:init-keyword #:ciaddr)
|
||||
(yiaddr #:init-form (make-bytevector 4 0))
|
||||
(siaddr #:init-form (make-bytevector 4 0))
|
||||
(giaddr #:init-form (make-bytevector 4 0))
|
||||
(chaddr #:init-keyword #:chaddr)
|
||||
(sname #:init-form (make-bytevector 64 0))
|
||||
(file #:init-form (make-bytevector 128 0))
|
||||
; Options are represented as a fixed-length
|
||||
; vector in which each element is either a
|
||||
; <dhcp-option> object or #nil.
|
||||
(options #:init-form (make-vector 256 #nil)
|
||||
#:init-keyword #:options))
|
||||
;; DHCP message object.
|
||||
;; See page 8, RFC 2131 for the message format.
|
||||
(define-record-type <dhcp-msg>
|
||||
(make-dhcp-msg op
|
||||
htype hlen
|
||||
hops
|
||||
xid
|
||||
secs
|
||||
flags
|
||||
ciaddr
|
||||
yiaddr siaddr giaddr
|
||||
chaddr
|
||||
sname
|
||||
file
|
||||
options)
|
||||
|
||||
dhcp-msg?
|
||||
|
||||
(op dhcp-msg-op set-dhcp-msg-op!)
|
||||
(htype dhcp-msg-htype set-dhcp-msg-htype!)
|
||||
(hlen dhcp-msg-hlen set-dhcp-msg-hlen!)
|
||||
(hops dhcp-msg-hops set-dhcp-msg-hops!)
|
||||
(xid dhcp-msg-xid set-dhcp-msg-xid!)
|
||||
(secs dhcp-msg-secs set-dhcp-msg-secs!)
|
||||
(flags dhcp-msg-flags set-dhcp-msg-flags!)
|
||||
(ciaddr dhcp-msg-ciaddr set-dhcp-msg-ciaddr!)
|
||||
(yiaddr dhcp-msg-yiaddr set-dhcp-msg-yiaddr!)
|
||||
(siaddr dhcp-msg-siaddr set-dhcp-msg-siaddr!)
|
||||
(giaddr dhcp-msg-giaddr set-dhcp-msg-giaddr!)
|
||||
(chaddr dhcp-msg-chaddr set-dhcp-msg-chaddr!)
|
||||
(sname dhcp-msg-sname set-dhcp-msg-sname!)
|
||||
(file dhcp-msg-file set-dhcp-msg-file!)
|
||||
|
||||
;; Options are represented as a fixed-length
|
||||
;; vector in which each element is either a
|
||||
;; <dhcp-option> object or #nil.
|
||||
(options dhcp-msg-options set-dhcp-msg-options))
|
||||
|
||||
; Note: client initializes #hops to 0.
|
||||
; Note: yiaddr, siaddr, giaddr are always 0 for
|
||||
; client->server DHCP messages. See Page 32, RFC 2131.
|
||||
;; Note: client initializes #hops to 0.
|
||||
;; Note: yiaddr, siaddr, giaddr are always 0 for
|
||||
;; client->server DHCP messages. See Page 32, RFC 2131.
|
||||
|
||||
; Set/unset the BROADCAST bit in the 'flags' field. The
|
||||
; remaining bits are always zero, see Figure 2, RFC 2131.
|
||||
(define-method (set-broadcast-bit (msg <dhcp-message>))
|
||||
(slot-set! msg 'flags #x8000))
|
||||
(define-method (unset-broadcast-bit (msg <dhcp-message>))
|
||||
(slot-set! msg 'flags 0))
|
||||
;; Set/unset the BROADCAST bit in the 'flags' field. The
|
||||
;; remaining bits are always zero, see Figure 2, RFC 2131.
|
||||
(define-syntax-rule (set-broadcast-bit msg)
|
||||
(set-dhcp-msg-flags #x8000))
|
||||
(define-syntax-rule (unset-broadcast-bit msg)
|
||||
(set-dhcp-msg-flags 0))
|
||||
|
||||
(define (serialize-options! opts dst idx)
|
||||
#;(define (serialize-options! opts dst idx)
|
||||
"Copy the options field OPTS from a <dhcp-message> into a
|
||||
bytevector. OPTS is a vector, DST is a bytevector.
|
||||
Copying starts at index IDX in DST. This function mutates DST.
|
||||
|
|
@ -108,7 +143,7 @@ simply ignored whilst serializing."
|
|||
(loop (1+ i)))))))))
|
||||
|
||||
; Serialize a <dhcp-message> object into a bytevector.
|
||||
(define-method (serialize-dhcp-message (msg <dhcp-message>))
|
||||
#;(define-method (serialize-dhcp-message (msg <dhcp-message>))
|
||||
(let* ((res (make-bytevector 576 0))
|
||||
(chaddr (slot-ref msg 'chaddr))
|
||||
(chaddr-len (bytevector-length chaddr))
|
||||
|
|
@ -136,7 +171,7 @@ simply ignored whilst serializing."
|
|||
|
||||
; Read options from a bytevector 'src' starting at index
|
||||
; 'idx' and returns a vector of <dhcp-option> objects.
|
||||
(define (deserialize-options src idx)
|
||||
#;(define (deserialize-options src idx)
|
||||
(define (helper src i res)
|
||||
(if (= i (bytevector-length src))
|
||||
res ; nothing more to read from 'src'
|
||||
|
|
@ -153,31 +188,9 @@ simply ignored whilst serializing."
|
|||
(helper src (+ i 2 len) res)))))))
|
||||
(helper src idx (make-vector 256 #nil)))
|
||||
|
||||
; 'Pad' and 'End' are the only zero-length options.
|
||||
; In RFC 4039, 'Rapid Commit' (also zero-length) was introduced.
|
||||
; This is not yet supported in this client implementation.
|
||||
|
||||
;; (define (deserialize-dhcp-message msg)
|
||||
;; "Given a serialized DHCP packet MSG, parse it and
|
||||
;; return a <dhcp-message> object."
|
||||
;; (let ((res (make <dhcp-message>)))
|
||||
;; (slot-set! res 'op (bytevector-u8-ref msg 0))
|
||||
;; (slot-set! res 'htype (bytevector-u8-ref msg 1))
|
||||
;; (slot-set! res 'hlen (bytevector-u8-ref msg 2))
|
||||
;; (slot-set! res 'hops (bytevector-u8-ref msg 3))
|
||||
;; (slot-set! res 'xid (bytevector-u32-ref msg 4 (endianness big)))
|
||||
;; (slot-set! res 'secs (bytevector-u16-ref msg 8 (endianness big)))
|
||||
;; (slot-set! res 'flags (bytevector-u16-ref msg 10 (endianness big)))
|
||||
;; (slot-set! res 'ciaddr (bytevector-u32-ref msg 12 (endianness big)))
|
||||
;; (slot-set! res 'yiaddr (bytevector-u32-ref msg 16 (endianness big)))
|
||||
;; (slot-set! res 'siaddr (bytevector-u32-ref msg 20 (endianness big)))
|
||||
;; (slot-set! res 'giaddr (bytevector-u32-ref msg 24 (endianness big)))
|
||||
;; (slot-set! res 'chaddr (bytevector-copy! msg 28 (slot-ref res 'chaddr) 0 16))
|
||||
;; (slot-set! res 'sname (bytevector-copy! msg 44 (slot-ref res 'sname) 0 64))
|
||||
;; (slot-set! res 'file (bytevector-copy! msg 108 (slot-ref res 'file) 0 128))
|
||||
;; ; we skip the 4-byte magic cookie that starts off the options field
|
||||
;; (slot-set! res 'options (deserialize-options msg 240))
|
||||
;; res))
|
||||
;; 'Pad' and 'End' are the only zero-length options.
|
||||
;; In RFC 4039, 'Rapid Commit' (also zero-length) was introduced.
|
||||
;; This is not yet supported in this client implementation.
|
||||
|
||||
(define (bytevector-slice bv start len)
|
||||
"Return a new bytevector with LEN elements sliced
|
||||
|
|
@ -186,7 +199,7 @@ from BV starting at index START"
|
|||
(bytevector-copy! bv start res 0 len)
|
||||
res))
|
||||
|
||||
(define (deserialize-dhcp-message msg)
|
||||
#;(define (deserialize-dhcp-message msg)
|
||||
(make <dhcp-message>
|
||||
#:op (bytevector-u8-ref msg 0)
|
||||
#:htype (bytevector-u8-ref msg 1)
|
||||
|
|
@ -201,90 +214,96 @@ from BV starting at index START"
|
|||
; TODO: chaddr
|
||||
#:options (deserialize-options msg 240)))
|
||||
|
||||
(define-method (set-option! (msg <dhcp-message>) (opt <dhcp-option>))
|
||||
"Set an <option> in a <dhcp-message>."
|
||||
(vector-set! (slot-ref msg 'options)
|
||||
(dhcp-option-code opt)
|
||||
opt))
|
||||
;; Set an <option> in a <dhcp-msg>.
|
||||
(define-syntax-rule (set-option! msg opt)
|
||||
(let ((opts (dhcp-msg-options msg)))
|
||||
(vector-set! opts
|
||||
(dhcp-option-code opt)
|
||||
opt)))
|
||||
|
||||
(define-method (option-value (msg <dhcp-message>) code)
|
||||
"Retrieve an option's value from a <dhcp-message>."
|
||||
;; Retrieve an option's value from a <dhcp-msg>
|
||||
;; record MSG given its code CODE.
|
||||
(define-syntax-rule (option-value msg code)
|
||||
(let* ((opts (slot-ref msg 'options))
|
||||
(opt (vector-ref opts code))
|
||||
(val (dhcp-option-val opt)))
|
||||
val))
|
||||
|
||||
; Get the DHCP message type. See Section 9.6, RFC 2132.
|
||||
;; Get the DHCP message type. See Section 9.6, RFC 2132.
|
||||
(define-syntax-rule (message-type msg)
|
||||
(option-value msg 53))
|
||||
|
||||
; Map a DHCP message type to its single-digit code.
|
||||
; See Section 9.6, RFC 2132.
|
||||
;; Map a DHCP message type to its single-digit code.
|
||||
;; See Section 9.6, RFC 2132.
|
||||
(define-syntax-rule (map-type-to-code type)
|
||||
(begin
|
||||
(assert (enum-set-member? type *dhcp-message-types*))
|
||||
(1+ ((enum-set-indexer *dhcp-message-types*) type))))
|
||||
(assert (enum-set-member? type *dhcp-msg-types*))
|
||||
(1+ ((enum-set-indexer *dhcp-msg-types*) type))))
|
||||
|
||||
; Map a DHCP message type TYPE to its op.
|
||||
; 1 = BOOTREQUEST, 2 = BOOTREPLY. See Pages 9, 27, 36 of
|
||||
; RFC 2131.
|
||||
;; Map a DHCP message type TYPE to its op.
|
||||
;; 1 = BOOTREQUEST, 2 = BOOTREPLY. See Pages 9, 27, 36 of
|
||||
;; RFC 2131.
|
||||
(define-syntax-rule (map-type-to-op type)
|
||||
(begin
|
||||
(assert (enum-set-member? type *dhcp-message-types*))
|
||||
(assert (enum-set-member? type *dhcp-msg-types*))
|
||||
(cond ((eq? 'DHCPOFFER type) 2)
|
||||
((eq? 'DHCPACK type) 2)
|
||||
((eq? 'DHCPNAK type) 2)
|
||||
(else 1))))
|
||||
|
||||
(define (make-dhcp-message netif type opts)
|
||||
"Make an instance of <dhcp-message> for interface NETIF
|
||||
(define (make-dhcp-msg netif type opts)
|
||||
"Make an instance of <dhcp-msg> for interface NETIF
|
||||
with message type TYPE and options initialized to OPTS"
|
||||
(let* ((pair (slot-ref netif 'hwaddr))
|
||||
(let* ((pair (net-iface-hwaddr netif))
|
||||
(chaddr (car pair))
|
||||
(htype (cdr pair))
|
||||
(hlen (bytevector-length chaddr))
|
||||
(op (map-type-to-op type))
|
||||
(dhcp (slot-ref netif 'dhcp))
|
||||
(dhcp (net-iface-dhcp netif))
|
||||
(msg-type-code (map-name-to-code
|
||||
'DHCP-MESSAGE-TYPE)))
|
||||
'DHCP-MSG-TYPE)))
|
||||
(begin
|
||||
(vector-set! opts
|
||||
msg-type-code ; 53
|
||||
(make <dhcp-option>
|
||||
#:code msg-type-code
|
||||
#:len 1
|
||||
#:val (make-bytevector 1 (map-type-to-code type))))
|
||||
(make <dhcp-message>
|
||||
#:op op
|
||||
#:xid (retrieve-xid netif)
|
||||
#:htype htype
|
||||
#:hlen hlen
|
||||
#:secs (retrieve-secs netif type)
|
||||
#:chaddr chaddr
|
||||
#:ciaddr (retrieve-ciaddr netif type)
|
||||
#:options opts))))
|
||||
(make-dhcp-option
|
||||
msg-type-code
|
||||
1
|
||||
(make-bytevector 1 (map-type-to-code type))))
|
||||
(make-dhcp-msg
|
||||
op
|
||||
htype hlen
|
||||
0
|
||||
(retrieve-xid netif)
|
||||
(retrieve-secs netif type)
|
||||
0
|
||||
(retrieve-ciaddr netif type)
|
||||
#vu8(0 0 0 0) #vu8(0 0 0 0) #vu8(0 0 0 0)
|
||||
chaddr
|
||||
(make-bytevector 64 0)
|
||||
(make-bytevector 128 0)
|
||||
opts))))
|
||||
|
||||
(define (retrieve-xid netif)
|
||||
"Given a <net-interface> NETIF, return the
|
||||
its current transaction ID, unless it has just
|
||||
started out, in which give it a new transaction
|
||||
ID and return that"
|
||||
(let* ((dhcp (slot-ref netif 'dhcp))
|
||||
(state (slot-ref dhcp 'state)))
|
||||
(let* ((dhcp (net-iface-dhcp netif))
|
||||
(state (dhcp-state dhcp)))
|
||||
(if (eq? state 'DHCP-INIT)
|
||||
(let* ((new-xid (generate-random-xid))
|
||||
(_ (slot-set! dhcp 'xid new-xid)))
|
||||
(_ (set-dhcp-xid! dhcp new-xid)))
|
||||
new-xid)
|
||||
(slot-ref dhcp 'xid))))
|
||||
(dhcp-xid dhcp))))
|
||||
|
||||
(define (retrieve-ciaddr netif type)
|
||||
"Given a <net-interface> NETIF and the message
|
||||
type TYPE, return the appropriate value for the
|
||||
ciaddr field in a <dhcp-message> object."
|
||||
(let* ((dhcp (slot-ref netif 'dhcp))
|
||||
(state (slot-ref dhcp 'state))
|
||||
ciaddr field in a <dhcp-msg> object."
|
||||
(let* ((dhcp (net-iface-dhcp netif))
|
||||
(state (dhcp-state dhcp))
|
||||
(zeroaddr (make-bytevector 4 0))
|
||||
(ipaddr (slot-ref netif 'ipaddr)))
|
||||
(ipaddr (net-iface-ipaddr netif)))
|
||||
(cond ((or (eq? type 'DHCPDISCOVER)
|
||||
(eq? type 'DHCPDECLINE))
|
||||
zeroaddr)
|
||||
|
|
@ -298,19 +317,18 @@ ciaddr field in a <dhcp-message> object."
|
|||
ipaddr
|
||||
zeroaddr)))))
|
||||
|
||||
; TODO: figure out from 2131 exactly when to
|
||||
; return secs since config and when to return 0
|
||||
;; TODO: figure out from 2131 exactly when to
|
||||
;; return secs since config and when to return 0
|
||||
(define (retrieve-secs netif type)
|
||||
"Given a <net-interface> NETIF and the message
|
||||
type TYPE, return the appropriate value for the
|
||||
secs field in a <dhcp-message> object."
|
||||
(let ((dhcp (slot-ref netif 'dhcp)))
|
||||
secs field in a <dhcp-msg> object."
|
||||
(let ((dhcp (net-iface-dhcp netif)))
|
||||
(cond ((or (eq? type 'DHCPDECLINE)
|
||||
(eq? type 'DHCPRELEASE))
|
||||
0)
|
||||
(else (- (current-time) ; might need to change
|
||||
(slot-ref dhcp
|
||||
'config-started-at))))))
|
||||
(dhcp-config-start dhcp))))))
|
||||
|
||||
(define-syntax-rule (make-dhcpdiscover netif opts)
|
||||
(make-dhcp-message netif 'DHCPDISCOVER opts))
|
||||
(make-dhcp-msg netif 'DHCPDISCOVER opts))
|
||||
|
|
|
|||
|
|
@ -19,24 +19,6 @@
|
|||
#include <ifaddrs.h>
|
||||
#include <stdio.h>
|
||||
|
||||
void print_interfaces() {
|
||||
struct ifaddrs *ifaddr, *itr;
|
||||
if (getifaddrs(&ifaddr) == -1) {
|
||||
return;
|
||||
}
|
||||
for (itr = ifaddr; itr; itr = itr->ifa_next) {
|
||||
if (itr->ifa_addr == NULL) {
|
||||
continue;
|
||||
}
|
||||
int family = itr->ifa_addr->sa_family;
|
||||
if (family == AF_INET || family == AF_INET6) {
|
||||
printf("Name: %s, ", itr->ifa_name);
|
||||
printf("Address: %s, ", family == AF_INET ? "AF_INET" : family == AF_INET6 ? "AF_INET6" : "");
|
||||
printf("Flags: %d\n", itr->ifa_flags);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
char* get_sockaddr_data(struct ifaddrs* ifaddr) {
|
||||
return ifaddr->ifa_addr->sa_data;
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue