r11005 - in trunk/libraries: packetizer protocols

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)
-- 
Gd-chatter mailing list
Gd-chatter@xxxxxxxxxxxxxxxx
https://www.opendylan.org/mailman/listinfo/gd-chatter