guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[dhcp] 08/08: fix bugs in serializer and deserializer


From: Rohan Prinja
Subject: [dhcp] 08/08: fix bugs in serializer and deserializer
Date: Mon, 15 Jun 2015 19:26:23 +0000

wenderen pushed a commit to branch master
in repository dhcp.

commit 0937fcf663579d0bc7cd31a8df371e01da2b31d5
Author: Rohan Prinja <address@hidden>
Date:   Tue Jun 16 00:55:06 2015 +0530

    fix bugs in serializer and deserializer
---
 dhcp/messages.scm       |  153 +++++++++++++++++++++++++++--------------------
 tests/dhcp-messages.scm |   29 +++++++--
 2 files changed, 112 insertions(+), 70 deletions(-)

diff --git a/dhcp/messages.scm b/dhcp/messages.scm
index ff7024b..4ed2266 100644
--- a/dhcp/messages.scm
+++ b/dhcp/messages.scm
@@ -27,9 +27,14 @@
   #:use-module (rnrs enums)
   #:export (<dhcp-msg>
            make-dhcp-msg
+           make-dhcp-message ; wrapper for make-dhcp-msg
+
+           make-dhcpdiscover
 
            dhcp-msg?
 
+           bytevector-slice
+
            dhcp-msg-op set-dhcp-msg-op!
            dhcp-msg-htype set-dhcp-msg-htype!
            dhcp-msg-hlen set-dhcp-msg-hlen!
@@ -49,11 +54,19 @@
            set-broadcast-bit
            unset-broadcast-bit
            option-value
-           serialize-dhcp-message
-           deserialize-dhcp-message
-           message-type
-           make-dhcpdiscover
-           map-type-to-code))
+
+           serialize-dhcp-msg
+           deserialize-dhcp-msg
+           deserialize-options
+
+           msg-type
+
+           retrieve-secs
+           retrieve-xid
+           retrieve-ciaddr
+
+           map-type-to-code
+           map-type-to-op))
 
 ;; Magic cookie that starts off the 'options' field
 ;; in a DHCP message packet.
@@ -116,75 +129,77 @@
 ;; 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)
-  "Copy the options field OPTS from a <dhcp-message> into a
+(define (serialize-options! opts dst idx)
+  "Copy the options field OPTS from a <dhcp-msg> 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 #f, it means it does not exist, so it is
+If an option is #f, it does not exist, so it is
 simply ignored whilst serializing."
-  (let loop ((i 0))
-    (if (< i 256)
+  (let loop ((i 0) (to idx))
+    (if (< i 255)
        (let* ((opt (vector-ref opts i)))
-         (if (eq? #f opt)
-             (loop (1+ i))
+         (if (eq? #f opt) ; option not present
+             (loop (1+ i) to)
              (let ((code i)
                    (len (dhcp-option-len opt))
                    (val (dhcp-option-val opt)))
                (begin
                  (if (zero? len)
-                     (bytevector-u8-set! dst idx code)
+                     (bytevector-u8-set! dst to 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)))))))))
+                       (bytevector-u8-set! dst to code)
+                       (bytevector-u8-set! dst (1+ to) len)
+                       (bytevector-copy! val 0 dst (+ to 2) len)))
+                 (loop (1+ i) (+ to 2 len))))))
+       (bytevector-u8-set! dst to 255))))
 
