[Gd-chatter] r11453 - trunk/libraries/protocols

[hannes at gwydiondylan.org]

Author: hannes
Date: Sat Sep 15 20:50:32 2007
New Revision: 11453

Modified:
   trunk/libraries/protocols/dns.dylan
   trunk/libraries/protocols/tcp.dylan
Log:
Job: 7299
some cleanup in tcp (line break)
implement assemble-frame-into for dns (not yet tested)


Modified: trunk/libraries/protocols/dns.dylan
==============================================================================
--- trunk/libraries/protocols/dns.dylan	(original)
+++ trunk/libraries/protocols/dns.dylan	Sat Sep 15 20:50:32 2007
@@ -2,7 +2,20 @@
 Author:    Andreas Bogk, Hannes Mehnert
 Copyright: (C) 2005, 2006,  All rights reserved. Free for non-commercial use.
 
-define protocol dns-frame (container-frame)
+define abstract class <container-frame-with-metadata> (<container-frame>)
+  constant slot index-table :: <table> = make(<table>);
+  constant slot symbol-table :: <string-table> = make(<string-table>);
+end;
+
+define abstract class <decoded-container-frame-with-metadata>
+ (<container-frame-with-metadata>, <decoded-container-frame>)
+end;
+
+define abstract class <unparsed-container-frame-with-metadata>
+ (<container-frame-with-metadata>, <unparsed-container-frame>)
+end;
+
+define protocol dns-frame (container-frame-with-metadata)
   over <udp-frame> 53;
   summary "DNS ID=%=, %= questions, %= answers",
     identifier, question-count, answer-count;
@@ -33,6 +46,28 @@
     count: frame.additional-count;
 end;
 
+define method assemble-frame-into
+ (frame :: <domain-name>, packet :: <stretchy-byte-vector-subsequence>)
+ => (res :: <integer>)
+  //assumption: frame.parent.parent is the <dns-frame>!
+  let name-table = frame.parent.parent.symbol-table;
+  let offset = 0;
+  local method encode-fragments (frags :: <collection>) => (res :: <integer>)
+          let strings = map(curry(as, <string>), frags);
+          let name =  reduce1(method(a, b) concatenate(a, ".", b) end, strings);
+          let offset = element(name-table, name, default: #f);
+          if (offset)
+            assemble-frame-into(make(<label-offset>, offset: offset), packet);
+          else
+            name-table[name] := packet.start-index + offset;
+            offset := offset + assemble-frame-into(frags[0], packet);
+            encode-fragments(subsequence(frags, start: 1));
+          end;
+        end;
+  encode-fragments(frame.fragment);
+  offset;
+end;
+
 define protocol domain-name (container-frame)
   summary "%s", curry(as, <string>);
   repeated field fragment :: <domain-name-fragment>,

Modified: trunk/libraries/protocols/tcp.dylan
==============================================================================
--- trunk/libraries/protocols/tcp.dylan	(original)
+++ trunk/libraries/protocols/tcp.dylan	Sat Sep 15 20:50:32 2007
@@ -11,7 +11,9 @@
   field sequence-number :: <big-endian-unsigned-integer-4byte>;
   field acknowledgement-number :: <big-endian-unsigned-integer-4byte>;
   field data-offset :: <4bit-unsigned-integer>,
-   fixup: ceiling/(20 + byte-offset(reduce(method(x, y) frame-size(y) + x end, 0, frame.options-and-padding)), 4);
+   fixup: ceiling/(20 + byte-offset(reduce(method(x, y)
+                                               frame-size(y) + x
+                                           end, 0, frame.options-and-padding)), 4);
   field reserved :: <6bit-unsigned-integer> = 0;
   field urg :: <1bit-unsigned-integer> = 0;
   field ack :: <1bit-unsigned-integer> = 0;
@@ -22,7 +24,8 @@
   field window :: <2byte-big-endian-unsigned-integer> = 0;
   field checksum :: <2byte-big-endian-unsigned-integer> = 0;
   field urgent-pointer :: <2byte-big-endian-unsigned-integer> = 0;
-  repeated field options-and-padding :: <tcp-option>, reached-end?: instance?(frame, <end-of-option>);
+  repeated field options-and-padding :: <tcp-option>,
+    reached-end?: instance?(frame, <end-of-option>);
   field payload :: <raw-frame> = make(<raw-frame>, data: make(<stretchy-byte-vector-subsequence>)),
     start: frame.data-offset * 4 * 8;
 end;