[Gd-chatter] r11005 - in trunk/libraries: packetizer protocols
hannes at gwydiondylan.org
hannes at gwydiondylan.org
Wed Nov 29 21:45:40 CET 2006
Author: hannes
Date: Wed Nov 29 21:45:35 2006
New Revision: 11005
Modified:
trunk/libraries/packetizer/module.dylan
trunk/libraries/packetizer/packetizer.dylan
trunk/libraries/packetizer/protocol-definer-macro.dylan
trunk/libraries/protocols/ethernet.dylan
Log:
Bug: 7299
*support for dynamic sized container frames
*fix assembly (actually, fixup) of <variably-typed-container-frame>
Modified: trunk/libraries/packetizer/module.dylan
==============================================================================
--- trunk/libraries/packetizer/module.dylan (original)
+++ trunk/libraries/packetizer/module.dylan Wed Nov 29 21:45:35 2006
@@ -112,8 +112,10 @@
source-address, source-address-setter,
destination-address, destination-address-setter,
payload-type,
- get-protocol-magic,
- layer, reverse-layer, layer-magic;
+ container-frame-size,
+ get-protocol-magic, layer-magic,
+ layer,
+ reverse-layer, recursive-reverse-layer;
export <header-frame>,
<unparsed-header-frame>,
Modified: trunk/libraries/packetizer/packetizer.dylan
==============================================================================
--- trunk/libraries/packetizer/packetizer.dylan (original)
+++ trunk/libraries/packetizer/packetizer.dylan Wed Nov 29 21:45:35 2006
@@ -148,6 +148,12 @@
fixup!(frame.payload);
end;
+define open generic container-frame-size (frame :: <container-frame>) => (length :: false-or(<integer>));
+
+define method container-frame-size (frame :: <container-frame>) => (res :: false-or(<integer>))
+ #f
+end;
+
define open generic frame-size (frame :: type-union(<frame>, subclass(<fixed-size-frame>)))
=> (length :: <integer>);
@@ -260,13 +266,30 @@
element(table, frame.layer-magic, default: <raw-frame>);
end;
+define open generic recursive-reverse-layer (frame) => (res :: false-or(<table>));
+
+define inline method recursive-reverse-layer (frame) => (res :: false-or(<table>))
+ #f
+end;
define inline method fixup-protocol-magic (frame :: <header-frame>) => (magic)
get-protocol-magic(frame, frame.payload);
end;
-//define inline method fixup-protocol-magic (frame :: <variably-typed-container-frame>) => (magic)
-// get-protocol-magic
-//end;
+define inline method fixup-protocol-magic (frame :: <variably-typed-container-frame>) => (magic)
+ let layer-table = recursive-reverse-layer(frame.object-class);
+ if (layer-table)
+ let res = element(layer-table, frame.object-class, default: #f);
+ if (res)
+ res
+ else
+ error("Inline layering not found for %=", frame);
+ end;
+ else
+ error("No non-empty layering table not found for %=", frame);
+ end;
+end;
+
+
define inline method get-protocol-magic (frame :: <header-frame>, payload :: <frame>) => (magic)
let reverse-layering = reverse-layer(frame.object-class);
let res = element(reverse-layering, decoded-class(payload.object-class), default: #f);
Modified: trunk/libraries/packetizer/protocol-definer-macro.dylan
==============================================================================
--- trunk/libraries/packetizer/protocol-definer-macro.dylan (original)
+++ trunk/libraries/packetizer/protocol-definer-macro.dylan Wed Nov 29 21:45:35 2006
@@ -64,7 +64,7 @@
define constant "$" ## ?name ## "-layering"
= if (subtype?(?name, <header-frame>))
make(<table>);
- elseif (subtype?(?name, <variably-typed-container-frame>))
+ elseif (?superclasses == <variably-typed-container-frame>)
make(<table>);
end;
define inline method layer (frame :: subclass(?name)) => (res :: false-or(<table>))
@@ -73,11 +73,19 @@
define constant "$" ## ?name ## "-reverse-layering"
= if (subtype?(?name, <header-frame>))
make(<table>);
- elseif (subtype?(?name, <variably-typed-container-frame>))
+ elseif (?superclasses == <variably-typed-container-frame>)
make(<table>);
end;
define inline method reverse-layer (frame :: subclass(?name)) => (res :: false-or(<table>))
- "$" ## ?name ## "-reverse-layering";
+ "$" ## ?name ## "-reverse-layering"
+ end;
+ define inline method recursive-reverse-layer (frame :: subclass(?name), #next next-method)
+ => (res :: false-or(<table>))
+ if ("$" ## ?name ## "-reverse-layering")
+ "$" ## ?name ## "-reverse-layering"
+ else
+ next-method()
+ end;
end;
define constant "$" ## ?name ## "-layer-bonding"
= begin
@@ -423,14 +431,20 @@
end;
define method parse-frame (frame-type :: subclass(<container-frame>),
- packet :: <byte-sequence>,
+ byte-packet :: <byte-sequence>,
#key parent :: false-or(<container-frame>))
let frame = make(unparsed-class(frame-type),
- packet: packet,
+ packet: byte-packet,
parent: parent);
let length = field-size(frame-type);
if (length = $unknown-at-compile-time)
- frame;
+ let fr-length = container-frame-size(frame);
+ if (fr-length)
+ frame.packet := subsequence(frame.packet, length: fr-length);
+ values(frame, fr-length);
+ else
+ frame
+ end;
else
values(frame, length)
end;
@@ -484,6 +498,18 @@
}
{ define protocol ?:name (?superprotocol:name)
+ length ?container-frame-length:expression;
+ ?fields:*
+ end } =>
+ {
+ define protocol ?name (?superprotocol) ?fields end;
+ define inline method container-frame-size (?=frame :: "<" ## ?name ## ">") => (res :: <integer>)
+ ?container-frame-length
+ end;
+ }
+
+
+ { define protocol ?:name (?superprotocol:name)
?fields:*
end } =>
{ //protocol-module-definer(?name; ?superprotocol; ?fields);
Modified: trunk/libraries/protocols/ethernet.dylan
==============================================================================
--- trunk/libraries/protocols/ethernet.dylan (original)
+++ trunk/libraries/protocols/ethernet.dylan Wed Nov 29 21:45:35 2006
@@ -122,20 +122,18 @@
end;
define protocol cdp-record (variably-typed-container-frame)
+ length frame.cdp-length * 8;
layering field cdp-type :: <2byte-big-endian-unsigned-integer>;
- field cdp-length :: <2byte-big-endian-unsigned-integer>;
-end;
-
-define method frame-size (frame :: <cdp-record>) => (res :: <integer>)
- frame.cdp-length * 8;
+ field cdp-length :: <2byte-big-endian-unsigned-integer>,
+ fixup: byte-offset(frame-size(frame));
end;
define protocol cdp-unknown-record (cdp-record)
- field cdp-value :: <raw-frame>, end: frame.cdp-length * 8;
+ field cdp-value :: <raw-frame>;
end;
define protocol cdp-string-record (cdp-record)
- field cdp-value :: <externally-delimited-string>, end: frame.cdp-length * 8;
+ field cdp-value :: <externally-delimited-string>;
end;
define protocol cdp-device-id (cdp-string-record)
@@ -156,7 +154,6 @@
field address-count :: <unsigned-byte>;
repeated field cdp-addresses :: <cdp-address>,
count: frame.address-count;
- field padding :: <raw-frame>, end: frame.cdp-length * 8;
end;
define protocol cdp-port-id (cdp-string-record)
More information about the chatter
mailing list