[Gd-chatter] r10914 - in trunk/libraries: interfaces network-flow packetizer packetizer/packetizer-test pcap
hannes at gwydiondylan.org
hannes at gwydiondylan.org
Sun Oct 1 23:43:57 CEST 2006
Author: hannes
Date: Sun Oct 1 23:43:52 2006
New Revision: 10914
Added:
trunk/libraries/packetizer/packetizer-test/stretchy-byte-vector-test.dylan (contents, props changed)
trunk/libraries/packetizer/stretchy-byte-vector.dylan (contents, props changed)
Modified:
trunk/libraries/interfaces/interfaces.dylan
trunk/libraries/network-flow/network-flow.dylan
trunk/libraries/packetizer/dns.dylan
trunk/libraries/packetizer/ipv4.dylan
trunk/libraries/packetizer/leaf-frames.dylan
trunk/libraries/packetizer/library.dylan
trunk/libraries/packetizer/module.dylan
trunk/libraries/packetizer/packetizer-test/packetizer-test.dylan
trunk/libraries/packetizer/packetizer-test/packetizer-test.hdp
trunk/libraries/packetizer/packetizer.dylan
trunk/libraries/packetizer/packetizer.hdp
trunk/libraries/packetizer/pcap.dylan
trunk/libraries/packetizer/protocol-definer-macro.dylan
trunk/libraries/packetizer/util.dylan
trunk/libraries/pcap/pcap.dylan
Log:
Bug: 7299
*introduce <strechy-byte-vector-subsequence> as our main data type for parsing and assembling
*use it, testcases for assembling work now :)
Modified: trunk/libraries/interfaces/interfaces.dylan
==============================================================================
--- trunk/libraries/interfaces/interfaces.dylan (original)
+++ trunk/libraries/interfaces/interfaces.dylan Sun Oct 1 23:43:52 2006
@@ -113,13 +113,13 @@
define method push-data-aux (input :: <push-input>,
node :: <ethernet-interface>,
frame :: <frame>)
- send(node.unix-interface, assemble-frame(frame));
+ send(node.unix-interface, assemble-frame(frame).packet);
end;
define method toplevel (node :: <ethernet-interface>)
while(#t)
let packet = receive(node.unix-interface);
- let frame = make(unparsed-class(<ethernet-frame>), packet: packet);
+ let frame = make(unparsed-class(<ethernet-frame>), packet: as(<stretchy-byte-vector-subsequence>, packet));
push-data(node.the-output, frame);
end while;
end;
Modified: trunk/libraries/network-flow/network-flow.dylan
==============================================================================
--- trunk/libraries/network-flow/network-flow.dylan (original)
+++ trunk/libraries/network-flow/network-flow.dylan Sun Oct 1 23:43:52 2006
@@ -156,7 +156,7 @@
end;
define method toplevel (reader :: <pcap-file-reader>)
- let file = as(<byte-vector>, stream-contents(reader.file-stream));
+ let file = as(<stretchy-byte-vector-subsequence>, stream-contents(reader.file-stream));
let pcap-file = make(unparsed-class(<pcap-file>), packet: file);
for(frame in pcap-file.packets)
push-data(reader.the-output, payload(frame));
@@ -178,8 +178,8 @@
node :: <pcap-file-writer>,
frame :: <frame>)
write(node.file-stream,
- assemble-frame(make(<pcap-packet>,
- payload: frame)));
+ packet(assemble-frame(make(<pcap-packet>,
+ payload: frame))));
force-output(node.file-stream);
end;
Modified: trunk/libraries/packetizer/dns.dylan
==============================================================================
--- trunk/libraries/packetizer/dns.dylan (original)
+++ trunk/libraries/packetizer/dns.dylan Sun Oct 1 23:43:52 2006
@@ -83,7 +83,7 @@
define method as (class == <string>, frame :: <externally-delimited-string>)
=> (res :: <string>)
let res = make(<string>, size: byte-offset(frame-size(frame)));
- copy-bytes(frame.data, 0, res, 0, byte-offset(frame-size(frame)));
+ copy-bytes-into!(frame.data, 0, res, 0, byte-offset(frame-size(frame)));
res;
end;
Modified: trunk/libraries/packetizer/ipv4.dylan
==============================================================================
--- trunk/libraries/packetizer/ipv4.dylan (original)
+++ trunk/libraries/packetizer/ipv4.dylan Sun Oct 1 23:43:52 2006
@@ -121,7 +121,7 @@
source-address, destination-address, compose(summary, payload);
field version :: <4bit-unsigned-integer> = 4;
field header-length :: <4bit-unsigned-integer>,
- fixup: round/(reduce(\+, 20, map(method(x) byte-offset(frame-size(x)) end, frame.options)), 4);
+ fixup: ceiling/(reduce(\+, 20, map(method(x) byte-offset(frame-size(x)) end, frame.options)), 4);
field type-of-service :: <unsigned-byte> = 0;
field total-length :: <2byte-big-endian-unsigned-integer>,
fixup: frame.header-length * 4 + byte-offset(frame-size(frame.payload));
Modified: trunk/libraries/packetizer/leaf-frames.dylan
==============================================================================
--- trunk/libraries/packetizer/leaf-frames.dylan (original)
+++ trunk/libraries/packetizer/leaf-frames.dylan Sun Oct 1 23:43:52 2006
@@ -51,9 +51,13 @@
end;
define method assemble-frame-into-as
- (frame-type == <unsigned-byte>, data :: <byte>, packet :: <byte-vector>, start :: <integer>)
+ (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;
end;
define method as (class == <string>, frame :: <unsigned-byte>)
@@ -121,43 +125,36 @@
signal(make(<malformed-packet-error>))
else
let result = 0;
- for (i from start below start + result-size)
- //assumption: msb first
- result := logand(1, ash(packet[byte-offset(i)],
- - (7 - bit-offset(i))))
- + ash(result, 1);
+ for (i from 0 below size(packet))
+ result := ash(result, 8) + packet[i];
end;
values(result, result-size + start);
end;
end;
define method assemble-frame (frame :: <unsigned-integer-bit-frame>)
- => (packet :: <bit-vector>)
+ => (packet :: <stretchy-byte-vector-subsequence>)
assemble-frame-as(frame.object-class, frame.data)
end;
define method assemble-frame-as(frame-type :: subclass(<unsigned-integer-bit-frame>),
- data :: <integer>)
- => (packet :: <bit-vector>)
+ data :: <integer>)
+ => (packet :: <byte-sequence>)
let result-size = frame-size(frame-type);
- let result = make(<bit-vector>, size: result-size);
- for (i from 0 below result-size)
- result[i] := logand(1, ash(data, i - result-size + 1));
- end;
+ let result = make(<byte-sequence>, end: byte-offset(result-size + 7));
+ assemble-frame-into-as(frame-type, data, result, 0);
result;
end;
define method assemble-frame-into-as (frame-type :: subclass(<unsigned-integer-bit-frame>),
data :: <integer>,
- packet :: <byte-vector>,
+ packet :: <stretchy-vector-subsequence>,
start :: <integer>)
- => ()
+ => (res :: <integer>)
let result-size = frame-size(frame-type);
- for (i from start below start + result-size)
- packet[byte-offset(i)] := logior(packet[byte-offset(i)],
- ash(logand(1, ash(data, i - start - result-size + 1)),
- 7 - bit-offset(i)));
- end;
+ let subseq = subsequence(packet, start: start, length: result-size);
+ encode-integer(data, subseq, result-size);
+ start + result-size;
end;
define method as (class == <string>, frame :: <unsigned-integer-bit-frame>)
@@ -179,7 +176,7 @@
end;
define abstract class <fixed-size-byte-vector-frame> (<fixed-size-untranslated-leaf-frame>)
- slot data :: <byte-vector>, required-init-keyword: data:;
+ slot data :: <byte-sequence>, required-init-keyword: data:;
end;
define macro n-byte-vector-definer
@@ -208,9 +205,7 @@
signal(make(<malformed-packet-error>))
else
values(make(frame-type,
- data: copy-sequence(packet,
- start: byte-offset(start),
- end: byte-offset(end-of-frame))),
+ data: packet),
end-of-frame)
end;
end;
@@ -220,10 +215,11 @@
end;
define method assemble-frame-into (frame :: <fixed-size-byte-vector-frame>,
- packet :: <byte-vector>,
- start :: <integer>)
+ 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)));
+ copy-bytes-into!(frame.data, 0, packet, byte-offset(start), byte-offset(frame-size(frame)));
+ start + frame-size(frame)
end;
define method as (class == <string>, frame :: <fixed-size-byte-vector-frame>) => (res :: <string>)
@@ -329,18 +325,19 @@
define method assemble-frame-as (frame-type :: subclass(<big-endian-unsigned-integer-byte-frame>),
data :: <integer>)
=> (packet :: <byte-vector>)
- let result = make(<byte-vector>, size: byte-offset(frame-size(frame-type)), fill: 0);
+ let result = make(<stretchy-byte-vector-subsequence>, end: frame-size(frame-type));
assemble-frame-into-as(frame-type, data, result, 0);
end;
define method assemble-frame-into-as (frame-type :: subclass(<big-endian-unsigned-integer-byte-frame>),
data :: <integer>,
- packet :: type-union(<byte-vector>, <byte-vector-subsequence>),
- start :: <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)));
end;
+ start + frame-size(frame-type)
end;
define method as (class == <string>, frame :: <big-endian-unsigned-integer-byte-frame>)
@@ -395,12 +392,13 @@
define method assemble-frame-into-as (frame-type :: subclass(<little-endian-unsigned-integer-byte-frame>),
data :: <integer>,
- packet :: <byte-vector>,
+ 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));
end;
+ start + frame-size(frame-type);
end;
define method as (class == <string>, frame :: <little-endian-unsigned-integer-byte-frame>)
@@ -422,7 +420,7 @@
define abstract class <variable-size-byte-vector> (<variable-size-untranslated-leaf-frame>)
- slot data :: <byte-vector>, required-init-keyword: data:;
+ slot data :: <byte-sequence>, required-init-keyword: data:;
slot parent :: false-or(<container-frame>) = #f, init-keyword: parent:;
end;
@@ -440,7 +438,7 @@
signal(make(<malformed-packet-error>))
else
values(make(frame-type,
- data: copy-sequence(packet, start: byte-offset(start)),
+ data: packet,
parent: parent),
start + packet.size * 8)
end
@@ -452,10 +450,11 @@
end;
define method assemble-frame-into (frame :: <variable-size-byte-vector>,
- packet :: <byte-vector>,
- start :: <integer>)
+ packet :: <stretchy-byte-vector-subsequence>,
+ start :: <integer>) => (res :: <integer>)
byte-aligned(start);
- copy-bytes(frame.data, 0, packet, byte-offset(start), frame.data.size);
+ copy-bytes-into!(frame.data, 0, packet, byte-offset(start), frame.data.size);
+ start + frame-size(frame)
end;
define class <raw-frame> (<variable-size-byte-vector>)
Modified: trunk/libraries/packetizer/library.dylan
==============================================================================
--- trunk/libraries/packetizer/library.dylan (original)
+++ trunk/libraries/packetizer/library.dylan Sun Oct 1 23:43:52 2006
@@ -4,6 +4,7 @@
define library packetizer
use common-dylan;
+ use dylan;
use io;
use collections;
use collection-extensions;
Modified: trunk/libraries/packetizer/module.dylan
==============================================================================
--- trunk/libraries/packetizer/module.dylan (original)
+++ trunk/libraries/packetizer/module.dylan Sun Oct 1 23:43:52 2006
@@ -4,19 +4,21 @@
define module packetizer
use common-dylan, exclude: { format-to-string };
- use threads;
+ use dylan-extensions, import: { \copy-down-method-definer };
use format;
use format-out;
use standard-io;
use streams;
- use bit-vector;
use print, import: { print-object };
- use byte-vector;
- use subseq;
- use file-system;
use date;
// Add binding exports here.
+ export <stretchy-vector-subsequence>,
+ <stretchy-byte-vector-subsequence>,
+ subsequence,
+ <out-of-bound-error>,
+ encode-integer;
+
export <udp-frame>, source-port, destination-port, length, checksum;
export <ethernet-frame>, <ipv4-frame>,
@@ -50,7 +52,7 @@
<2byte-big-endian-unsigned-integer>,
<3byte-little-endian-unsigned-integer>,
<externally-delimited-string>, <1bit-unsigned-integer>,
- <4bit-unsigned-integer>;
+ <4bit-unsigned-integer>, <7bit-unsigned-integer>;
export <fixed-size-translated-leaf-frame>, <byte-sequence>;
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 Sun Oct 1 23:43:52 2006
@@ -42,8 +42,16 @@
define test packetizer-assemble ()
let frame = make(<test-protocol>, foo: #x23, bar: #x42);
let byte-vector = assemble-frame(frame);
- check-equal("Assembled frame is correct", as(<byte-vector>, #(#x23, #x42)), byte-vector);
+ check-equal("Assembled frame is correct", as(<byte-vector>, #(#x23, #x42)), byte-vector.packet);
end;
+define test packetizer-modify ()
+ let frame = make(unparsed-class(<test-protocol>),
+ packet: as(<byte-vector>, #(#x23, #x42)));
+ frame.bar := #x69;
+ let byte-vector = assemble-frame(frame);
+ check-equal("Modified frame is correct", as(<byte-vector>, #(#x23, #x69)), byte-vector.packet);
+end;
+
define protocol dynamic-test (header-frame)
field foobar :: <unsigned-byte>;
field payload :: <raw-frame>,
@@ -66,8 +74,8 @@
payload: parse-frame(<raw-frame>, as(<byte-vector>, #(#x23, #x42, #x23, #x42))));
let byte-vector = assemble-frame(frame);
check-equal("Assembling dynamic frame is correct (including padding)",
- as(<byte-vector>, #(#x3, #x0, #x0, #x0, #x23, #x42, #x23, #x42)),
- byte-vector);
+ as(<stretchy-byte-vector-subsequence>, #(#x3, #x0, #x0, #x23, #x42, #x23, #x42)),
+ byte-vector.packet);
end;
define protocol static-start (container-frame)
field a :: <unsigned-byte>;
@@ -89,7 +97,7 @@
let byte-vector = assemble-frame(frame);
check-equal("Assembling static start frame is correct (including padding)",
as(<byte-vector>, #(#x23, #x0, #x0, #x2, #x3, #x4, #x5)),
- byte-vector);
+ byte-vector.packet);
end;
define protocol repeated-test (container-frame)
field foo :: <unsigned-byte>;
@@ -118,12 +126,13 @@
let byte-vector = assemble-frame(frame);
check-equal("Assemble frame with repeated field",
as(<byte-vector>, #(#x23, #x23, #x42, #x23, #x42, #x0, #x44)),
- byte-vector);
+ byte-vector.packet);
end;
define protocol repeated-and-dynamic-test (header-frame)
field header-length :: <unsigned-byte>,
- fixup: byte-offset(frame-size(frame.header-length) + frame-size(frame.type-code) + frame-size(frame.options));
+// FIXME: fixup: byte-offset(frame-size(frame.header-length) + frame-size(frame.type-code) + frame-size(frame.options));
+ fixup: frame.options.size + 2;
field type-code :: <unsigned-byte> = #x23;
repeated field options :: <unsigned-byte>,
reached-end?: method(frame) frame = 0 end;
@@ -164,7 +173,7 @@
let byte-vector = assemble-frame(frame);
check-equal("Repeated and dynamic assemble",
as(<byte-vector>, #(#x8, #x23, #x23, #x42, #x23, #x42, #x23, #x0, #x0, #x1, #x2, #x3, #x4)),
- byte-vector);
+ byte-vector.packet);
end;
define protocol count-repeated-test (container-frame)
@@ -195,7 +204,7 @@
let byte-vector = assemble-frame(frame);
check-equal("Count repeated assemble",
as(<byte-vector>, #(#x7, #x1, #x2, #x3, #x4, #x5, #x6, #x7, #x23)),
- byte-vector);
+ byte-vector.packet);
end;
define protocol frag (container-frame)
@@ -232,7 +241,7 @@
let byte-vector = assemble-frame(frame);
check-equal("label assemble",
as(<byte-vector>, #(#x23, #x23, #x3, #x1, #x2, #x3, #x23, #x3, #x4, #x5, #x6, #x23, #x4, #x7, #x8, #x9, #x10, #x42)),
- byte-vector);
+ byte-vector.packet);
end;
define protocol a-super (container-frame)
@@ -258,7 +267,7 @@
define test inheritance-assemble ()
let frame = make(<a-sub>, type-code: #x42, a: #x23);
let byte-vector = assemble-frame(frame);
- check-equal("inheritance assemble", as(<byte-vector>, #(#x42, #x23)), byte-vector);
+ check-equal("inheritance assemble", as(<byte-vector>, #(#x42, #x23)), byte-vector.packet);
end;
define protocol b-sub (a-super)
@@ -319,8 +328,44 @@
let byte-vector = assemble-frame(frame);
check-equal("Inheritance dynamic length assemble",
as(<byte-vector>, #(#x42, #x4, #x23, #x42, #x23, #x42)),
- byte-vector);
+ byte-vector.packet);
+end;
+
+define protocol half-byte-protocol (container-frame)
+ field first-element :: <4bit-unsigned-integer> = #xf;
+ field second-element :: <7bit-unsigned-integer> = #x7f;
end;
+
+define test half-byte-parsing ()
+ let frame = make(unparsed-class(<half-byte-protocol>),
+ packet: as(<byte-vector>, #(#x23, #x42)));
+ let field-list = fields(frame);
+ static-checker(field-list[0], 0, 4, 4);
+ static-checker(field-list[1], 4, 7, 11);
+ check-equal("first in half-byte has correct value", #x2, frame.first-element);
+ check-equal("second in half-byte has correct value", #x1a, frame.second-element);
+end;
+
+define test half-byte-assembling ()
+ let frame = make(<half-byte-protocol>,
+ first-element: #x2,
+ second-element: #x1a);
+ let ff = assemble-frame(frame);
+ check-equal("first byte is #x23", #x23, ff.packet[0]);
+ check-equal("second byte is #x40", #x40, ff.packet[1]);
+end;
+
+define test half-byte-modify ()
+ let frame = make(<half-byte-protocol>,
+ first-element: #x2,
+ second-element: #x1a);
+ let ff = assemble-frame(frame);
+ ff.first-element := #xf;
+ check-equal("first byte is #xf3", #xf3, ff.packet[0]);
+ check-equal("second byte is #x40", #x40, ff.packet[1]);
+end;
+
+
define suite packetizer-suite ()
test packetizer-parser;
test packetizer-dynamic-parser;
@@ -334,10 +379,12 @@
test inheritance-dynamic-length;
test dyn-length;
test dynamic-length;
+ test half-byte-parsing;
end;
define suite packetizer-assemble-suite ()
test packetizer-assemble;
+ test packetizer-modify;
test packetizer-dynamic-assemble;
test static-start-assemble;
test repeated-assemble;
@@ -346,12 +393,12 @@
test label-assemble;
test inheritance-assemble;
test inheritance-dynamic-length-assemble;
+ test half-byte-assembling;
+ test half-byte-modify;
end;
begin
run-test-application(packetizer-suite, arguments: #("-debug"));
- run-test-application(packetizer-assemble-suite); //, arguments: #("-debug"));
- while(#t)
- end;
+ run-test-application(packetizer-assemble-suite, arguments: #("-debug"));
end;
Modified: trunk/libraries/packetizer/packetizer-test/packetizer-test.hdp
==============================================================================
--- trunk/libraries/packetizer/packetizer-test/packetizer-test.hdp (original)
+++ trunk/libraries/packetizer/packetizer-test/packetizer-test.hdp Sun Oct 1 23:43:52 2006
@@ -7,6 +7,7 @@
Minor-Version: 0
Files: library
module
+ stretchy-byte-vector-test
packetizer-test
Start-Function: main
Compilation-Mode: loose
Added: trunk/libraries/packetizer/packetizer-test/stretchy-byte-vector-test.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/packetizer/packetizer-test/stretchy-byte-vector-test.dylan Sun Oct 1 23:43:52 2006
@@ -0,0 +1,247 @@
+module: packetizer-test
+Synopsis: Test library for packetizer
+Author: Andreas Bogk, Hannes Mehnert
+Copyright: (C) 2006, All rights reserved.
+
+define test byte-vector-subsequence-read ()
+ let sbv = as(<stretchy-byte-vector-subsequence>, #(#x00, #x01, #x02, #x03));
+ check-equal("Size of sbv is 4", 4, size(sbv));
+ let sbv-sub = subsequence(sbv, start: 16, end: 32);
+ check-equal("Size of subseq is 2", 2, size(sbv-sub));
+ check-equal("content at element 0 is #x02", #x02, sbv-sub[0]);
+ check-equal("content at element 1 is #x03", #x03, sbv-sub[1]);
+ check-condition("-1 is out of bound", <out-of-bound-error>, sbv-sub[-1]);
+ check-condition("2 is out of bound", <out-of-bound-error>, sbv-sub[2]);
+ check-condition("3 is out of bound", <out-of-bound-error>, sbv-sub[3]);
+end;
+
+define test byte-vector-subsequence-modify ()
+ let sbv = as(<stretchy-byte-vector-subsequence>, #(#x00, #x01, #x02, #x03));
+ let sbv-sub = subsequence(sbv, start: 16, end: 32);
+ check-equal("content at element 0 is #x02", #x02, sbv-sub[0]);
+ check-equal("content at element 0 of sbv-sub is set to #x23", #x23, sbv-sub[0] := #x23);
+ check-equal("content at element 0 is #x23", #x23, sbv-sub[0]);
+ check-equal("content at element 2 of sbv is set to #x23", #x23, sbv[2]);
+ check-condition("-1 is out of bound", <out-of-bound-error>, sbv-sub[-1] := #x42);
+ check-condition("3 is out of bound", <out-of-bound-error>, sbv-sub[3] := #x56);
+end;
+
+define test byte-vector-subsequence-iteration ()
+ let sbv = as(<stretchy-byte-vector-subsequence>, #(#x00, #x01, #x02, #x03));
+ for (ele in sbv, i from 0)
+ check-equal(format-to-string("Ele %d is correct", i), i, ele);
+ end;
+ check-equal("Map(-as) works", #(#x01, #x02, #x03, #x04), map-as(<list>, curry(\+, 1), sbv));
+ let sbv-sub = subsequence(sbv, start: 16, end: 32);
+ for (ele in sbv-sub, i from 0)
+ check-equal(format-to-string("Ele %d is correct", i), i + 2, ele);
+ end;
+ check-equal("Map(-as) works", #(#x03, #x04), map-as(<list>, curry(\+, 1), sbv-sub));
+end;
+
+define test byte-vector-subsequence-iteration-modify ()
+ let sbv = as(<stretchy-byte-vector-subsequence>, #(#x00, #x01, #x02, #x03));
+ let sbv-sub = subsequence(sbv, start: 16, end: 32);
+ replace-elements!(sbv-sub, method(x) #t end, curry(\*, 2));
+ check-equal("Map(-as) works", #(#x04, #x06), map-as(<list>, method(x) x end, sbv-sub));
+ check-equal("Map(-as) works", #(#x00, #x01, #x04, #x06), map-as(<list>, method(x) x end, sbv));
+ replace-elements!(sbv, method(x) #t end, curry(\*, 2));
+ check-equal("Map(-as) works", #(#x08, #x0c), map-as(<list>, method(x) x end, sbv-sub));
+ check-equal("Map(-as) works", #(#x00, #x02, #x08, #x0c), map-as(<list>, method(x) x end, sbv));
+end;
+
+define test byte-vector-subsequence-error-test ()
+ let sbv = as(<stretchy-byte-vector-subsequence>, #(#x00, #x01, #x02, #x03));
+ check-condition("negative offset", <out-of-bound-error>, subsequence(sbv, start: -1));
+ let sbv-sub = subsequence(sbv, end: 32);
+ check-condition("start beyond end", <out-of-bound-error>, subsequence(sbv-sub, start: 23 * 8));
+ check-condition("end beyond end", <out-of-bound-error>, subsequence(sbv-sub, end: 23 * 8));
+end;
+
+define test byte-vector-subsequence-stretchy-test ()
+ let sbv = as(<stretchy-byte-vector-subsequence>, #(#x00, #x01, #x02, #x03));
+ check-equal("element 5 (index 4) to #x42", #x42, sbv[4] := #x42);
+ check-equal("element 5 is #x42", #x42, sbv[4]);
+ check-equal("size is 5", 5, sbv.size);
+end;
+
+define test byte-vector-subsequence-nested-test ()
+ let sub = as(<stretchy-byte-vector-subsequence>,
+ #(#x0, #x1, #x2, #x3, #x4, #x5, #x6, #x7, #x8, #x9, #xa, #xb, #xc, #xd, #xe, #xf, #x10, #x11));
+ for (i from 0 below 8)
+ sub := subsequence(sub, start: 8);
+ end;
+ check-instance?("nested subseq is byte-vector-subseq",
+ <stretchy-byte-vector-subsequence>,
+ sub);
+ check-equal("nested subseq ele 0 is #x08", #x08, sub[0]);
+ let sub2 = as(<stretchy-byte-vector-subsequence>,
+ #(#x0, #x1, #x2, #x3, #x4, #x5, #x6, #x7, #x8, #x9, #xa, #xb, #xc, #xd, #xe, #xf, #x10, #x11));
+ for (i from 0 below 2)
+ sub2 := subsequence(sub2, start: 32);
+ end;
+ check-instance?("nested subseq is byte-vector-subseq",
+ <stretchy-byte-vector-subsequence>,
+ sub2);
+ check-equal("nested subseq ele 0 is #x08", #x08, sub2[0]);
+ let sub3 = as(<stretchy-byte-vector-subsequence>,
+ #(#x0, #x1, #x2, #x3, #x4, #x5, #x6, #x7, #x8, #x9, #xa, #xb, #xc, #xd, #xe, #xf, #x10, #x11));
+ for (i from 0 below 8)
+ sub3 := subsequence(sub3, start: 8, end: 80 - (i * 8));
+ end;
+ check-instance?("nested subseq is byte-vector-subseq",
+ <stretchy-byte-vector-subsequence>,
+ sub3);
+ check-equal("nested subseq ele 0 is #x08", #x08, sub3[0]);
+ check-equal("size is 2", 2, sub3.size);
+ check-condition("cant go after end", <out-of-bound-error>, subsequence(sub3, end: 32));
+ check-condition("cant go after end with length", <out-of-bound-error>, subsequence(sub3, length: 24));
+ check-condition("cant go negative with length", <out-of-bound-error>, subsequence(sub3, length: -24));
+ check-condition("cant go negative with end", <out-of-bound-error>, subsequence(sub3, end: -24));
+end;
+
+define test byte-vector-subsequence-with-offset-read ()
+ let sbv = as(<stretchy-byte-vector-subsequence>, #(#xff, #x00, #xf0, #x0f, #x00));
+ let sub1 = subsequence(sbv, start: 1, end: 2);
+ check-equal("size is 1", 1, sub1.size);
+ check-equal("value is 1", 1, sub1[0]);
+ check-condition("can't read element 1", <out-of-bound-error>, sub1[1]);
+ check-condition("can't read element -1", <out-of-bound-error>, sub1[-1]);
+ let sub2 = subsequence(sbv, start: 4, end: 8);
+ check-equal("size is 1", 1, sub2.size);
+ check-equal("value is 15", 15, sub2[0]);
+ let sub2a = subsequence(sub2, start: 0, length: 0);
+ check-equal("size is 0", 0, sub2a.size);
+ check-condition("accessing ele 0 on empty", <out-of-bound-error>, sub2a[0]);
+ let sub2b = subsequence(sub2, start: 0, end: 0);
+ check-equal("size is 0", 0, sub2b.size);
+ check-condition("accessing ele 0 on empty", <out-of-bound-error>, sub2b[0]);
+ let sub3 = subsequence(sub2, start: 0, length: 2);
+ check-equal("size is 1", 1, sub3.size);
+ check-equal("value is 3", 3, sub3[0]);
+ let sub3a = subsequence(sub2, start: 0, end: 2);
+ check-equal("size is 1", 1, sub3a.size);
+ check-equal("value is 3", 3, sub3a[0]);
+ let sub4 = subsequence(sbv, start: 8, length: 12);
+ check-equal("size is 2", 2, sub4.size);
+ check-equal("value is 0", 0, sub4[0]);
+ check-equal("value is 15", 15, sub4[1]);
+ let sub5 = subsequence(sbv, start: 16, length: 23);
+ check-equal("size is 3", 3, sub5.size);
+ check-equal("value is 240", 240, sub5[0]);
+ check-equal("value is 15", 15, sub5[1]);
+ check-equal("value is 0", 0, sub5[2]);
+ let sub6 = subsequence(sub5, start: 2, end: 10);
+ check-equal("size is 1", 1, sub6.size);
+ check-equal("value is 192", 192, sub6[0]);
+ let sub7 = subsequence(sub5, start: 2, end: 11);
+ check-equal("size is 2", 2, sub7.size);
+ check-equal("value is 192", 192, sub7[0]);
+ check-equal("value is 0", 0, sub7[1]);
+end;
+
+define test byte-vector-subsequence-with-offset-advanced ()
+ let sbv = as(<stretchy-byte-vector-subsequence>, #(#x55, #x55, #xaa, #xaa));
+ check-equal("value 0", #x55, sbv[0]);
+ check-equal("value 1", #x55, sbv[1]);
+ check-equal("value 2", #xaa, sbv[2]);
+ check-equal("value 3", #xaa, sbv[3]);
+ let sub1 = subsequence(sbv, start: 3, end: 7);
+ check-equal("value of sub1", #xa, sub1[0]);
+ let sub2 = subsequence(sub1, start: 1, end: 3);
+ check-equal("value of sub2", #x1, sub2[0]);
+ let sub3 = subsequence(sbv, start: 12, end: 20);
+ check-equal("value of sub3", 90, sub3[0]);
+ let sub4 = subsequence(sub3, start: 1, end: 5);
+ check-equal("value of sub4", 11, sub4[0]);
+ let sub5 = subsequence(sub3, start: 1, end: 6);
+ check-equal("value of sub5", 22, sub5[0]);
+ let sub6 = subsequence(sbv, start: 1, length: 24);
+ check-equal("size of sub6", 3, size(sub6));
+ check-equal("element 0 of sub6", #xaa, sub6[0]);
+ check-equal("element 1 of sub6", 171, sub6[1]);
+ check-equal("element 2 of sub6", #x55, sub6[2]);
+ let sub7 = subsequence(sbv, start: 5, length: 24);
+ check-equal("size of sub7", 3, size(sub7));
+ check-equal("element 0 of sub7", #xaa, sub7[0]);
+ check-equal("element 1 of sub7", 181, sub7[1]);
+ check-equal("element 2 of sub7", #x55, sub7[2]);
+end;
+
+define test byte-vector-subsequence-with-offset-iteration ()
+ let sbv = as(<stretchy-byte-vector-subsequence>, #(#x55, #x55, #x55));
+ let sub = subsequence(sbv, start: 1);
+ check-equal("size of sbv is 3", 3, size(sbv));
+ check-equal("size of sub is 3", 3, size(sub));
+ let count = 0;
+ for (ele in sub, i from 1)
+ if (i < sub.size)
+ check-equal("value is #xaa", #xaa, ele);
+ else
+ check-equal("last value is 85", 85, ele);
+ end;
+ count := i;
+ end;
+ check-equal("count was 3", 3, count);
+end;
+
+define test byte-vector-subsequence-with-offset-modify ()
+ let sbv = as(<stretchy-byte-vector-subsequence>, #(#xff));
+ let sub = subsequence(sbv, start: 0, end: 4);
+ check-equal("setting 0th element of sub", 0, sub[0] := 0);
+ check-equal("0th element of sub", 0, sub[0]);
+ check-equal("0th element of sbv", #x0f, sbv[0]);
+ let sbv2 = as(<stretchy-byte-vector-subsequence>, #(#xf0));
+ let sub2 = subsequence(sbv2, start: 4, end: 8);
+ check-equal("setting 0th element of sub2", #xf, sub2[0] := #xf);
+ check-equal("0th element of sub2", #xf, sub2[0]);
+ check-equal("0th element of sbv2", #xff, sbv2[0]);
+ let sbv3 = as(<stretchy-byte-vector-subsequence>, #(#xff, #xff, #xff, #xff, #xff));
+ let sub3 = subsequence(sbv3, start: 4, length: 32);
+ check-equal("setting 0th element of sub3", #x0, sub3[0] := #x0);
+ check-equal("0th element of sub3", #x0, sub3[0]);
+ check-equal("setting 1st element of sub3", #x0f, sub3[1] := #x0f);
+ check-equal("1st element of sub3", #x0f, sub3[1]);
+ check-equal("setting 2nd element of sub3", #xf0, sub3[2] := #xf0);
+ check-equal("2nd element of sub3", #xf0, sub3[2]);
+ check-equal("0th element of sbv3", #xf0, sbv3[0]);
+ check-equal("1st element of sbv3", #x00, sbv3[1]);
+ check-equal("2nd element of sbv3", #xff, sbv3[2]);
+ check-equal("3rd element of sbv3", #x0f, sbv3[3]);
+ check-equal("4th element of sbv3", #xff, sbv3[4]);
+ let sbv4 = as(<stretchy-byte-vector-subsequence>, #(#x55, #x55, #x55));
+ let sub4 = subsequence(sbv4, start: 6, end: 10);
+ check-equal("sub4 size", 1, size(sub4));
+ check-equal("0th element of sub4", #x5, sub4[0]);
+ check-equal("setting 0th element", #xf, sub4[0] := #xf);
+ check-equal("0th element of sub4", #xf, sub4[0]);
+ check-equal("0th element of sbv4", #x57, sbv4[0]);
+ check-equal("1st element of sbv4", #xd5, sbv4[1]);
+end;
+
+define test encode-integer-test ()
+ let sbv = make(<stretchy-byte-vector-subsequence>);
+ let sub1 = subsequence(sbv, start: 2);
+ encode-integer(#x23, sub1, 6);
+ check-equal("encode integer in bit vector", #x23, sbv[0]);
+end;
+
+define suite stretchy-byte-vector-suite ()
+ test byte-vector-subsequence-read;
+ test byte-vector-subsequence-modify;
+ test byte-vector-subsequence-iteration;
+ test byte-vector-subsequence-iteration-modify;
+ test byte-vector-subsequence-error-test;
+ test byte-vector-subsequence-stretchy-test;
+ test byte-vector-subsequence-nested-test;
+ test byte-vector-subsequence-with-offset-read;
+ test byte-vector-subsequence-with-offset-advanced;
+ test byte-vector-subsequence-with-offset-iteration;
+ test byte-vector-subsequence-with-offset-modify;
+ test encode-integer-test;
+end;
+
+begin
+ run-test-application(stretchy-byte-vector-suite, arguments: #("-debug"));
+end;
+
Modified: trunk/libraries/packetizer/packetizer.dylan
==============================================================================
--- trunk/libraries/packetizer/packetizer.dylan (original)
+++ trunk/libraries/packetizer/packetizer.dylan Sun Oct 1 23:43:52 2006
@@ -41,7 +41,10 @@
$unknown-at-compile-time
end;
-define constant <byte-sequence> = <byte-vector-subsequence>;
+define constant <byte-sequence> = <stretchy-vector-subsequence>;
+define constant <byte-vector-subsequence> = <stretchy-vector-subsequence>;
+
+define constant <bit-vector> = <stretchy-bit-vector-subsequence>;
define constant $protocols = make(<table>);
@@ -98,27 +101,28 @@
#rest rest,
#key, #all-keys)
=> (value :: <object>, next-unparsed :: false-or(<integer>));
- let packet-subseq = subsequence(packet);
+ let packet-subseq = subsequence(as(<stretchy-byte-vector-subsequence>, packet));
apply(parse-frame, frame-type, packet-subseq, rest);
end;
+
define generic assemble-frame-into (frame :: <frame>,
- packet :: <byte-vector>,
- start :: <integer>);
+ packet :: <stretchy-vector-subsequence>,
+ start :: <integer>) => (length :: <integer>);
define generic assemble-frame
- (frame :: <frame>) => (packet :: <vector>);
+ (frame :: <frame>) => (packet /* :: <vector> */);
define method assemble-frame
- (frame :: <unparsed-container-frame>) => (packet :: <vector>)
- frame.packet;
+ (frame :: <unparsed-container-frame>) => (packet :: <unparsed-container-frame>)
+ frame;
end;
define generic assemble-frame-as
- (frame-type :: subclass(<frame>), data :: <object>) => (packet :: <vector>);
+ (frame-type :: subclass(<frame>), data :: <object>) => (packet /* :: <vector> */);
define method assemble-frame-as
- (frame-type :: subclass(<frame>), data :: <object>) => (packet :: <byte-vector>);
+ (frame-type :: subclass(<frame>), data :: <object>) => (packet /* :: <byte-vector> */);
if (instance?(data, frame-type))
assemble-frame(data)
else
@@ -139,18 +143,18 @@
end;
define open generic fixup! (frame :: type-union(<container-frame>, <raw-frame>),
- packet :: type-union(<byte-vector>, <byte-vector-subsequence>));
+ packet :: <byte-vector-subsequence>);
define method fixup!(frame :: type-union(<container-frame>, <raw-frame>),
- packet :: type-union(<byte-vector>, <byte-vector-subsequence>))
+ packet :: <byte-vector-subsequence>)
end;
define method fixup!(frame :: <header-frame>,
- packet :: type-union(<byte-vector>, <byte-vector-subsequence>))
+ packet :: <byte-vector-subsequence>)
unless (instance?(frame.payload, <unparsed-container-frame>))
fixup!(frame.payload,
subsequence(packet,
- start: byte-offset(start-offset(get-frame-field(#"payload", frame)))));
+ start: start-offset(get-frame-field(#"payload", frame))));
end;
end;
@@ -255,11 +259,19 @@
end;
define open abstract class <unparsed-container-frame> (<container-frame>)
- slot packet :: type-union(<byte-vector>, <byte-vector-subsequence>),
- init-keyword: packet:;
- slot cache :: <container-frame>;
+ slot packet :: <byte-vector-subsequence>, init-keyword: packet:;
+ slot cache :: <container-frame>, init-keyword: cache:;
end;
+define method make (class :: subclass(<unparsed-container-frame>),
+ #next next-method, #rest rest, #key packet, #all-keys)
+ => (res :: <unparsed-container-frame>)
+ if (instance?(packet, <byte-vector>))
+ let packet = as(<stretchy-byte-vector-subsequence>, packet);
+ replace-arg(rest, #"packet", packet);
+ end;
+ apply(next-method, class, rest);
+end;
define method initialize (class :: <unparsed-container-frame>,
#rest rest, #key parent, #all-keys)
next-method();
@@ -327,11 +339,11 @@
// frame.packet.size * 8
//end;
-define method assemble-frame (frame :: <container-frame>) => (packet :: <byte-vector>);
- let result = make(<byte-vector>, size: byte-offset(frame-size(frame)), fill: 0);
+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);
- result;
+ make(unparsed-class(frame.object-class), cache: frame, packet: result)
end;
define method as(type == <string>, frame :: <container-frame>) => (string :: <string>);
@@ -354,10 +366,10 @@
end;
define method assemble-frame-into (frame :: <container-frame>,
- packet :: <byte-vector>,
- start :: <integer>)
- for (field in fields(frame),
- offset = start then offset + get-field-size-aux(frame, field))
+ packet :: <stretchy-vector-subsequence>,
+ start :: <integer>) => (res :: <integer>)
+ let offset :: <integer> = start;
+ for (field in fields(frame))
unless (field.getter(frame))
if (field.fixup-function)
field.setter(field.fixup-function(frame), frame);
@@ -365,52 +377,95 @@
error("No value for field %s while assembling", field.field-name);
end;
end;
- assemble-field-into(field, frame, packet, offset)
+ if (field.dynamic-start)
+ let real-frame-start = field.dynamic-start(frame);
+ if (real-frame-start ~= offset)
+ //pad!
+ format-out("Need dynamic padding at start of %s : %d ~= %d\n",
+ field.field-name, real-frame-start, offset);
+ end;
+ offset := real-frame-start;
+ end;
+ if ((field.static-start ~= $unknown-at-compile-time) & (field.static-start ~= offset))
+ format-out("Need static padding at start of %s : %d ~= %d\n",
+ 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);
+ if (field.dynamic-end)
+ let real-frame-end = field.dynamic-end(frame);
+ if (real-frame-end ~= length)
+ //pad!
+ format-out("Need dynamic padding at end of %s : %d ~= %d\n",
+ field.field-name, real-frame-end, length);
+ end;
+ length := real-frame-end;
+ end;
+ if ((field.static-end ~= $unknown-at-compile-time) & (field.static-end ~= length))
+ format-out("Need static padding at end of %s : %d ~= %d\n",
+ field.field-name, field.static-end, length);
+ offset := field.static-end;
+ end;
+ offset := length;
end;
+ offset;
end;
define method assemble-frame-into (frame :: <unparsed-container-frame>,
- to-packet :: <byte-vector>,
- start :: <integer>)
+ 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);
+ copy-bytes-into!(frame.packet, 0, to-packet, byte-offset(start), frame.packet.size);
end;
define method assemble-field-into(field :: <single-field>,
frame :: <container-frame>,
- packet :: <byte-vector>,
+ packet :: <stretchy-vector-subsequence>,
start :: <integer>)
- assemble-aux(field.type, field.getter(frame), packet, start);
+ let length = assemble-aux(field.type, field.getter(frame), packet, start);
+ let ff = make(<frame-field>, field: field, frame: frame, start: start, end: length);
+ frame.concrete-frame-fields[field.index] := ff;
+ length;
end;
define method assemble-field-into(field :: <variably-typed-field>,
frame :: <container-frame>,
- packet :: <byte-vector>,
+ packet :: <stretchy-vector-subsequence>,
start :: <integer>)
- assemble-frame-into(field.getter(frame), packet, start);
+ let length = assemble-frame-into(field.getter(frame), packet, start);
+ let ff = make(<frame-field>, field: field, frame: frame, start: start, end: length);
+ frame.concrete-frame-fields[field.index] := ff;
+ length;
end;
define method assemble-field-into(field :: <repeated-field>,
frame :: <container-frame>,
- packet :: <byte-vector>,
+ packet :: <stretchy-vector-subsequence>,
start :: <integer>)
- for (ele in field.getter(frame),
- offset = start then offset + frame-size(ele))
- assemble-frame-into(ele, packet, offset)
- end;
+ let offset :: <integer> = start;
+ let repeated-ff = make(<repeated-frame-field>, field: field, frame: frame, start: start);
+ for (ele in field.getter(frame))
+ let length = assemble-aux(field.type, ele, subsequence(packet, start: offset), 0);
+ 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;
+ frame.concrete-frame-fields[field.index] := repeated-ff;
+ offset;
end;
define method assemble-aux (frame-type :: subclass(<untranslated-frame>),
frame :: <frame>,
- packet :: <byte-vector>,
- start :: <integer>)
+ packet :: <stretchy-vector-subsequence>,
+ start :: <integer>) => (res :: <integer>)
assemble-frame-into(frame, packet, start);
end;
define method assemble-aux (frame-type :: subclass(<translated-frame>),
frame :: <object>,
- packet :: <byte-vector>,
- start :: <integer>)
+ packet :: <stretchy-vector-subsequence>,
+ start :: <integer>) => (res :: <integer>)
assemble-frame-into-as(frame-type, frame, packet, start);
end;
Modified: trunk/libraries/packetizer/packetizer.hdp
==============================================================================
--- trunk/libraries/packetizer/packetizer.hdp (original)
+++ trunk/libraries/packetizer/packetizer.hdp Sun Oct 1 23:43:52 2006
@@ -3,6 +3,7 @@
library: packetizer
files: library
module
+ stretchy-byte-vector
packetizer
leaf-frames
fields
Modified: trunk/libraries/packetizer/pcap.dylan
==============================================================================
--- trunk/libraries/packetizer/pcap.dylan (original)
+++ trunk/libraries/packetizer/pcap.dylan Sun Oct 1 23:43:52 2006
@@ -48,7 +48,7 @@
field microseconds :: <little-endian-unsigned-integer-4byte>;
end;
-define function byte-vector-to-float (bv :: <byte-vector>) => (res :: <float>)
+define function byte-vector-to-float (bv :: <stretchy-byte-vector-subsequence>) => (res :: <float>)
let res = 0.0d0;
for (ele in reverse(bv))
res := ele + 256 * res;
@@ -56,7 +56,7 @@
res;
end;
-define function byte-vector-to-int (bv :: <byte-vector>) => (res :: <integer>)
+define function byte-vector-to-int (bv :: <stretchy-byte-vector-subsequence>) => (res :: <integer>)
let res = 0;
let first? = #t;
for (ele in reverse(bv))
Modified: trunk/libraries/packetizer/protocol-definer-macro.dylan
==============================================================================
--- trunk/libraries/packetizer/protocol-definer-macro.dylan (original)
+++ trunk/libraries/packetizer/protocol-definer-macro.dylan Sun Oct 1 23:43:52 2006
@@ -3,6 +3,23 @@
Copyright: (C) 2005, 2006, All rights reserved. Free for non-commercial use.
+define macro protocol-module-definer
+ { protocol-module-definer (?:name; ?fields:*) }
+ => { define module ?name
+ use dylan;
+ use packetizer;
+ export "<" ## ?name ## ">";
+ export ?fields;
+ end; }
+
+ fields:
+ { } => { }
+ { field ?:name ?rest:* ; ... } => { ?name, ... }
+ { repeated field ?:name ?rest:* ; ... } => { ?name, ... }
+ { variably-typed field ?:name ?rest:* ... } => { ?name, ... }
+
+end;
+
define macro real-class-definer
{ real-class-definer(?:name; ?superclasses:*; ?fields-aux:*) }
=> { define abstract class ?name (?superclasses)
@@ -162,7 +179,8 @@
end;
define class "<unparsed-" ## ?name ## ">" ("<" ## ?name ## ">", "<unparsed-" ## ?superframe ## ">")
- inherited slot cache :: "<" ## ?name ## ">" = make("<decoded-" ## ?name ## ">");
+ inherited slot cache :: "<" ## ?name ## ">" = make("<decoded-" ## ?name ## ">"),
+ init-keyword: cache:;
end; }
end;
@@ -183,7 +201,14 @@
end;
mframe.cache.?name
end;
- end; }
+ end;
+ define inline method ?name ## "-setter" (value, mframe :: ?frame-type) => (res)
+ 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);
+ end;
+ }
end;
define method parse-frame-field
@@ -221,10 +246,10 @@
let (value, length)
= parse-frame-field-aux(frame-field.field,
frame-field.frame,
- bit-offset(start),
+ 0,
subsequence(frame-field.frame.packet,
- start: byte-offset(start),
- end: byte-offset(end-of-field + 7)));
+ start: start,
+ end: end-of-field));
if (length)
let real-end = length - bit-offset(start) + start;
unless (real-end = end-of-field)
@@ -273,8 +298,8 @@
if (packet.size > 0)
let (value, offset)
= parse-frame(field.type,
- subsequence(packet, start: byte-offset(start)),
- start: bit-offset(start),
+ subsequence(packet, start: start),
+ start: 0,
parent: frame);
unless (offset)
offset := end-offset(get-frame-field(field-count(value.object-class) - 1, value));
@@ -291,8 +316,8 @@
while ((~ field.reached-end?(frames.last)) & (byte-offset(start) < packet.size))
let (value, offset)
= parse-frame(field.type,
- subsequence(packet, start: byte-offset(start)),
- start: bit-offset(start),
+ subsequence(packet, start: start),
+ start: 0,
parent: frame);
unless (offset)
offset := end-offset(get-frame-field(field-count(value.object-class) - 1, value));
@@ -323,9 +348,8 @@
for (i from 0 below field.count(frame))
let (value, offset)
= parse-frame(field.type,
- subsequence(packet,
- start: byte-offset(start)),
- start: bit-offset(start),
+ subsequence(packet, start: start),
+ start: 0,
parent: frame);
unless (offset)
offset := end-offset(get-frame-field(field-count(value.object-class) - 1, value));
@@ -350,7 +374,7 @@
parent :: false-or(<container-frame>) = #f)
byte-aligned(start);
let frame = make(unparsed-class(frame-type),
- packet: subsequence(packet, start: byte-offset(start)),
+ packet: subsequence(packet, start: start),
parent: parent);
let length = field-size(frame-type);
if (length = $unknown-at-compile-time)
Added: trunk/libraries/packetizer/stretchy-byte-vector.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/packetizer/stretchy-byte-vector.dylan Sun Oct 1 23:43:52 2006
@@ -0,0 +1,417 @@
+module:packetizer
+Author: Andreas Bogk, Hannes Mehnert
+Copyright: (C) 2006, All rights reserved. Free for non-commercial use.
+
+
+define class <out-of-bound-error> (<error>)
+end;
+
+define constant <stretchy-byte-vector> = limited(<stretchy-vector>, of: <byte>);
+
+define abstract class <stretchy-vector-subsequence> (<mutable-sequence>)
+ constant slot real-data :: <stretchy-byte-vector> = make(<stretchy-byte-vector>),
+ init-keyword: data:;
+ constant slot start-index :: <integer> = 0, init-keyword: start:;
+ constant slot end-index :: false-or(<integer>) = #f, init-keyword: end:;
+end;
+
+define method make (class == <stretchy-vector-subsequence>,
+ #next next-method,
+ #rest rest,
+ #key start, end: last, bit-start, bit-end,
+ #all-keys) => (res :: <stretchy-vector-subsequence>)
+ if (bit-start & bit-start ~= 0)
+ apply(make, <stretchy-byte-vector-subsequence-with-offset>, rest)
+ else
+ if (bit-end & bit-end ~= 0)
+ apply(make, <stretchy-byte-vector-subsequence-with-offset>, rest)
+ else
+ apply(make, <stretchy-byte-vector-subsequence>, rest)
+ end;
+ end;
+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)
+ error("only last or length can be provided!");
+ end;
+ let end-offset = if (last) last elseif (length) length + start else #f end;
+ if (end-offset & ((end-offset < start) | (end-offset < 0)))
+ signal(make(<out-of-bound-error>))
+ end;
+ if (start < 0)
+ signal(make(<out-of-bound-error>))
+ end;
+ values(start, end-offset);
+end;
+define method subsequence (seq :: <stretchy-byte-vector-subsequence>,
+ #key start :: <integer> = 0,
+ length :: false-or(<integer>),
+ end: last :: false-or(<integer>))
+ => (res :: <stretchy-vector-subsequence>)
+ //assumption: start, length, last are in bits!
+ let (start, end-offset) = check-values(start, length, last);
+ let (start-byte :: <integer>, start-bit :: <integer>) = truncate/(start, 8);
+ if (seq.end-index & ((seq.end-index <= start-byte + seq.start-index)))
+ signal(make(<out-of-bound-error>))
+ end;
+ let (last-byte :: false-or(<integer>), last-bit :: false-or(<integer>))
+ = if (end-offset)
+ truncate/(seq.start-index * 8 + end-offset, 8)
+ else
+ values(seq.end-index, #f)
+ end;
+ if ((end-offset) & (seq.end-index) & (seq.end-index < last-byte))
+ signal(make(<out-of-bound-error>))
+ end;
+ make(<stretchy-vector-subsequence>,
+ data: seq.real-data,
+ start: start-byte + seq.start-index,
+ bit-start: start-bit,
+ end: if (last-byte) last-byte end,
+ bit-end: if (last-bit) last-bit end);
+end;
+
+define inline function vs-fip-next-element
+ (c :: <stretchy-vector-subsequence>, s :: <integer>) => (result :: <integer>);
+ s + 1;
+end function;
+
+define inline function vs-fip-done?
+ (c :: <stretchy-vector-subsequence>, s :: <integer>, l :: <integer>)
+ => (done :: <boolean>);
+ s >= l;
+end function;
+
+define inline function vs-fip-current-key
+ (c :: <stretchy-vector-subsequence>, s :: <integer>) => (result :: <integer>);
+ s;
+end function;
+
+define inline function vs-fip-copy-state
+ (c :: <stretchy-vector-subsequence>, s :: <integer>) => (result :: <integer>);
+ s;
+end function;
+
+
+define sealed class <stretchy-byte-vector-subsequence> (<stretchy-vector-subsequence>)
+end;
+
+define inline function real-sbv-element
+ (c :: <stretchy-byte-vector-subsequence>, key :: <integer>) => (result :: <byte>)
+ c.real-data[key];
+end;
+
+define inline function real-sbv-element-setter
+ (value :: <byte>, c :: <stretchy-byte-vector-subsequence>, key :: <integer>) => (result :: <byte>)
+ c.real-data[key] := value;
+end;
+
+define inline method forward-iteration-protocol (seq :: <stretchy-byte-vector-subsequence>)
+ => (initial-state :: <object>, limit :: <object>, next-state :: <function>,
+ finished-state? :: <function>, current-key :: <function>,
+ current-element :: <function>, current-element-setter :: <function>,
+ copy-state :: <function>);
+ values(seq.start-index, seq.end-index | seq.real-data.size, vs-fip-next-element,
+ vs-fip-done?, vs-fip-current-key, real-sbv-element,
+ real-sbv-element-setter, vs-fip-copy-state)
+end;
+
+define method copy-bytes-into!
+ (source :: <collection>, src-start :: <integer>,
+ destination :: <stretchy-byte-vector-subsequence>, dest-start :: <integer>,
+ length :: <integer>)
+ for (i from 0 below length)
+ destination[i + dest-start] := source[src-start + i]
+ end;
+end;
+define inline method as (class == <stretchy-byte-vector-subsequence>, data :: <byte-vector>)
+ => (res :: <stretchy-byte-vector-subsequence>)
+ make(<stretchy-byte-vector-subsequence>, data: as(<stretchy-byte-vector>, data));
+end;
+
+define inline method as (class == <stretchy-byte-vector-subsequence>, data :: <collection>)
+ => (res :: <stretchy-byte-vector-subsequence>)
+ as(<stretchy-byte-vector-subsequence>, as(<byte-vector>, data));
+end;
+
+define inline method size (c :: <stretchy-byte-vector-subsequence>) => (result :: <integer>);
+ let res = c.real-data.size - c.start-index;
+ if (res > 0)
+ if (c.end-index)
+ min(res, c.end-index - c.start-index)
+ else
+ res
+ end
+ else
+ 0
+ end
+end method size;
+
+define inline function check-sbv-range
+ (seq :: <stretchy-byte-vector-subsequence>, key :: <integer>) => ()
+ if (key < 0)
+ signal(make(<out-of-bound-error>))
+ end;
+ if (seq.end-index & (key >= (seq.end-index - seq.start-index)))
+ signal(make(<out-of-bound-error>))
+ end;
+end;
+define inline method element (seq :: <stretchy-byte-vector-subsequence>,
+ key :: <integer>, #key default) => (res :: <byte>)
+ check-sbv-range(seq, key);
+ seq.real-data[key + seq.start-index];
+end;
+
+define inline method element-setter (value :: <byte>, seq :: <stretchy-byte-vector-subsequence>,
+ key :: <integer>) => (res :: <byte>)
+ check-sbv-range(seq, key);
+ seq.real-data[key + seq.start-index] := value;
+end;
+
+define class <bit> (<object>)
+//NYI
+end;
+define class <stretchy-bit-vector-subsequence> (<stretchy-vector-subsequence>)
+end;
+
+define inline method size(c :: <stretchy-bit-vector-subsequence>) => (result :: <integer>);
+ let res = c.real-data.size * 8 - c.start-index;
+ if (res > 0)
+ if (c.end-index)
+ min(res, c.end-index - c.start-index)
+ else
+ res
+ end
+ else
+ 0
+ end
+end method size;
+
+define inline method element (seq :: <stretchy-bit-vector-subsequence>,
+ key :: <integer>, #key default) => (res :: <bit>)
+ if ((key > seq.start-index) & (seq.end-index & (key < seq.end-index)))
+ let (byte-offset, bit-offset) = truncate/(seq.start-index + key, 8);
+ logand(1, ash(seq.real-data[byte-offset], - (7 - bit-offset)))
+ else
+ error("out of bound")
+ end
+end;
+
+define inline method element-setter (value :: <bit>, seq :: <stretchy-bit-vector-subsequence>,
+ key :: <integer>) => (res :: <bit>)
+ if ((key > seq.start-index) & (seq.end-index & (key < seq.end-index)))
+ let (byte-offset, bit-offset) = truncate/(seq.start-index + key, 8);
+ let mask = lognot(ash(1, 7 - bit-offset));
+
+ seq.real-data[byte-offset] := logior(logand(mask, seq.real-data[byte-offset]),
+ ash(value, 7 - bit-offset));
+ else
+ error("out of bound")
+ end
+end;
+
+define class <stretchy-byte-vector-subsequence-with-offset> (<stretchy-vector-subsequence>)
+ constant slot bit-start-index :: <integer> = 0, init-keyword: bit-start:;
+ constant slot bit-end-index :: <integer> = 8, init-keyword: bit-end:;
+end;
+
+define method make (class == <stretchy-byte-vector-subsequence-with-offset>,
+ #next next-method,
+ #rest rest,
+ #key bit-end, end: last,
+ #all-keys) => (res :: <stretchy-byte-vector-subsequence-with-offset>)
+ unless (bit-end)
+ replace-arg(rest, #"bit-end", 8);
+ end;
+ if (bit-end & bit-end = 0)
+ replace-arg(rest, #"bit-end", 8);
+ replace-arg(rest, #"end", last - 1);
+ end;
+ apply(next-method, class, rest)
+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
+ end;
+ end;
+ list;
+end;
+define inline method subsequence (seq :: <stretchy-byte-vector-subsequence-with-offset>,
+ #key start :: <integer> = 0,
+ length :: false-or(<integer>),
+ end: last :: false-or(<integer>))
+ => (seq :: <stretchy-vector-subsequence>)
+ let (start, end-offset) = check-values(start, length, last);
+ let old-start = seq.start-index * 8 + seq.bit-start-index;
+ let (start-byte :: <integer>, start-bit :: <integer>) = truncate/(start + old-start, 8);
+ let old-end = if (seq.end-index) seq.end-index * 8 + seq.bit-end-index end;
+ if (old-end & ((old-end < start + old-start)))
+ signal(make(<out-of-bound-error>))
+ end;
+ let new-end
+ = if (end-offset)
+ old-start + end-offset
+ elseif (old-end)
+ old-end
+ else
+ #f
+ end;
+ if ((new-end) & (old-end) & (old-end < new-end))
+ signal(make(<out-of-bound-error>))
+ end;
+ let (last-byte :: false-or(<integer>), last-bit :: false-or(<integer>))
+ = if (new-end) truncate/(new-end, 8) else values(#f, #f) end;
+ make(<stretchy-vector-subsequence>,
+ data: seq.real-data,
+ start: start-byte,
+ bit-start: start-bit,
+ end: if (last-byte) last-byte end,
+ bit-end: if (last-bit) last-bit end);
+end;
+
+define inline method size(c :: <stretchy-byte-vector-subsequence-with-offset>)
+ => (result :: <integer>);
+ let fudge-factor = if (c.bit-start-index >= c.bit-end-index) 0 else 1 end;
+ let res = c.real-data.size - c.start-index + fudge-factor;
+ if (res > 0)
+ if (c.end-index)
+ min(res, max(c.end-index - c.start-index + fudge-factor, 0))
+ else
+ res - fudge-factor
+ end
+ else
+ 0
+ end
+end method size;
+
+define inline function check-sbvwo-range (seq :: <stretchy-byte-vector-subsequence-with-offset>, key :: <integer>)
+ if (key < 0)
+ signal(make(<out-of-bound-error>));
+ end;
+ if (seq.end-index & (key >= seq.size))
+ signal(make(<out-of-bound-error>));
+ end;
+end;
+
+define inline function real-sbvwo-element
+ (c :: <stretchy-byte-vector-subsequence-with-offset>, key :: <integer>) => (result :: <byte>)
+ element(c, key - c.start-index);
+end;
+
+define inline function real-sbvwo-element-setter
+ (value :: <byte>, c :: <stretchy-byte-vector-subsequence-with-offset>, key :: <integer>) => (result :: <byte>)
+ element-setter(value, c, key - c.start-index);
+end;
+
+define inline method forward-iteration-protocol (seq :: <stretchy-byte-vector-subsequence-with-offset>)
+ => (initial-state :: <object>, limit :: <object>, next-state :: <function>,
+ finished-state? :: <function>, current-key :: <function>,
+ current-element :: <function>, current-element-setter :: <function>,
+ copy-state :: <function>);
+ values(seq.start-index, seq.end-index | seq.real-data.size, vs-fip-next-element,
+ vs-fip-done?, vs-fip-current-key, real-sbvwo-element,
+ real-sbvwo-element-setter, vs-fip-copy-state)
+end;
+
+define inline method element (seq :: <stretchy-byte-vector-subsequence-with-offset>,
+ key :: <integer>, #key default) => (res :: <byte>)
+ check-sbvwo-range(seq, key);
+ if (key = seq.size - 1)
+ //last element
+ if (seq.bit-start-index >= seq.bit-end-index)
+ //need to get 2 bytes
+ ash(logand(ash(#xff, - seq.bit-start-index), seq.real-data[key + seq.start-index]), seq.bit-end-index)
+ + ash(seq.real-data[key + seq.start-index + 1], - (8 - seq.bit-end-index));
+ else
+ logand(ash(seq.real-data[key + seq.start-index], - (8 - seq.bit-end-index)),
+ ash(#xff, - (8 - (seq.bit-end-index - seq.bit-start-index))))
+ end;
+ else
+ //need to get 2 bytes, and shift them correctly
+ if (seq.bit-start-index ~= 0)
+ ash(logand(ash(#xff, - seq.bit-start-index), seq.real-data[key + seq.start-index]), seq.bit-start-index)
+ + ash(seq.real-data[key + seq.start-index + 1], - (8 - seq.bit-start-index));
+ else
+ seq.real-data[key + seq.start-index]
+ end;
+ end;
+end;
+
+define inline method element-setter (value :: <byte>, seq :: <stretchy-byte-vector-subsequence-with-offset>,
+ key :: <integer>) => (res :: <byte>)
+ check-sbvwo-range(seq, key);
+ let first-byte = key + seq.start-index;
+ if (key = seq.size - 1)
+ //last element
+ if (seq.bit-start-index >= seq.bit-end-index)
+ let mask = lognot(ash(#xff, - seq.bit-start-index));
+ seq.real-data[first-byte] := logior(logand(seq.real-data[first-byte], mask),
+ ash(value, - seq.bit-end-index));
+ let other-mask = ash(#xff, - seq.bit-end-index);
+ seq.real-data[first-byte + 1] := logior(logand(seq.real-data[first-byte + 1], other-mask),
+ logand(#xff, ash(value, 8 - seq.bit-end-index)))
+ else
+ let mask = ash(ash(#xff, - (seq.bit-end-index - seq.bit-start-index)), seq.bit-start-index);
+ seq.real-data[first-byte] := logior(logand(seq.real-data[first-byte], mask),
+ ash(value, 8 - seq.bit-end-index))
+ end;
+ else
+ if (seq.bit-start-index ~= 0)
+ seq.real-data[first-byte] := logior(logand(seq.real-data[first-byte],
+ lognot(ash(#xff, - seq.bit-start-index))),
+ ash(value, - (8 - seq.bit-start-index)));
+ seq.real-data[first-byte + 1] := logior(logand(seq.real-data[first-byte + 1],
+ ash(#xff, - seq.bit-start-index)),
+ logand(#xff, ash(value, 8 - seq.bit-start-index)));
+ else
+ seq.real-data[first-byte] := value;
+ end;
+ end;
+ value;
+end;
+
+
+define inline method encode-integer (value :: <integer>, seq :: <stretchy-byte-vector-subsequence-with-offset>, count :: <integer>)
+ if (value > 2 ^ count - 1)
+ error("value to big for n bits")
+ end;
+ if (seq.end-index & (((seq.end-index - seq.start-index) * 8 - seq.bit-start-index + seq.bit-end-index) < count))
+ signal(make(<out-of-bound-error>))
+ end;
+ let needed-size = ceiling/(count + seq.bit-start-index + seq.start-index * 8, 8);
+ if (seq.real-data.size < needed-size)
+ seq.real-data.size := needed-size
+ end;
+ let (fullbytes, bits) = truncate/(count - 8 + seq.bit-start-index, 8);
+ 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)));
+ else
+ if (seq.bit-start-index = 0)
+ seq.real-data[0] := 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))));
+ 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)));
+ 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)));
+ end;
+ end;
+end;
+
Modified: trunk/libraries/packetizer/util.dylan
==============================================================================
--- trunk/libraries/packetizer/util.dylan (original)
+++ trunk/libraries/packetizer/util.dylan Sun Oct 1 23:43:52 2006
@@ -11,7 +11,8 @@
if(sequence.size > 16)
format(stream, "\n");
end;
- for (byte keyed-by index in sequence)
+ for (byte in sequence,
+ index from 0)
if(sequence.size > 16 & modulo(index, 16) == 0)
format(stream, "%s ", hex(index, size: 4))
end;
Modified: trunk/libraries/pcap/pcap.dylan
==============================================================================
--- trunk/libraries/pcap/pcap.dylan (original)
+++ trunk/libraries/pcap/pcap.dylan Sun Oct 1 23:43:52 2006
@@ -15,7 +15,7 @@
for (i from 0 below packet.caplen)
res[i] := bytes[i];
end;
- push-data(real-interface.the-output, make(unparsed-class(<ethernet-frame>), packet: res));
+ push-data(real-interface.the-output, make(unparsed-class(<ethernet-frame>), packet: as(<stretchy-byte-vector-subsequence>, res)));
end;
define C-callable-wrapper receive-callback of pcap-receive-callback
@@ -169,7 +169,7 @@
define method push-data-aux (input :: <push-input>,
node :: <ethernet-interface>,
frame :: <frame>)
- let buffer = assemble-frame(frame);
+ let buffer = assemble-frame(frame).packet;
pcap-inject(node.pcap-t, buffer-offset(buffer, 0), buffer.size);
end;
More information about the chatter
mailing list