[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[dhcp] 01/03: dhcp: some bug fixes to make tests pass. deserialize does
|
From: |
Rohan Prinja |
|
Subject: |
[dhcp] 01/03: dhcp: some bug fixes to make tests pass. deserialize does not yet work |
|
Date: |
Tue, 09 Jun 2015 01:39:15 +0000 |
wenderen pushed a commit to branch master
in repository dhcp.
commit ac3d7b512cf3459977803c50db6bcacf171b05c5
Author: Rohan Prinja <address@hidden>
Date: Mon Jun 8 19:56:36 2015 +0530
dhcp: some bug fixes to make tests pass. deserialize does not yet work
---
dhcp/client.scm | 10 +--
dhcp/dhcp.scm | 16 ++++-
dhcp/interfaces.scm | 19 ++++-
dhcp/messages.scm | 200 +++++++++++++++++++++++++++++------------------
dhcp/options/names.scm | 2 +-
tests/dhcp-messages.scm | 16 +++-
6 files changed, 167 insertions(+), 96 deletions(-)
diff --git a/dhcp/client.scm b/dhcp/client.scm
index be613e2..e9cf826 100644
--- a/dhcp/client.scm
+++ b/dhcp/client.scm
@@ -7,7 +7,8 @@ coding: utf-8
"/.."))
; DHCP client module
-(define-module (dhcp client))
+(define-module (dhcp client)
+ #:export (main))
(use-modules (dhcp dhcp)
(ice-9 getopt-long)
@@ -47,10 +48,3 @@ dhcp-client [options]
; Seed the random state.
(set! *random-state* (random-state-from-platform))
-
-(define (generate-xid)
- "Generate a random 32-bit number to be used as a transaction id."
- (random (expt 2 32)))
-
-; Generate initial transaction id.
-(define xid (generate-xid))
diff --git a/dhcp/dhcp.scm b/dhcp/dhcp.scm
index 4805450..30a6eab 100644
--- a/dhcp/dhcp.scm
+++ b/dhcp/dhcp.scm
@@ -25,7 +25,9 @@
dhcp-release
dhcp-stop
dhcp-inform
- get-most-recent-lease))
+ get-most-recent-lease
+ generate-different-xid
+ generate-random-xid))
(use-modules (dhcp messages)
(oop goops)
@@ -59,9 +61,19 @@
offered_t1_renew
offered_t2_rebind
- (config-started-at #:init-form 0)
+ (config-started-at #:init-form (current-time))
dhcpdiscover-sent-at)
+; Generate a random 32-bit number to be used as
+; a transaction id.
+(define (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."
+ (1+ (slot-ref dhcp 'xid)))
+
; config-start: time when config process began
; dhcpdiscover-sent-at: time at which most recent
; DHCPDISCOVER packet was sent
diff --git a/dhcp/interfaces.scm b/dhcp/interfaces.scm
index 4b23389..272bdb2 100644
--- a/dhcp/interfaces.scm
+++ b/dhcp/interfaces.scm
@@ -15,6 +15,9 @@
;;; You should have received a copy of the GNU General Public License
;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+(add-to-load-path (string-append (dirname (current-filename))
+ "/.."))
+
(define-module (dhcp interfaces)
#:export (<net-interface>
hardware-address
@@ -23,7 +26,8 @@
print-hardware-address
make-network-interface))
-(use-modules (system foreign)
+(use-modules (dhcp dhcp)
+ (system foreign)
(oop goops)
(guix build syscalls)
(rnrs base)
@@ -232,17 +236,22 @@ interface names"
; the second element is the hardware type (see
; arp/identifiers.scm).
-(define (make-network-interface name)
+(define (make-network-interface name init-state)
"Create a <network-interface> instance for the
interface NAME"
- (let* ((hwaddr (hardware-address name))
+ (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)))
+ #: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
-
diff --git a/dhcp/messages.scm b/dhcp/messages.scm
index 3fee82c..5000edd 100644
--- a/dhcp/messages.scm
+++ b/dhcp/messages.scm
@@ -31,6 +31,7 @@
map-type-to-code))
(use-modules (dhcp interfaces)
+ (dhcp dhcp)
(dhcp options base)
(dhcp options names)
(oop goops)
@@ -73,15 +74,13 @@
; 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 255 #nil)
+ (options #:init-form (make-vector 256 #nil)
#:init-keyword #:options))
; Note: client initializes #hops to 0.
; Note: yiaddr, siaddr, giaddr are always 0 for
; client->server DHCP messages. See Page 32, RFC 2131.
-(define *big-endian* (endianness big))
-
; 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>))
@@ -90,48 +89,53 @@
(slot-set! msg 'flags 0))
(define (serialize-options! opts dst idx)
- "Copy the options field from a <dhcp-message> into a bytevector
-while serializing. 'opts' is a vector, 'dst' is a bytevector.
-Copying starts at index 'idx' in the 'dst' bytevector.
-This function mutates 'dst'"
+ "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.
+If an option is #nil, it means it does not exist, so it is
+simply ignored whilst serializing."
(let loop ((i 0))
(if (< i 256)
- (let* ((opt (vector-ref opts i))
- (code i)
- (len (slot-ref opt 'len))
- (val (slot-ref opt 'val)))
- (begin
- (if (zero? len)
- (bytevector-u8-set! dst idx code)
+ (let* ((opt (vector-ref opts i)))
+ (if (eq? #nil opt)
+ (loop (1+ i))
+ (let ((code i)
+ (len (slot-ref opt 'len))
+ (val (slot-ref opt 'val)))
(begin
- (bytevector-u8-set! dst idx code)
- (bytevector-u8-set! dst (1+ idx) len)
- (bytevector-copy! val 0 dst (+ idx 2) len)))
- (loop (1+ i)))))))
+ (if (zero? len)
+ (bytevector-u8-set! dst idx code)
+ (begin
+ (bytevector-u8-set! dst idx code)
+ (bytevector-u8-set! dst (1+ idx) len)
+ (bytevector-copy! val 0 dst (+ idx 2) len)))
+ (loop (1+ i)))))))))
; Serialize a <dhcp-message> object into a bytevector.
(define-method (serialize-dhcp-message (msg <dhcp-message>))
- (let ((res (make-bytevector 576 0))
- (chaddr (slot-ref msg 'chaddr))
- (sname (slot-ref msg 'sname))
- (file (slot-ref msg 'file))
- (opts (slot-ref msg 'options)))
+ (let* ((res (make-bytevector 576 0))
+ (chaddr (slot-ref msg 'chaddr))
+ (chaddr-len (bytevector-length chaddr))
+ (padded-chaddr (make-bytevector 16 0))
+ (_ (bytevector-copy! chaddr 0
+ padded-chaddr (- 16 chaddr-len)
+ chaddr-len)))
(bytevector-u8-set! res 0 (slot-ref msg 'op))
(bytevector-u8-set! res 1 (slot-ref msg 'htype))
(bytevector-u8-set! res 2 (slot-ref msg 'hlen))
(bytevector-u8-set! res 3 (slot-ref msg 'hops))
- (bytevector-u32-set! res 4 (slot-ref msg 'xid) *big-endian*)
- (bytevector-u16-set! res 8 (slot-ref msg 'secs) *big-endian*)
- (bytevector-u16-set! res 10 (slot-ref msg 'flags) *big-endian*)
- (bytevector-u32-set! res 12 (slot-ref msg 'ciaddr) *big-endian*)
- (bytevector-u32-set! res 16 (slot-ref msg 'yiaddr) *big-endian*)
- (bytevector-u32-set! res 20 (slot-ref msg 'siaddr) *big-endian*)
- (bytevector-u32-set! res 24 (slot-ref msg 'giaddr) *big-endian*)
- (bytevector-copy! chaddr 0 res 28 16)
- (bytevector-copy! sname 0 res 44 64)
- (bytevector-copy! file 0 res 108 128)
+ (bytevector-u32-set! res 4 (slot-ref msg 'xid) (endianness big))
+ (bytevector-u16-set! res 8 (slot-ref msg 'secs) (endianness big))
+ (bytevector-u16-set! res 10 (slot-ref msg 'flags) (endianness big))
+ (bytevector-copy! (slot-ref msg 'ciaddr) 0 res 12 4)
+ (bytevector-copy! (slot-ref msg 'yiaddr) 0 res 16 4)
+ (bytevector-copy! (slot-ref msg 'siaddr) 0 res 20 4)
+ (bytevector-copy! (slot-ref msg 'giaddr) 0 res 24 4)
+ (bytevector-copy! padded-chaddr 0 res 28 16)
+ (bytevector-copy! (slot-ref msg 'sname) 0 res 44 64)
+ (bytevector-copy! (slot-ref msg 'file) 0 res 108 128)
(bytevector-copy! *magic-cookie* 0 res 236 4)
- (serialize-options! opts res 240)
+ (serialize-options! (slot-ref msg 'options) res 240)
res))
; Read options from a bytevector 'src' starting at index
@@ -151,34 +155,56 @@ This function mutates 'dst'"
(begin
(slot-set! res code (make-dhcp-option code len val))
(helper src (+ i 2 len) res)))))))
- (helper src idx (make-vector 255 #nil)))
+ (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.
-; Given a serialized DHCP message, parse it and
-; return a <dhcp-message> object.
-(define (deserialize-dhcp-message msg)
- (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 *big-endian*))
- (slot-set! res 'secs (bytevector-u16-ref msg 8 *big-endian*))
- (slot-set! res 'flags (bytevector-u16-ref msg 10 *big-endian*))
- (slot-set! res 'ciaddr (bytevector-u32-ref msg 12 *big-endian*))
- (slot-set! res 'yiaddr (bytevector-u32-ref msg 16 *big-endian*))
- (slot-set! res 'siaddr (bytevector-u32-ref msg 20 *big-endian*))
- (slot-set! res 'giaddr (bytevector-u32-ref msg 24 *big-endian*))
- (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))
+;; (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))
+
+(define (bytevector-slice bv start len)
+ "Return a new bytevector with LEN elements sliced
+from BV starting at index START"
+ (let ((res (make-bytevector len)))
+ (bytevector-copy! bv start res 0 len)
res))
+(define (deserialize-dhcp-message msg)
+ (make <dhcp-message>
+ #:op (bytevector-u8-ref msg 0)
+ #:htype (bytevector-u8-ref msg 1)
+ #:hops (bytevector-u8-ref msg 2)
+ #:xid (bytevector-u32-ref msg 4 (endianness big))
+ #:secs (bytevector-u16-ref msg 8 (endianness big))
+ #:flags (bytevector-u16-ref msg 10 (endianness big))
+ #:ciaddr (bytevector-u32-ref msg 12 (endianness big))
+ #:yiaddr (bytevector-u32-ref msg 16 (endianness big))
+ #:siaddr (bytevector-u32-ref msg 20 (endianness big))
+ #:giaddr (bytevector-u32-ref msg 24 (endianness big))
+ ; 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)
@@ -204,14 +230,15 @@ This function mutates 'dst'"
(1+ ((enum-set-indexer *dhcp-message-types*) type))))
; Map a DHCP message type TYPE to its op.
-; 1 = BOOTREQUEST, 2 = BOOTREPLY. See Page 9, RFC 2131.
+; 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*))
- (cond ((eq? 'DHCPOFFER type) 1)
- ((eq? 'DHCPACK type) 1)
- ((eq? 'DHCPNAK type) 1)
- (else 'BOOTREQUEST))))
+ (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
@@ -221,6 +248,7 @@ with message type TYPE and options initialized to OPTS"
(htype (cdr pair))
(hlen (bytevector-length chaddr))
(op (map-type-to-op type))
+ (dhcp (slot-ref netif 'dhcp))
(msg-type-code (map-name-to-code
'DHCP-MESSAGE-TYPE)))
(begin
@@ -229,21 +257,36 @@ with message type TYPE and options initialized to OPTS"
(make <dhcp-option>
#:code msg-type-code
#:len 1
- #:val (map-type-to-code type)))
+ #: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 dhcp type)
+ #:secs (retrieve-secs netif type)
#:chaddr chaddr
- #:ciaddr (retrieve-ciaddr dhcp type)
+ #:ciaddr (retrieve-ciaddr netif type)
#:options opts))))
-(define (retrieve-ciaddr dhcp type)
- "Given a dhcp object DHCP and the message type
-TYPE, return the appropriate value for the ciaddr
-field in a <dhcp-message> object."
- (let* ((state (slot-ref dhcp 'state))
+(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)))
+ (if (eq? state 'DHCP-INIT)
+ (let* ((new-xid (generate-random-xid))
+ (_ (slot-set! dhcp 'xid new-xid)))
+ new-xid)
+ (slot-ref dhcp 'xid))))
+
+(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))
(zeroaddr (make-bytevector 4 0))
(ipaddr (slot-ref netif 'ipaddr)))
(cond ((or (eq? type 'DHCPDISCOVER)
@@ -259,14 +302,19 @@ field in a <dhcp-message> object."
ipaddr
zeroaddr)))))
-(define (retrieve-secs dhcp type)
- "Given a dhcp object DHCP and the message type
-TYPE, return the appropriate value for the secs
-field in a <dhcp-message> object."
- (cond ((or (eq? type 'DHCPDECLINE)
- (eq? type 'DHCPRELEASE))
- 0)
- (else 'TODO)))
+; 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)))
+ (cond ((or (eq? type 'DHCPDECLINE)
+ (eq? type 'DHCPRELEASE))
+ 0)
+ (else (- (current-time) ; might need to change
+ (slot-ref dhcp
+ 'config-started-at))))))
(define-syntax-rule (make-dhcpdiscover netif opts)
(make-dhcp-message netif 'DHCPDISCOVER opts))
diff --git a/dhcp/options/names.scm b/dhcp/options/names.scm
index 64a30f9..3b2e516 100644
--- a/dhcp/options/names.scm
+++ b/dhcp/options/names.scm
@@ -286,4 +286,4 @@
; Map a DHCP option name to its option code,
; which lies between 0 and 255 inclusive.
(define-syntax-rule (map-name-to-code name)
- (1+ ((enum-set-indexer *option-names*) name)))
+ ((enum-set-indexer *option-names*) name))
diff --git a/tests/dhcp-messages.scm b/tests/dhcp-messages.scm
index 2ed435d..42a82fc 100644
--- a/tests/dhcp-messages.scm
+++ b/tests/dhcp-messages.scm
@@ -23,22 +23,30 @@
(use-modules (srfi srfi-64)
((guix build syscalls) #:select (all-network-interfaces))
(dhcp interfaces)
- (dhcp messages))
+ (dhcp messages)
+ (dhcp options names)
+ (oop goops)
+ (rnrs bytevectors))
(define netif
(make-network-interface
(car
(retain-ethernet-interfaces
- (all-network-interfaces)))))
+ (all-network-interfaces)))
+ 'DHCP-INIT))
(define msg
- (make-dhcpdiscover netif (make-vector 255 0)))
+ (make-dhcpdiscover netif (make-vector 256 #nil)))
(test-begin "dhcp-messages")
(test-eq "message-type"
(map-type-to-code 'DHCPDISCOVER)
- (message-type msg))
+ (bytevector-u8-ref (message-type msg) 0))
+
+(define serialized (serialize-dhcp-message msg))
+
+;(define deserialized (deserialize-dhcp-message msg))
(test-end)