[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[dhcp] 03/03: dhcp: switch to srfi-9 records + numerous small fixes to f
|
From: |
Rohan Prinja |
|
Subject: |
[dhcp] 03/03: dhcp: switch to srfi-9 records + numerous small fixes to follow style guide |
|
Date: |
Wed, 10 Jun 2015 04:18:07 +0000 |
wenderen pushed a commit to branch master
in repository dhcp.
commit f591e1fd4d2255039cf0c839ac42c7dc7385c8ce
Author: Rohan Prinja <address@hidden>
Date: Wed Jun 10 09:47:51 2015 +0530
dhcp: switch to srfi-9 records + numerous small fixes to follow style guide
---
dhcp/client.scm | 4 +-
dhcp/dhcp.scm | 31 ++++---
dhcp/interfaces.scm | 141 +++++++++++++++--------------
dhcp/messages.scm | 248 +++++++++++++++++++++++++++------------------------
lib/interfaces.c | 18 ----
5 files changed, 226 insertions(+), 216 deletions(-)
diff --git a/dhcp/client.scm b/dhcp/client.scm
index ced9a40..34a609a 100644
--- a/dhcp/client.scm
+++ b/dhcp/client.scm
@@ -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))
diff --git a/dhcp/dhcp.scm b/dhcp/dhcp.scm
index 74aed88..7948487 100644
--- a/dhcp/dhcp.scm
+++ b/dhcp/dhcp.scm
@@ -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)
diff --git a/dhcp/interfaces.scm b/dhcp/interfaces.scm
index 5b01e12..549f7a1 100644
--- a/dhcp/interfaces.scm
+++ b/dhcp/interfaces.scm
@@ -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))
-
-; 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 init-state)
- "Create a <network-interface> instance for the
-interface NAME"
+;; 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))
+
+;; 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).
+
+;; 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)))))
diff --git a/dhcp/messages.scm b/dhcp/messages.scm
index 84ff350..ba2c016 100644
--- a/dhcp/messages.scm
+++ b/dhcp/messages.scm
@@ -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))
diff --git a/lib/interfaces.c b/lib/interfaces.c
index 1e69ebc..94a315d 100644
--- a/lib/interfaces.c
+++ b/lib/interfaces.c
@@ -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;
}