[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[dhcp] 06/12: dhcp: packet objects, untested
From: |
Rohan Prinja |
Subject: |
[dhcp] 06/12: dhcp: packet objects, untested |
Date: |
Sat, 06 Jun 2015 18:16:56 +0000 |
wenderen pushed a commit to branch master
in repository dhcp.
commit d96db6c0d2692b311d9a1f7a891da55cf0b159b2
Author: Rohan Prinja <address@hidden>
Date: Sat Jun 6 23:39:01 2015 +0530
dhcp: packet objects, untested
---
dhcp/messages.scm | 272 +++++++++++++++++++++++++++++++++++++++++++++++++++++
1 files changed, 272 insertions(+), 0 deletions(-)
diff --git a/dhcp/messages.scm b/dhcp/messages.scm
new file mode 100644
index 0000000..3fee82c
--- /dev/null
+++ b/dhcp/messages.scm
@@ -0,0 +1,272 @@
+3;;; GNU Guix DHCP Client.
+;;;
+;;; Copyright 2015 Free Software Foundation, Inc.
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(add-to-load-path (string-append (dirname (current-filename))
+ "/.."))
+
+; Module for constructing and parsing DHCP messages
+(define-module (dhcp messages)
+ #:export (<dhcp-message>
+ set-broadcast-bit
+ unset-broadcast-bit
+ option-value
+ serialize-dhcp-message
+ deserialize-dhcp-message
+ message-type
+ make-dhcpdiscover
+ map-type-to-code))
+
+(use-modules (dhcp interfaces)
+ (dhcp options base)
+ (dhcp options names)
+ (oop goops)
+ (rnrs base)
+ (rnrs bytevectors)
+ (rnrs enums))
+
+; 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*
+ (make-enumeration '(DHCPDISCOVER
+ DHCPOFFER
+ DHCPREQUEST
+ DHCPDECLINE
+ DHCPACK
+ DHCPNAK
+ 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 255 #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>))
+ (slot-set! msg 'flags #x8000))
+(define-method (unset-broadcast-bit (msg <dhcp-message>))
+ (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'"
+ (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)
+ (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)))
+ (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-copy! *magic-cookie* 0 res 236 4)
+ (serialize-options! opts 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 (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 #nil))
+ (helper src (+ i 1) res))
+ (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))
+ (helper src (+ i 2 len) res)))))))
+ (helper src idx (make-vector 255 #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))
+ res))
+
+(define-method (set-option! (msg <dhcp-message>) (opt <dhcp-option>))
+ "Set an <option> in a <dhcp-message>."
+ (vector-set! (slot-ref msg 'options)
+ (slot-ref opt 'code)
+ opt))
+
+(define-method (option-value (msg <dhcp-message>) code)
+ "Retrieve an option's value from a <dhcp-message>."
+ (let* ((opts (slot-ref msg 'options))
+ (opt (vector-ref opts code))
+ (val (slot-ref opt 'val)))
+ val))
+
+; 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.
+(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))))
+
+; Map a DHCP message type TYPE to its op.
+; 1 = BOOTREQUEST, 2 = BOOTREPLY. See Page 9, 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))))
+
+(define (make-dhcp-message netif type opts)
+ "Make an instance of <dhcp-message> for interface NETIF
+with message type TYPE and options initialized to OPTS"
+ (let* ((pair (slot-ref netif 'hwaddr))
+ (chaddr (car pair))
+ (htype (cdr pair))
+ (hlen (bytevector-length chaddr))
+ (op (map-type-to-op type))
+ (msg-type-code (map-name-to-code
+ 'DHCP-MESSAGE-TYPE)))
+ (begin
+ (vector-set! opts
+ msg-type-code ; 53
+ (make <dhcp-option>
+ #:code msg-type-code
+ #:len 1
+ #:val (map-type-to-code type)))
+ (make <dhcp-message>
+ #:op op
+ #:htype htype
+ #:hlen hlen
+ #:secs (retrieve-secs dhcp type)
+ #:chaddr chaddr
+ #:ciaddr (retrieve-ciaddr dhcp 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))
+ (zeroaddr (make-bytevector 4 0))
+ (ipaddr (slot-ref netif 'ipaddr)))
+ (cond ((or (eq? type 'DHCPDISCOVER)
+ (eq? type 'DHCPDECLINE))
+ zeroaddr)
+ ((or (eq? type 'DHCPINFORM)
+ (eq? type 'DHCPRELEASE))
+ ipaddr)
+ ((eq? type 'DHCPREQUEST)
+ (if (or (eq? state 'DHCP-BOUND)
+ (eq? state 'DHCP-RENEW)
+ (eq? state 'DHCP-REBIND))
+ 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)))
+
+(define-syntax-rule (make-dhcpdiscover netif opts)
+ (make-dhcp-message netif 'DHCPDISCOVER opts))
- [dhcp] branch master updated (30d7a60 -> d6b11dd), Rohan Prinja, 2015/06/06
- [dhcp] 02/12: dhcp: tell git to ignore log files, Rohan Prinja, 2015/06/06
- [dhcp] 05/12: dhcp: add in deprecated time-offset option, Rohan Prinja, 2015/06/06
- [dhcp] 01/12: dhcp: arp hardware address identifiers, Rohan Prinja, 2015/06/06
- [dhcp] 04/12: dhcp: change module names to reflect directory structure, Rohan Prinja, 2015/06/06
- [dhcp] 08/12: dhcp: code for sending packets, incomplete, untested, Rohan Prinja, 2015/06/06
- [dhcp] 10/12: dhcp: source for .so, used by some now-redundant functions in interfaces.scm, Rohan Prinja, 2015/06/06
- [dhcp] 06/12: dhcp: packet objects, untested,
Rohan Prinja <=
- [dhcp] 03/12: dhcp: add unused and private-use options, fix some other mistakes, Rohan Prinja, 2015/06/06
- [dhcp] 09/12: dhcp: dhcp configuration objects, Rohan Prinja, 2015/06/06
- [dhcp] 07/12: dhcp: code to read info about network interfaces, untested, Rohan Prinja, 2015/06/06
- [dhcp] 12/12: dhcp: client code, incomplete, Rohan Prinja, 2015/06/06
- [dhcp] 11/12: dhcp: tests for the (dhcp *) modules, incomplete, Rohan Prinja, 2015/06/06