-; Serialize a <dhcp-message> object into a bytevector.
-#;(define-method (serialize-dhcp-message (msg <dhcp-message>))
+(define (serialize-dhcp-msg msg)
+  "Serialize a <dhcp-message> record MSG into a bytevector"
   (let* ((res (make-bytevector 576 0))
-        (chaddr (slot-ref msg 'chaddr))
+        (chaddr (dhcp-msg-chaddr msg))
         (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) (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-u8-set! res 0 (dhcp-msg-op msg))
+    (bytevector-u8-set! res 1 (dhcp-msg-htype msg))
+    (bytevector-u8-set! res 2 (dhcp-msg-hlen msg))
+    (bytevector-u8-set! res 3 (dhcp-msg-hops msg))
+    (bytevector-u32-set! res 4 (dhcp-msg-xid msg) (endianness big))
+    (bytevector-u16-set! res 8 (dhcp-msg-secs msg) (endianness big))
+    (bytevector-u16-set! res 10 (dhcp-msg-flags msg) (endianness big))
+    (bytevector-copy! (dhcp-msg-ciaddr msg) 0 res 12 4)
+    (bytevector-copy! (dhcp-msg-yiaddr msg) 0 res 16 4)
+    (bytevector-copy! (dhcp-msg-siaddr msg) 0 res 20 4)
+    (bytevector-copy! (dhcp-msg-giaddr msg) 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! (dhcp-msg-sname msg) 0 res 44 64)
+    (bytevector-copy! (dhcp-msg-file msg) 0 res 108 128)
     (bytevector-copy! *magic-cookie* 0 res 236 4)
-    (serialize-options! (slot-ref msg 'options) res 240)
+    (serialize-options! (dhcp-msg-options msg) res 240)
     res))
 
-; 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)
+  "Read options from a bytevector SRC starting at index
+IDX and returns a vector of <dhcp-option> records. We ignore
+the PAD option since its only purpose is to pad the
+bytevector; it carries no other useful information."
   (define (helper src i res)
     (if (= i (bytevector-length src))
        res ; nothing more to read from 'src'
        (let* ((code (bytevector-u8-ref src i)))
-         (if (or (= code 0) (code 255))
-             (begin
-               (slot-set! res code (make-dhcp-option code 0 #f))
-               (helper src (+ i 1) res))
+         (if (= code 255)
+             res ; we have seen an 'end' option, stop reading
              (let* ((len (bytevector-u8-ref src (+ i 1)))
                     (val (make-bytevector len))
                     (_ (bytevector-copy! src (+ i 2) val 0 len)))
                (begin
-                 (slot-set! res code (make-dhcp-option code len val))
+                 (vector-set! res code (make-dhcp-option code len val))
                  (helper src (+ i 2 len) res)))))))
   (helper src idx (make-vector 256 #f)))
 
@@ -199,20 +214,24 @@ from BV starting at index START"
     (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 (deserialize-dhcp-msg msg)
+  (make-dhcp-msg
+    (bytevector-u8-ref msg 0) ; op
+    (bytevector-u8-ref msg 1) ; htype
+    (bytevector-u8-ref msg 2) ; hlen
+    (bytevector-u8-ref msg 3) ; hops
+    (bytevector-u32-ref msg 4 (endianness big)) ; xid
+    (bytevector-u16-ref msg 8 (endianness big)) ; secs
+    (bytevector-u16-ref msg 10 (endianness big)) ; flags
+    (bytevector-u32-ref msg 12 (endianness big)) ; ciaddr
+    (bytevector-u32-ref msg 16 (endianness big)) ; yiaddr
+    (bytevector-u32-ref msg 20 (endianness big)) ; siaddr
+    (bytevector-u32-ref msg 24 (endianness big)) ; giaddr
+    (bytevector-slice msg 28 16) ; chaddr
+    (bytevector-slice msg 44 64) ; sname
+    (bytevector-slice msg 108 128) ; file
+    (deserialize-options msg 240) ; options
+    ))
 
 ;; Set an <option> in a <dhcp-msg>.
 (define-syntax-rule (set-option! msg opt)
@@ -224,13 +243,13 @@ from BV starting at index START"
 ;; 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))
+  (let* ((opts (dhcp-msg-options msg))
         (opt (vector-ref opts code))
         (val (dhcp-option-val opt)))
     val))
 
 ;; Get the DHCP message type. See Section 9.6, RFC 2132.
-(define-syntax-rule (message-type msg)
+(define-syntax-rule (msg-type msg)
   (option-value msg 53))
 
 ;; Map a DHCP message type to its single-digit code.
@@ -251,17 +270,18 @@ from BV starting at index START"
          ((eq? 'DHCPNAK type) 2)
          (else 1))))
 
-(define (make-dhcp-msg netif type opts)
+(define (make-dhcp-message netif type opts)
   "Make an instance of <dhcp-msg> for interface NETIF
 with message type TYPE and options initialized to OPTS"
-  (let* ((pair (net-iface-hwaddr netif))
+  (let* ((dhcp (net-iface-dhcp netif))
+        (pair (net-iface-hwaddr netif))
         (chaddr (car pair))
         (htype (cdr pair))
         (hlen (bytevector-length chaddr))
         (op (map-type-to-op type))
-        (dhcp (net-iface-dhcp netif))
         (msg-type-code (map-name-to-code
-                        'DHCP-MSG-TYPE)))
+                        'DHCP-MESSAGE-TYPE))
+        (end-code (map-name-to-code 'END)))
     (begin
       (vector-set! opts
                   msg-type-code ; 53
@@ -319,7 +339,7 @@ ciaddr field in a <dhcp-msg> object."
 
 ;; TODO: figure out from 2131 exactly when to
 ;; return secs since config and when to return 0
-(define (retrieve-secs netif type)
+#;(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-msg> object."
@@ -330,5 +350,8 @@ secs field in a <dhcp-msg> object."
          (else (- (current-time) ; might need to change
                   (dhcp-config-start dhcp))))))
 
-(define-syntax-rule (make-dhcpdiscover netif opts)
-  (make-dhcp-msg netif 'DHCPDISCOVER opts))
+(define (retrieve-secs netif type)
+  0)
+
+(define (make-dhcpdiscover netif opts)
+  (make-dhcp-message netif 'DHCPDISCOVER opts))
diff --git a/tests/dhcp-messages.scm b/tests/dhcp-messages.scm
index ad0e4b7..5abca40 100644
--- a/tests/dhcp-messages.scm
+++ b/tests/dhcp-messages.scm
@@ -19,8 +19,10 @@
 
 (use-modules (srfi srfi-64)
             ((guix build syscalls) #:select (all-network-interfaces))
-            (dhcp interfaces)
             (dhcp messages)
+            (dhcp interfaces)
+            (dhcp dhcp)
+            (dhcp options base)
             (dhcp options names)
             (rnrs bytevectors))
 
@@ -31,18 +33,35 @@
      (all-network-interfaces)))
    'DHCP-INIT))
 
-(define msg
+
+(define msg-type-code (map-name-to-code
+                        'DHCP-MESSAGE-TYPE))
+
+(define original
   (make-dhcpdiscover netif (make-vector 256 #f)))
 
+(display (vector-ref (dhcp-msg-options original) 243))
+(newline) (newline)
+
 (test-begin "dhcp-messages")
 
 (test-eq "message-type"
         (map-type-to-code 'DHCPDISCOVER)
-        (bytevector-u8-ref (message-type msg) 0))
+        (bytevector-u8-ref (msg-type original) 0))
+
+(define serialized (serialize-dhcp-msg original))
+
+;(define opts (deserialize-options serialized 240))
+
+(define deserialized (deserialize-dhcp-msg serialized))
 
-(define serialized (serialize-dhcp-message msg))
+(test-eqv "fields-preserved-xid"
+         (dhcp-msg-xid deserialized)
+         (dhcp-msg-xid original))
 
-;(define deserialized (deserialize-dhcp-message msg))
+(test-equal "fields-preserved-options"
+           (dhcp-msg-options deserialized)
+           (dhcp-msg-options original))
 
 (test-end)
 



reply via email to

[Prev in Thread] Current Thread [Next in Thread]