[Gd-chatter] r10917 - in trunk/libraries: layer packetizer packetizer/packetizer-test pcap
hannes at gwydiondylan.org
hannes at gwydiondylan.org
Tue Oct 3 20:16:00 CEST 2006
Author: hannes
Date: Tue Oct 3 20:15:56 2006
New Revision: 10917
Modified:
trunk/libraries/layer/layer.dylan
trunk/libraries/packetizer/ethernet.dylan
trunk/libraries/packetizer/ipv4.dylan
trunk/libraries/packetizer/leaf-frames.dylan
trunk/libraries/packetizer/packetizer-test/packetizer-test.dylan
trunk/libraries/packetizer/packetizer.dylan
trunk/libraries/packetizer/protocol-definer-macro.dylan
trunk/libraries/packetizer/stretchy-byte-vector.dylan
trunk/libraries/pcap/pcap.dylan
Log:
Bug: 7299
*more fixes for assembling packets
*layer works again...
Modified: trunk/libraries/layer/layer.dylan
==============================================================================
--- trunk/libraries/layer/layer.dylan (original)
+++ trunk/libraries/layer/layer.dylan Tue Oct 3 20:15:56 2006
@@ -2,20 +2,75 @@
Author: Andreas Bogk, Hannes Mehnert
Copyright: (C) 2006, All rights reserved.
-define class <undefined-field-error> (<error>)
+//a layer contains a fan-out, demultiplexer and fan-in.
+// it also has a send-socket for sending packets
+//
+//a socket contains one input and one output
+// two types of sockets can be created
+// raw-socket without any filters: raw-socket(layer)
+// connects itself to fan-in and fan-out
+// socket (layer, type-code/port/whatever, source-address: source-address)
+// creates an output for the filter rule in the demultiplexer,
+// connects its input to it
+// adds an completer with template-frame (generated from filter rule),
+// connects its output to it
+//
+// a socket implements the following methods:
+// sendto(socket, destination, payload)
+// which
+// receive-callback(socket, method) // method gets one argument: a frame
+// which is called in push-data-aux(socket-input, socket, frame)
+//
+// an adapter connects layers with sockets and does adapter-specific stuff
+// it installs a decapsulator and encapsulator
+// creates a socket in bottom layer (with protocol-specific information in filter rule)
+// sets socket receive-callback to curry(push-data, upper-layer-input)
+// sets upper-layer send-socket to itself
+
+//
+// ethernet-layer
+// fan-in fan-out
+// demultiplexer
+//
+// ethernet-socket
+// completer demux-output
+// (#x800) (#x800)
+//
+// ip-over-ethernet-adapter
+// encapsulator decapsulator
+// (dest: find-mac)
+
+define open generic fan-in (object :: <layer>) => (res :: <fan-in>);
+define open generic demultiplexer (object :: <layer>) => (res :: <demultiplexer>);
+define open generic sockets (object :: <layer>) => (res :: <collection>);
+
+define abstract class <layer> (<object>)
+ constant slot fan-in :: <fan-in> = make(<fan-in>);
+ constant slot demultiplexer :: <demultiplexer> = make(<demultiplexer>);
+ constant slot sockets :: <collection> = make(<stretchy-vector>);
+end;
+
+define open generic demultiplexer-output (object :: <socket>) => (res :: <object>);
+define open generic demultiplexer-output-setter (value :: <object>, object :: <socket>) => (res :: <object>);
+define open generic decapsulator (object :: <socket>) => (res :: <decapsulator>);
+define open generic completer (object :: <socket>) => (res :: <completer>);
+define open generic completer-setter (value :: <completer>, object :: <socket>) => (res :: <completer>);
+
+define abstract class <socket> (<object>)
+ constant slot decapsulator :: <decapsulator> = make(<decapsulator>);
+ slot demultiplexer-output;
+ slot completer :: <completer>;
+end;
+
+define abstract class <adapter> (<object>)
end;
-define generic ethernet-fan-in (object :: <ethernet-layer>) => (res :: <fan-in>);
-define generic demultiplexer (object :: <object>) => (res :: <demultiplexer>);
define generic ethernet-interface (object :: <ethernet-layer>) => (res :: <ethernet-interface>);
define generic ethernet-interface-setter (object :: <ethernet-interface>, object2 :: <ethernet-layer>) => (res :: <ethernet-interface>);
define generic default-mac-address (object :: <ethernet-layer>) => (res :: <mac-address>);
define generic default-mac-address-setter (object :: <mac-address>, object2 :: <ethernet-layer>) => (res :: <mac-address>);
-define class <ethernet-layer> (<object>)
- constant slot ethernet-fan-in :: <fan-in> = make(<fan-in>);
- constant slot demultiplexer :: <demultiplexer> = make(<demultiplexer>);
- //slot sockets :: <collection> = make(<stretchy-vector>);
+define class <ethernet-layer> (<layer>)
slot ethernet-interface :: <ethernet-interface>,
required-init-keyword: ethernet-interface:;
slot default-mac-address :: <mac-address> = mac-address("00:de:ad:be:ef:01"),
@@ -24,61 +79,27 @@
define method initialize (layer :: <ethernet-layer>,
#rest rest, #key, #all-keys);
- connect(layer.ethernet-fan-in, layer.ethernet-interface);
+ connect(layer.fan-in, layer.ethernet-interface);
connect(layer.ethernet-interface, layer.demultiplexer);
end;
-define generic template-frame (object :: <completer>) => (res :: <frame>);
-define class <completer> (<filter>)
- constant slot template-frame :: <frame>, required-init-keyword: template-frame:;
-end;
-
-define method push-data-aux (input :: <push-input>,
- node :: <completer>,
- frame :: <container-frame>);
- for (field in node.template-frame.fields)
- unless (field.getter(frame))
- let default-field-value = field.getter(node.template-frame);
- if (default-field-value)
- field.setter(default-field-value, frame);
- elseif (~ field.fixup-function)
- format-out("Field %=\n", field.field-name);
- signal(make(<undefined-field-error>));
- end;
- end;
- end;
- push-data(node.the-output, frame);
-end;
-
define open generic ethernet-type-code (object :: <ethernet-socket>) => (res :: <integer>);
define open generic listen-address (object :: <object>) => (res :: <object>);
-define open generic demultiplexer-output (object :: <object>) => (res :: <object>);
-define open generic demultiplexer-output-setter (value :: <object>, object :: <object>) => (res :: <object>);
-define open generic decapsulator (object :: <object>) => (res :: <decapsulator>);
-define open generic completer (object :: <object>) => (res :: <completer>);
-define open generic completer-setter (value :: <completer>, object :: <object>) => (res :: <completer>);
-define open generic resolve (object :: <object>) => (res :: <object>);
-define class <ethernet-socket> (<object>)
+define class <ethernet-socket> (<socket>)
constant slot ethernet-type-code :: <integer>, init-keyword: type-code:;
constant slot listen-address :: false-or(<mac-address>) = #f, init-keyword: listen-address:;
- slot demultiplexer-output;
- constant slot decapsulator :: <decapsulator> = make(<decapsulator>);
- slot completer :: <completer>;
- constant slot resolve, init-keyword: resolve:;
end;
define method create-socket (layer :: <ethernet-layer>,
type-code :: <integer>,
- #key mac-address,
- resolve)
+ #key mac-address)
=> (socket :: <ethernet-socket>);
let source-address = mac-address | layer.default-mac-address;
let socket = make(<ethernet-socket>,
type-code: type-code,
- listen-address: source-address,
- resolve: resolve);
- let template-frame = make(cache-class(<ethernet-frame>),
+ listen-address: source-address);
+ let template-frame = make(<ethernet-frame>,
type-code: type-code,
source-address: source-address);
socket.completer := make(<completer>,
@@ -88,25 +109,21 @@
format-to-string("(ethernet.destination-address = %s) & (ethernet.type-code = %s)",
source-address, type-code));
connect(socket.demultiplexer-output, socket.decapsulator);
- connect(socket.completer, layer.ethernet-fan-in);
+ connect(socket.completer, layer.fan-in);
socket;
end;
-define method send (socket :: <ethernet-socket>, payload :: <container-frame>, destination :: <mac-address>);
+define method send (socket :: <ethernet-socket>, destination :: <mac-address>, payload :: <container-frame>);
let ethernet-frame = make(<ethernet-frame>,
destination-address: destination,
payload: payload);
push-data-aux(socket.completer.the-input, socket.completer, ethernet-frame);
end;
-define method send (socket :: <ethernet-socket>, payload :: <container-frame>, destination :: <ipv4-address>);
- let destination-mac = socket.resolve(destination);
- send(socket, payload, destination-mac);
-end;
define method delete-socket (socket :: <ethernet-socket>, layer :: <ethernet-layer>)
disconnect(socket.demultiplexer-output, socket.decapsulator);
- disconnect(socket.completer, layer.ethernet-fan-in);
+ disconnect(socket.completer, layer.fan-in);
end;
define open generic ethernet-layer (object :: <ip-over-ethernet-adapter>) => (res :: <ethernet-layer>);
@@ -114,99 +131,87 @@
define generic v4-address (object :: <ip-over-ethernet-adapter>) => (res :: <ipv4-address>);
define open generic ip-layer (object :: <object>) => (res :: <ip-layer>);
define open generic ip-layer-setter (value :: <ip-layer>, object :: <object>) => (res :: <ip-layer>);
+define open generic ip-send-socket (object :: <ip-over-ethernet-adapter>) => (res :: <ethernet-socket>);
+define open generic ip-send-socket-setter (value :: <ethernet-socket>, object :: <ip-over-ethernet-adapter>) => (res :: <ethernet-socket>);
-define class <ip-over-ethernet-adapter> (<object>)
+define class <ip-over-ethernet-adapter> (<adapter>)
constant slot ip-layer :: <ip-layer>, required-init-keyword: ip-layer:;
constant slot ethernet-layer :: <ethernet-layer>, required-init-keyword: ethernet:;
constant slot arp-handler :: <arp-handler>, required-init-keyword: arp:;
constant slot v4-address :: <ipv4-address>, required-init-keyword: ipv4-address:;
+ slot ip-send-socket :: <ethernet-socket>;
+end;
+
+define method send (socket :: <ip-over-ethernet-adapter>, destination :: <ipv4-address>, payload :: <container-frame>);
+ let destination-mac = find-mac-address(socket.arp-handler, destination);
+ if (destination-mac)
+ send(socket.ip-send-socket, destination-mac, payload);
+ else
+ format-out("Couldn't find mac-address for %=\n", destination);
+ end;
end;
+define constant $broadcast-ethernet-address = mac-address("ff:ff:ff:ff:ff:ff");
+
define method initialize (ip-over-ethernet :: <ip-over-ethernet-adapter>,
#rest rest, #key, #all-keys);
let arp-socket = create-socket(ip-over-ethernet.ethernet-layer, #x806);
let arp-broadcast-socket = create-socket(ip-over-ethernet.ethernet-layer,
#x806,
- mac-address: mac-address("ff:ff:ff:ff:ff:ff"));
+ mac-address: $broadcast-ethernet-address);
let arp-fan-in = make(<fan-in>);
connect(arp-socket.decapsulator, arp-fan-in);
connect(arp-broadcast-socket.decapsulator, arp-fan-in);
connect(arp-fan-in, ip-over-ethernet.arp-handler);
- ip-over-ethernet.arp-handler.ethernet-socket := arp-socket;
- ip-over-ethernet.arp-handler.ip-over-ethernet-adapter := ip-over-ethernet;
+ ip-over-ethernet.arp-handler.send-socket := arp-socket;
ip-over-ethernet.arp-handler.arp-table[ip-over-ethernet.v4-address]
:= make(<advertised-arp-entry>,
ip-address: ip-over-ethernet.v4-address,
mac-address: ip-over-ethernet.ethernet-layer.default-mac-address);
- let ip-socket = create-socket(ip-over-ethernet.ethernet-layer,
- #x800,
- resolve: curry(find-mac-address, ip-over-ethernet.arp-handler));
+ let ip-socket = create-socket(ip-over-ethernet.ethernet-layer, #x800);
let ip-broadcast-socket = create-socket(ip-over-ethernet.ethernet-layer,
#x800,
- mac-address: mac-address("ff:ff:ff:ff:ff:ff"));
+ mac-address: $broadcast-ethernet-address);
+ ip-over-ethernet.ip-send-socket := ip-socket;
let ipv4-fan-in = make(<fan-in>);
connect(ip-socket.decapsulator, ipv4-fan-in);
connect(ip-broadcast-socket.decapsulator, ipv4-fan-in);
connect(ipv4-fan-in, ip-over-ethernet.ip-layer.demultiplexer);
- connect(ip-over-ethernet.ip-layer.ip-fan-in, ip-socket.completer);
- ip-over-ethernet.ip-layer.ethernet-socket := ip-socket;
+ ip-over-ethernet.ip-layer.send-socket := ip-over-ethernet;
ip-over-ethernet.ip-layer.default-ip-address := ip-over-ethernet.v4-address;
-end;
-
-define class <ip-fan-in> (<fan-in>)
- slot ip-layer :: <ip-layer>;
-end;
+end;
-define method push-data-aux (input :: <push-input>,
- node :: <ip-fan-in>,
- frame :: <frame>)
- send(node.ip-layer.ethernet-socket, frame, frame.destination-address);
-end;
-define open generic ethernet-socket (object :: <object>) => (res :: <ethernet-socket>);
-define open generic ethernet-socket-setter (value :: <ethernet-socket>, object :: <object>) => (res :: <ethernet-socket>);
-define generic ip-fan-in (object :: <ip-layer>) => (res :: <fan-in>);
+define open generic send-socket (object :: <object>) => (res);
+define open generic send-socket-setter (value :: <object>, object :: <object>) => (res);
define generic default-ip-address (object :: <ip-layer>) => (res :: <ipv4-address>);
define generic default-ip-address-setter (value :: <ipv4-address>, object :: <ip-layer>) => (res :: <ipv4-address>);
-define generic packet-source-sink (object :: <ip-layer>) => (res :: <filter>);
-define class <ip-layer> (<object>)
- //constant slot packet-source-sink :: <filter> = make(<filter>);
- slot ethernet-socket :: <ethernet-socket>;
+
+define class <ip-layer> (<layer>)
+ slot send-socket :: type-union(<socket>, <adapter>);
//slot routing-table = make(<vector-table>);
- constant slot demultiplexer :: <demultiplexer> = make(<demultiplexer>);
- constant slot ip-fan-in :: <ip-fan-in> = make(<ip-fan-in>);
slot default-ip-address :: <ipv4-address>;
end;
-define method initialize (ip :: <ip-layer>,
- #rest rest, #key, #all-keys);
- ip.ip-fan-in.ip-layer := ip;
-end;
define open generic ip-protocol (object :: <ip-socket>) => (res :: <integer>);
-define class <ip-socket> (<object>)
+define class <ip-socket> (<socket>)
constant slot ip-protocol :: <integer>, init-keyword: protocol:;
constant slot listen-address :: false-or(<ipv4-address>) = #f, init-keyword: listen-address:;
- slot demultiplexer-output;
- constant slot decapsulator :: <decapsulator> = make(<decapsulator>);
- slot completer :: <completer>;
- constant slot resolve, init-keyword: resolve:;
end;
define method create-socket (ip-layer :: <ip-layer>,
protocol :: <integer>,
- #key ip-address,
- resolve)
+ #key ip-address)
=> (res :: <ip-socket>)
let source-address = ip-address | ip-layer.default-ip-address;
let socket = make(<ip-socket>,
protocol: protocol,
- listen-address: source-address,
- resolve: resolve);
- let template-frame = make(cache-class(<ipv4-frame>),
+ listen-address: source-address);
+ let template-frame = make(<ipv4-frame>,
protocol: protocol,
source-address: source-address);
socket.completer := make(<completer>,
@@ -216,11 +221,11 @@
format-to-string("(ipv4.destination-address = %s) & (ipv4.protocol = %s)",
source-address, protocol));
connect(socket.demultiplexer-output, socket.decapsulator);
- connect(socket.completer, ip-layer.ip-fan-in);
+ connect(socket.completer, ip-layer.fan-in);
socket;
end;
-define method send (ip-socket :: <ip-socket>, payload :: <container-frame>, destination :: <ipv4-address>)
+define method send (ip-socket :: <ip-socket>, destination :: <ipv4-address>, payload :: <container-frame>)
let frame = make(<ipv4-frame>,
destination-address: destination,
payload: payload);
@@ -254,12 +259,12 @@
type: 0,
code: 0,
payload: frame.payload);
- make(<thread>, function: curry(send, node.ip-socket, response, frame.parent.source-address));
+ make(<thread>, function: curry(send, node.ip-socket, frame.parent.source-address, response));
end;
end;
define generic icmp-handler (object :: <icmp-over-ip-adapter>) => (res :: <icmp-handler>);
-define class <icmp-over-ip-adapter> (<object>)
+define class <icmp-over-ip-adapter> (<adapter>)
constant slot ip-layer :: <ip-layer>, required-init-keyword: ip-layer:;
constant slot icmp-handler :: <icmp-handler>, required-init-keyword: icmp-handler:;
end;
@@ -273,14 +278,11 @@
define generic arp-table (object :: <arp-handler>) => (res :: <vector-table>);
define generic lock (object :: <arp-handler>) => (res :: <lock>);
-define generic ip-over-ethernet-adapter (object :: <arp-handler>) => (res :: <ip-over-ethernet-adapter>);
-define generic ip-over-ethernet-adapter-setter (value :: <ip-over-ethernet-adapter>, object :: <arp-handler>) => (res :: <ip-over-ethernet-adapter>);
define class <arp-handler> (<filter>)
constant slot arp-table :: <vector-table> = make(<vector-table>);
constant slot lock :: <lock> = make(<lock>);
- slot ip-over-ethernet-adapter :: <ip-over-ethernet-adapter>;
- slot ethernet-socket :: <ethernet-socket>;
+ slot send-socket :: <socket>;
end;
define generic original-request (object :: <outstanding-arp-request>) => (res :: <frame>);
@@ -316,9 +318,9 @@
define class <advertised-arp-entry> (<static-arp-entry>)
end;
-define open generic timestamp (object :: <dynamic-arp-entry>) => (res :: <date>);
+define open generic arp-timestamp (object :: <dynamic-arp-entry>) => (res :: <date>);
define class <dynamic-arp-entry> (<known-arp-entry>)
- constant slot timestamp :: <date> = current-date()
+ constant slot arp-timestamp :: <date> = current-date()
end;
define method try-again (request :: <outstanding-arp-request>, handler :: <arp-handler>)
@@ -326,7 +328,7 @@
if (request.counter > 3)
release-all(request.notification)
else
- send(handler.ethernet-socket, request.original-request, request.destination);
+ send(handler.send-socket, request.destination, request.original-request);
request.timer := make(<timer>, in: 5, event: curry(try-again, request, handler));
request.counter := request.counter + 1;
end
@@ -352,7 +354,7 @@
target-ip-address: frame.source-ip-address,
source-mac-address: arp-entry.arp-mac-address,
source-ip-address: arp-entry.ip-address);
- send(node.ethernet-socket, arp-response, frame.source-mac-address);
+ send(node.send-socket, frame.source-mac-address, arp-response);
end;
elseif (frame.operation = 2)
with-lock(node.lock)
@@ -405,17 +407,22 @@
else
with-lock(arp-handler.lock)
unless(arp-entry)
+ let from-addr = arp-handler.send-socket.listen-address;
+ let from-ip = find-key(arp-handler.arp-table,
+ method(x)
+ x.arp-mac-address = from-addr
+ end);
let arp-request = make(<arp-frame>,
operation: 1,
- source-mac-address: arp-handler.ip-over-ethernet-adapter.ethernet-layer.default-mac-address,
- source-ip-address: arp-handler.ip-over-ethernet-adapter.v4-address,
+ source-mac-address: from-addr,
+ source-ip-address: from-ip,
target-ip-address: ip,
target-mac-address: mac-address("00:00:00:00:00:00"));
- send(arp-handler.ethernet-socket, arp-request, mac-address("ff:ff:ff:ff:ff:ff"));
+ send(arp-handler.send-socket, $broadcast-ethernet-address, arp-request);
let outstanding-request = make(<outstanding-arp-request>,
handler: arp-handler,
request: arp-request,
- destination: mac-address("ff:ff:ff:ff:ff:ff"),
+ destination: $broadcast-ethernet-address,
ip-address: ip);
let timer* = make(<timer>, in: 5, event: curry(try-again, outstanding-request, arp-handler));
outstanding-request.timer := timer*;
@@ -454,7 +461,8 @@
ip-layer: ip-layer,
icmp-handler: icmp-handler);
let thr = make(<thread>, function: curry(toplevel, int));
- send(ip-layer.ethernet-socket,
+ send(ip-layer.send-socket,
+ ipv4-address("192.168.0.1"),
make(<ipv4-frame>,
identification: 23,
protocol: 1,
@@ -464,14 +472,13 @@
payload: make(<icmp-frame>,
type: 8,
code: 0,
- payload: parse-frame(<raw-frame>, as(<byte-vector>, #(#x23, #x42, #x0, #x0))))),
- ipv4-address("192.168.0.1"));
+ payload: parse-frame(<raw-frame>, as(<byte-vector>, #(#x23, #x42, #x0, #x0))))));
send(icmp-handler.ip-socket,
+ ipv4-address("192.168.0.1"),
make(<icmp-frame>,
type: 8,
code: 0,
- payload: parse-frame(<raw-frame>, as(<byte-vector>, #(#x23, #x42, #x0, #x0)))),
- ipv4-address("192.168.0.1"));
+ payload: parse-frame(<raw-frame>, as(<byte-vector>, #(#x23, #x42, #x0, #x0)))));
format-out("Mac 192.168.0.1: %=\n", find-mac-address(arp-handler, ipv4-address("192.168.0.1")));
sleep(1200);
end;
Modified: trunk/libraries/packetizer/ethernet.dylan
==============================================================================
--- trunk/libraries/packetizer/ethernet.dylan (original)
+++ trunk/libraries/packetizer/ethernet.dylan Tue Oct 3 20:15:56 2006
@@ -15,7 +15,7 @@
signal(make(<parse-error>))
end;
make(<mac-address>,
- data: map-as(<byte-vector>, rcurry(string-to-integer, base: 16), fields));
+ data: map-as(<stretchy-vector-subsequence>, rcurry(string-to-integer, base: 16), fields));
else
//input: 00deadbeef00
unless (res.size = 12)
Modified: trunk/libraries/packetizer/ipv4.dylan
==============================================================================
--- trunk/libraries/packetizer/ipv4.dylan (original)
+++ trunk/libraries/packetizer/ipv4.dylan Tue Oct 3 20:15:56 2006
@@ -68,7 +68,7 @@
define method read-frame (frame-type == <ipv4-address>, string :: <string>)
=> (res)
make(<ipv4-address>,
- data: map-as(<byte-vector>, string-to-integer, split(string, '.')));
+ data: map-as(<stretchy-vector-subsequence>, string-to-integer, split(string, '.')));
end;
define method as (class == <string>, frame :: <ipv4-address>) => (string :: <string>);
@@ -96,23 +96,16 @@
logand(#xffff, lognot(checksum));
end;
-define method fixup! (frame :: <ipv4-frame>,
- packet :: type-union(<byte-vector-subsequence>, <byte-vector>),
+define method fixup! (frame :: <unparsed-ipv4-frame>,
#next next-method)
- assemble-frame-into-as(<2byte-big-endian-unsigned-integer>,
- calculate-checksum(packet, frame.header-length * 4),
- packet,
- start-offset(get-frame-field(#"header-checksum", frame)));
+ frame.header-checksum := calculate-checksum(frame.packet, frame.header-length * 4);
+ break();
next-method();
end;
-define method fixup! (frame :: <icmp-frame>,
- packet :: type-union(<byte-vector-subsequence>, <byte-vector>),
+define method fixup! (frame :: <unparsed-icmp-frame>,
#next next-method)
- assemble-frame-into-as(<2byte-big-endian-unsigned-integer>,
- calculate-checksum(packet, packet.size),
- packet,
- start-offset(get-frame-field(#"checksum", frame)));
+ frame.checksum := calculate-checksum(frame.packet, frame.packet.size);
next-method();
end;
Modified: trunk/libraries/packetizer/leaf-frames.dylan
==============================================================================
--- trunk/libraries/packetizer/leaf-frames.dylan (original)
+++ trunk/libraries/packetizer/leaf-frames.dylan Tue Oct 3 20:15:56 2006
@@ -53,11 +53,9 @@
define method assemble-frame-into-as
(frame-type == <unsigned-byte>,
data :: <byte>,
- packet :: <stretchy-byte-vector-subsequence>,
- start :: <integer>) => (end-offset :: <integer>)
- byte-aligned(start);
- packet[byte-offset(start)] := data;
- start + 8;
+ packet :: <stretchy-byte-vector-subsequence>) => (end-offset :: <integer>)
+ packet[0] := data;
+ 8;
end;
define method as (class == <string>, frame :: <unsigned-byte>)
@@ -142,19 +140,18 @@
=> (packet :: <byte-sequence>)
let result-size = frame-size(frame-type);
let result = make(<byte-sequence>, end: byte-offset(result-size + 7));
- assemble-frame-into-as(frame-type, data, result, 0);
+ assemble-frame-into-as(frame-type, data, result);
result;
end;
define method assemble-frame-into-as (frame-type :: subclass(<unsigned-integer-bit-frame>),
data :: <integer>,
- packet :: <stretchy-vector-subsequence>,
- start :: <integer>)
+ packet :: <stretchy-vector-subsequence>)
=> (res :: <integer>)
let result-size = frame-size(frame-type);
- let subseq = subsequence(packet, start: start, length: result-size);
+ let subseq = subsequence(packet, length: result-size);
encode-integer(data, subseq, result-size);
- start + result-size;
+ result-size;
end;
define method as (class == <string>, frame :: <unsigned-integer-bit-frame>)
@@ -215,11 +212,9 @@
end;
define method assemble-frame-into (frame :: <fixed-size-byte-vector-frame>,
- packet :: <stretchy-byte-vector-subsequence>,
- start :: <integer>) => (res :: <integer>)
- byte-aligned(start);
- copy-bytes(frame.data, 0, packet, byte-offset(start), byte-offset(frame-size(frame)));
- start + frame-size(frame)
+ packet :: <stretchy-byte-vector-subsequence>) => (res :: <integer>)
+ copy-bytes(frame.data, 0, packet, 0, byte-offset(frame-size(frame)));
+ frame-size(frame)
end;
define method as (class == <string>, frame :: <fixed-size-byte-vector-frame>) => (res :: <string>)
@@ -331,13 +326,11 @@
define method assemble-frame-into-as (frame-type :: subclass(<big-endian-unsigned-integer-byte-frame>),
data :: <integer>,
- packet :: <byte-vector-subsequence>,
- start :: <integer>) => (res :: <integer>)
- byte-aligned(start);
- for (i from 0 below frame-size(frame-type) by 8)
- packet[byte-offset(start + i)] := logand(#xff, ash(data, - (frame-size(frame-type) - i - 8)));
+ packet :: <byte-vector-subsequence>) => (res :: <integer>)
+ for (i from 0 below byte-offset(frame-size(frame-type)))
+ packet[i] := logand(#xff, ash(data, - (frame-size(frame-type) - i * 8 - 8)));
end;
- start + frame-size(frame-type)
+ frame-size(frame-type)
end;
define method as (class == <string>, frame :: <big-endian-unsigned-integer-byte-frame>)
@@ -392,13 +385,11 @@
define method assemble-frame-into-as (frame-type :: subclass(<little-endian-unsigned-integer-byte-frame>),
data :: <integer>,
- packet :: <stretchy-byte-vector-subsequence>,
- start :: <integer>)
- byte-aligned(start);
- for (i from 0 below frame-size(frame-type) by 8)
- packet[byte-offset(start + i)] := logand(#xff, ash(data, - i));
+ packet :: <stretchy-byte-vector-subsequence>)
+ for (i from 0 below byte-offset(frame-size(frame-type)))
+ packet[i] := logand(#xff, ash(data, - i * 8));
end;
- start + frame-size(frame-type);
+ frame-size(frame-type);
end;
define method as (class == <string>, frame :: <little-endian-unsigned-integer-byte-frame>)
@@ -450,11 +441,9 @@
end;
define method assemble-frame-into (frame :: <variable-size-byte-vector>,
- packet :: <stretchy-byte-vector-subsequence>,
- start :: <integer>) => (res :: <integer>)
- byte-aligned(start);
- copy-bytes(frame.data, 0, packet, byte-offset(start), frame.data.size);
- start + frame-size(frame)
+ packet :: <stretchy-byte-vector-subsequence>) => (res :: <integer>)
+ copy-bytes(frame.data, 0, packet, 0, frame.data.size);
+ frame-size(frame)
end;
define class <raw-frame> (<variable-size-byte-vector>)
Modified: trunk/libraries/packetizer/packetizer-test/packetizer-test.dylan
==============================================================================
--- trunk/libraries/packetizer/packetizer-test/packetizer-test.dylan (original)
+++ trunk/libraries/packetizer/packetizer-test/packetizer-test.dylan Tue Oct 3 20:15:56 2006
@@ -364,7 +364,24 @@
check-equal("first byte is #xf3", #xf3, ff.packet[0]);
check-equal("second byte is #x40", #x40, ff.packet[1]);
end;
+define protocol half-bytes (container-frame)
+ field a :: <4bit-unsigned-integer> = #xf;
+ field b :: <4bit-unsigned-integer> = #x0;
+ field c :: <4bit-unsigned-integer> = #x5;
+ field d :: <4bit-unsigned-integer> = #xa;
+end;
+define test half-bytes-assembling ()
+ let f = make(<half-bytes>);
+ check-equal("f.a is #xf", #xf, f.a);
+ check-equal("f.b is #x0", #x0, f.b);
+ check-equal("f.c is #x5", #x5, f.c);
+ check-equal("f.d is #xa", #xa, f.d);
+ f.a := #xe;
+ check-equal("f.a is #xe", #xe, f.a);
+ let as = assemble-frame(f);
+ check-equal("assembling is correct", #(#xe0, #x5a), as.packet);
+end;
define suite packetizer-suite ()
test packetizer-parser;
@@ -395,6 +412,7 @@
test inheritance-dynamic-length-assemble;
test half-byte-assembling;
test half-byte-modify;
+ test half-bytes-assembling;
end;
begin
Modified: trunk/libraries/packetizer/packetizer.dylan
==============================================================================
--- trunk/libraries/packetizer/packetizer.dylan (original)
+++ trunk/libraries/packetizer/packetizer.dylan Tue Oct 3 20:15:56 2006
@@ -107,8 +107,7 @@
define generic assemble-frame-into (frame :: <frame>,
- packet :: <stretchy-vector-subsequence>,
- start :: <integer>) => (length :: <integer>);
+ packet :: <stretchy-vector-subsequence>) => (length :: <integer>);
define generic assemble-frame
(frame :: <frame>) => (packet /* :: <vector> */);
@@ -142,20 +141,13 @@
object
end;
-define open generic fixup! (frame :: type-union(<container-frame>, <raw-frame>),
- packet :: <byte-vector-subsequence>);
+define open generic fixup! (frame :: type-union(<container-frame>, <raw-frame>));
-define method fixup!(frame :: type-union(<container-frame>, <raw-frame>),
- packet :: <byte-vector-subsequence>)
+define method fixup!(frame :: type-union(<container-frame>, <raw-frame>))
end;
-define method fixup!(frame :: <header-frame>,
- packet :: <byte-vector-subsequence>)
- unless (instance?(frame.payload, <unparsed-container-frame>))
- fixup!(frame.payload,
- subsequence(packet,
- start: start-offset(get-frame-field(#"payload", frame))));
- end;
+define method fixup!(frame :: <header-frame>)
+ fixup!(frame.payload);
end;
define generic frame-size (frame :: type-union(<frame>, subclass(<fixed-size-frame>)))
@@ -341,9 +333,10 @@
define method assemble-frame (frame :: <container-frame>) => (packet :: <unparsed-container-frame>);
let result = make(<stretchy-byte-vector-subsequence>, data: make(<stretchy-byte-vector>, capacity: 1548));
- assemble-frame-into(frame, result, 0);
- fixup!(frame, result);
- make(unparsed-class(frame.object-class), cache: frame, packet: result)
+ assemble-frame-into(frame, result);
+ let uf = make(unparsed-class(frame.object-class), cache: frame, packet: result);
+ fixup!(uf);
+ uf;
end;
define method as(type == <string>, frame :: <container-frame>) => (string :: <string>);
@@ -366,9 +359,8 @@
end;
define method assemble-frame-into (frame :: <container-frame>,
- packet :: <stretchy-vector-subsequence>,
- start :: <integer>) => (res :: <integer>)
- let offset :: <integer> = start;
+ packet :: <stretchy-vector-subsequence>) => (res :: <integer>)
+ let offset :: <integer> = 0;
for (field in fields(frame))
unless (field.getter(frame))
if (field.fixup-function)
@@ -391,7 +383,15 @@
field.field-name, field.static-start, offset);
offset := field.static-start;
end;
- let length = offset + assemble-field-into(field, frame, subsequence(packet, start: offset), 0);
+ let length = offset + assemble-field-into(field, frame, subsequence(packet, start: offset));
+ frame.concrete-frame-fields[field.index].%start-offset := offset;
+ if (instance?(field.getter(frame), <container-frame>))
+ let unparsed = make(unparsed-class(field.getter(frame).object-class),
+ cache: field.getter(frame), packet: subsequence(packet,
+ start: offset,
+ length: length));
+ field.setter(unparsed, frame);
+ end;
if (field.dynamic-end)
let real-frame-end = field.dynamic-end(frame);
if (real-frame-end ~= length)
@@ -412,61 +412,54 @@
end;
define method assemble-frame-into (frame :: <unparsed-container-frame>,
- to-packet :: <stretchy-vector-subsequence>,
- start :: <integer>) => (res :: <integer>)
- byte-aligned(start);
- copy-bytes(frame.packet, 0, to-packet, byte-offset(start), frame.packet.size);
+ to-packet :: <stretchy-vector-subsequence>) => (res :: <integer>)
+ copy-bytes(frame.packet, 0, to-packet, 0, frame.packet.size);
end;
define method assemble-field-into(field :: <single-field>,
frame :: <container-frame>,
- packet :: <stretchy-vector-subsequence>,
- start :: <integer>)
- let length = assemble-aux(field.type, field.getter(frame), packet, start);
- let ff = make(<frame-field>, field: field, frame: frame, start: start, end: length);
+ packet :: <stretchy-vector-subsequence>)
+ let length = assemble-aux(field.type, field.getter(frame), packet);
+ let ff = make(<frame-field>, field: field, frame: frame, length: length);
frame.concrete-frame-fields[field.index] := ff;
length;
end;
define method assemble-field-into(field :: <variably-typed-field>,
frame :: <container-frame>,
- packet :: <stretchy-vector-subsequence>,
- start :: <integer>)
- let length = assemble-frame-into(field.getter(frame), packet, start);
- let ff = make(<frame-field>, field: field, frame: frame, start: start, end: length);
+ packet :: <stretchy-vector-subsequence>)
+ let length = assemble-frame-into(field.getter(frame), packet);
+ let ff = make(<frame-field>, field: field, frame: frame, length: length);
frame.concrete-frame-fields[field.index] := ff;
length;
end;
define method assemble-field-into(field :: <repeated-field>,
frame :: <container-frame>,
- packet :: <stretchy-vector-subsequence>,
- start :: <integer>)
- let offset :: <integer> = start;
- let repeated-ff = make(<repeated-frame-field>, field: field, frame: frame, start: start);
+ packet :: <stretchy-vector-subsequence>)
+ let offset :: <integer> = 0;
+ let repeated-ff = make(<repeated-frame-field>, field: field, frame: frame);
for (ele in field.getter(frame))
- let length = assemble-aux(field.type, ele, subsequence(packet, start: offset), 0);
+ let length = assemble-aux(field.type, ele, subsequence(packet, start: offset));
let ff = make(<rep-frame-field>, start: offset, parent: repeated-ff, frame: frame, end: length);
add!(repeated-ff.frame-field-list, ff);
offset := length + offset;
end;
- repeated-ff.%end-offset := offset;
+ repeated-ff.%length := offset;
frame.concrete-frame-fields[field.index] := repeated-ff;
offset;
end;
define method assemble-aux (frame-type :: subclass(<untranslated-frame>),
frame :: <frame>,
- packet :: <stretchy-vector-subsequence>,
- start :: <integer>) => (res :: <integer>)
- assemble-frame-into(frame, packet, start);
+ packet :: <stretchy-vector-subsequence>) => (res :: <integer>)
+ assemble-frame-into(frame, packet);
end;
define method assemble-aux (frame-type :: subclass(<translated-frame>),
frame :: <object>,
- packet :: <stretchy-vector-subsequence>,
- start :: <integer>) => (res :: <integer>)
- assemble-frame-into-as(frame-type, frame, packet, start);
+ packet :: <stretchy-vector-subsequence>) => (res :: <integer>)
+ assemble-frame-into-as(frame-type, frame, packet);
end;
define open abstract class <position-mixin> (<object>)
Modified: trunk/libraries/packetizer/protocol-definer-macro.dylan
==============================================================================
--- trunk/libraries/packetizer/protocol-definer-macro.dylan (original)
+++ trunk/libraries/packetizer/protocol-definer-macro.dylan Tue Oct 3 20:15:56 2006
@@ -206,7 +206,8 @@
mframe.cache.?name := value;
let frame-field = get-frame-field(?field-index, mframe);
// blatantly ignores changed length, FIXME!
- assemble-field-into(frame-field.field, mframe, mframe.packet, frame-field.start-offset);
+ assemble-field-into(frame-field.field, mframe, subsequence(mframe.packet, start: start-offset(frame-field)));
+ value;
end;
}
end;
Modified: trunk/libraries/packetizer/stretchy-byte-vector.dylan
==============================================================================
--- trunk/libraries/packetizer/stretchy-byte-vector.dylan (original)
+++ trunk/libraries/packetizer/stretchy-byte-vector.dylan Tue Oct 3 20:15:56 2006
@@ -9,8 +9,8 @@
define constant <stretchy-byte-vector> = limited(<stretchy-vector>, of: <byte>);
define abstract class <stretchy-vector-subsequence> (<vector>)
- constant slot real-data :: <stretchy-byte-vector> = make(<stretchy-byte-vector>),
- init-keyword: data:;
+ constant slot real-data :: <stretchy-byte-vector>,
+ required-init-keyword: data:;
constant slot start-index :: <integer> = 0, init-keyword: start:;
constant slot end-index :: false-or(<integer>) = #f, init-keyword: end:;
end;
@@ -31,6 +31,19 @@
end;
end;
+define method make (class :: subclass(<stretchy-vector-subsequence>),
+ #next next-method,
+ #rest rest,
+ #key data,
+ #all-keys) => (res :: <stretchy-vector-subsequence>)
+ let args = rest;
+ unless (data)
+ let data = apply(make, <stretchy-byte-vector>, rest);
+ args := add!(args, #"data");
+ args := add!(args, data);
+ end;
+ apply(next-method, class, args)
+end;
define inline function check-values (start :: <integer>, length :: false-or(<integer>), last :: false-or(<integer>))
=> (start :: <integer>, last :: false-or(<integer>))
if (last & length)
@@ -225,13 +238,12 @@
end;
define inline function replace-arg (list :: <vector>, key :: <symbol>, value :: <object>)
- => (res :: <vector>)
+ => ()
for (i from 0 below list.size by 2)
if (list[i] = key)
- list[i + 1] := value
+ list[i + 1] := value;
end;
end;
- list;
end;
define inline method subsequence (seq :: <stretchy-byte-vector-subsequence-with-offset>,
#key start :: <integer> = 0,
@@ -380,29 +392,31 @@
seq.real-data.size := needed-size
end;
let (fullbytes, bits) = truncate/(count - 8 + seq.bit-start-index, 8);
+ let first-byte = seq.start-index;
if ((fullbytes = 0) & (bits < 0))
let mask = ash(ash(#xff, - (count - seq.bit-start-index)), seq.bit-start-index);
- seq.real-data[0] := logior(logand(seq.real-data[0], mask),
- ash(value, 8 - (count - seq.bit-start-index)));
+ seq.real-data[first-byte] := logior(logand(seq.real-data[first-byte], mask),
+ ash(value, 8 - (count - seq.bit-start-index)));
else
if (seq.bit-start-index = 0)
- seq.real-data[0] := logand(#xff, ash(value, - (count - 8)));
+ seq.real-data[first-byte] := logand(#xff, ash(value, - (count - 8)));
else
//write first element
- seq.real-data[0] := logior(logand(seq.real-data[0],
- lognot(ash(#xff, - seq.bit-start-index))),
- logand(#xff, ash(value, - (count - 8 + seq.bit-start-index))));
+ seq.real-data[first-byte] := logior(logand(seq.real-data[first-byte],
+ lognot(ash(#xff, - seq.bit-start-index))),
+ logand(#xff, ash(value, - (count - 8 + seq.bit-start-index))));
end;
//loop other elements
for (i from 1 below fullbytes + 1)
- seq.real-data[i] := logand(#xff, ash(value, - (count - i * 8 + seq.bit-start-index)));
+ seq.real-data[first-byte + i] := logand(#xff, ash(value, - (count - i * 8 + seq.bit-start-index)));
end;
//last element
if ((bits > 0) & (fullbytes >= 0))
- seq.real-data[fullbytes + 1] := logior(logand(seq.real-data[fullbytes + 1],
- ash(#xff, - bits)),
- logand(logand(#xff, lognot(ash(#xff, - bits))),
- ash(value, 8 - bits)));
+ seq.real-data[first-byte + fullbytes + 1]
+ := logior(logand(seq.real-data[first-byte + fullbytes + 1],
+ ash(#xff, - bits)),
+ logand(logand(#xff, lognot(ash(#xff, - bits))),
+ ash(value, 8 - bits)));
end;
end;
end;
Modified: trunk/libraries/pcap/pcap.dylan
==============================================================================
--- trunk/libraries/pcap/pcap.dylan (original)
+++ trunk/libraries/pcap/pcap.dylan Tue Oct 3 20:15:56 2006
@@ -169,7 +169,7 @@
define method push-data-aux (input :: <push-input>,
node :: <ethernet-interface>,
frame :: <frame>)
- let buffer = assemble-frame(frame).packet;
+ let buffer = as(<byte-vector>, assemble-frame(frame).packet);
pcap-inject(node.pcap-t, buffer-offset(buffer, 0), buffer.size);
end;
More information about the chatter
mailing list