[Gd-chatter] r11008 - in trunk/libraries: gui-sniffer layer monday/lib/program-representation/source-location packetizer protocols
hannes at gwydiondylan.org
hannes at gwydiondylan.org
Thu Nov 30 00:23:21 CET 2006
Author: hannes
Date: Thu Nov 30 00:23:17 2006
New Revision: 11008
Modified:
trunk/libraries/gui-sniffer/gui-sniffer.dylan
trunk/libraries/layer/layer.dylan
trunk/libraries/layer/module.dylan
trunk/libraries/layer/udp.dylan
trunk/libraries/monday/lib/program-representation/source-location/source-location-rangemap.dylan
trunk/libraries/packetizer/module.dylan
trunk/libraries/packetizer/packetizer.dylan
trunk/libraries/packetizer/protocol-definer-macro.dylan
trunk/libraries/protocols/dns.dylan
trunk/libraries/protocols/ipv4.dylan
trunk/libraries/protocols/protocols-library.dylan
Log:
Bug: 7299
*implemented automated layering fields for container-frames
*some code cleanup
Modified: trunk/libraries/gui-sniffer/gui-sniffer.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/gui-sniffer.dylan (original)
+++ trunk/libraries/gui-sniffer/gui-sniffer.dylan Thu Nov 30 00:23:17 2006
@@ -183,21 +183,12 @@
find-protocol-name(frame.payload) | next-method()
end;
-define method find-protocol-name (frame :: type-union(<raw-frame>, <container-frame>))
- let res = payload-type(frame);
- if (res = <raw-frame>)
- #f
- else
- res;
- end;
-end;
-
-define method payload-type (frame :: <container-frame>) => (res)
- frame
+define method find-protocol-name (frame :: <raw-frame>)
+ #f
end;
-define method payload-type (frame :: <raw-frame>) => (res)
- #f
+define method find-protocol-name (frame :: <container-frame>)
+ frame;
end;
define method print-info (frame :: <frame-with-metadata>)
Modified: trunk/libraries/layer/layer.dylan
==============================================================================
--- trunk/libraries/layer/layer.dylan (original)
+++ trunk/libraries/layer/layer.dylan Thu Nov 30 00:23:17 2006
@@ -613,12 +613,12 @@
*/
let ip-layer = make(<ip-layer>);
register-route(ip-layer, make(<next-hop-route>, cidr: as(<cidr>, "0.0.0.0/0"),
- next-hop: ipv4-address("192.168.2.1")));
+ next-hop: ipv4-address("192.168.0.1")));
let ip-over-ethernet = make(<ip-over-ethernet-adapter>,
ethernet: ethernet-layer,
arp: arp-handler,
ip-layer: ip-layer,
- ipv4-address: ipv4-address("192.168.2.23"),
+ ipv4-address: ipv4-address("192.168.0.23"),
netmask: 24);
let icmp-handler = make(<icmp-handler>);
let icmp-over-ip = make(<icmp-over-ip-adapter>,
Modified: trunk/libraries/layer/module.dylan
==============================================================================
--- trunk/libraries/layer/module.dylan (original)
+++ trunk/libraries/layer/module.dylan Thu Nov 30 00:23:17 2006
@@ -24,4 +24,13 @@
use dns, exclude: { ipv4-address };
// Add binding exports here.
+ export <ethernet-layer>,
+ <ip-over-ethernet-adapter>,
+ <ip-layer>,
+ <icmp-handler>,
+ <icmp-over-ip-adapter>,
+ <arp-handler>,
+ register-route,
+ <cidr>,
+ send;
end module layer;
Modified: trunk/libraries/layer/udp.dylan
==============================================================================
--- trunk/libraries/layer/udp.dylan (original)
+++ trunk/libraries/layer/udp.dylan Thu Nov 30 00:23:17 2006
@@ -73,4 +73,4 @@
*/
end;
-udp-begin();
+//udp-begin();
Modified: trunk/libraries/monday/lib/program-representation/source-location/source-location-rangemap.dylan
==============================================================================
--- trunk/libraries/monday/lib/program-representation/source-location/source-location-rangemap.dylan (original)
+++ trunk/libraries/monday/lib/program-representation/source-location/source-location-rangemap.dylan Thu Nov 30 00:23:17 2006
@@ -1,141 +1,141 @@
-Module: source-location-rangemap
-
-
-define constant <boundary-vector> = <stretchy-object-vector>;
- // = limited(<stretchy-vector>, of: <integer>);
-
-define class <source-location-rangemap> (<object>)
- slot rangemap-one-to-one? :: <boolean> = #t,
- init-keyword: one-to-one?:;
-
-constant slot rangemap-file-boundaries :: <boundary-vector>
- = make(<boundary-vector>, size: 1, fill: $maximum-integer);
-constant slot rangemap-file-names :: <stretchy-object-vector>
- = make(<stretchy-object-vector>, size: 1, fill: "");
-constant slot rangemap-line-boundaries :: <boundary-vector>
- = make(<boundary-vector>, size: 1, fill: $maximum-integer);
-constant slot rangemap-line-numbers :: <stretchy-object-vector>
- = make(<stretchy-object-vector>, size: 1, fill: $maximum-integer);
-
-end class;
-
-define method range-source-location
- (rangemap :: <source-location-rangemap>,
- start-position :: <integer>,
- end-position :: <integer>)
- => (location :: <source-location>);
-
-local
- method locate-boundary
- (boundary-vector :: <boundary-vector>,
- position :: <integer>,
- low-index :: <integer>, high-index :: <integer>)
- => (index :: <integer>);
- if (low-index > high-index)
- -1;
- else
- let mid = ash(low-index + high-index, -1);
- if (position < boundary-vector[mid])
- locate-boundary(boundary-vector, position, low-index, mid);
- elseif(position >= boundary-vector[mid + 1])
- locate-boundary(boundary-vector, position, mid + 1, high-index);
- else
- mid;
- end;
- end if;
- end method;
-
-let file-boundaries = rangemap.rangemap-file-boundaries;
-let start-file-boundary
- = locate-boundary(file-boundaries, start-position,
- 0, rangemap.rangemap-file-names.size - 1);
-if (start-file-boundary < 0
- | end-position >= file-boundaries[start-file-boundary + 1])
- make(<unknown-source-location>);
-else
- let line-boundaries = rangemap.rangemap-line-boundaries;
- let start-line-boundary
- = locate-boundary(line-boundaries, start-position,
- 0, rangemap.rangemap-line-numbers.size - 1);
- let end-line-boundary
- = locate-boundary(line-boundaries, end-position,
- start-line-boundary,
- rangemap.rangemap-line-numbers.size - 1);
- if (start-line-boundary < 0 | end-line-boundary < 0)
- make(<unknown-source-location>);
- elseif (rangemap.rangemap-one-to-one?)
-
-let start-column
- = start-position - line-boundaries[start-line-boundary] + 1;
-let end-column
- = end-position - line-boundaries[end-line-boundary] + 1;
-make(<file-source-location>,
- file: rangemap.rangemap-file-names[start-file-boundary],
- start-line: rangemap.rangemap-line-numbers[start-line-boundary],
- start-column: start-column,
- end-line: rangemap.rangemap-line-numbers[end-line-boundary],
- end-column: end-column);
-
- else
-
-make(<file-source-location>,
- file: rangemap.rangemap-file-names[start-file-boundary],
- start-line: rangemap.rangemap-line-numbers[start-line-boundary],
- end-line: rangemap.rangemap-line-numbers[end-line-boundary]);
-
- end if;
-end if;
-
-end method;
-
-define method rangemap-add-line
- (rangemap :: <source-location-rangemap>,
- position :: <integer>,
- line :: false-or(<integer>))
- => ();
-
-rangemap.rangemap-line-boundaries.size
- := rangemap.rangemap-line-boundaries.size + 1;
-rangemap.rangemap-line-numbers.size
- := rangemap.rangemap-line-numbers.size + 1;
-let line-boundaries = rangemap.rangemap-line-boundaries;
-for(i :: <integer> from line-boundaries.size - 1 above 0 by -1,
- while: line-boundaries[i - 1] > position)
- rangemap.rangemap-line-boundaries[i]
- := rangemap.rangemap-line-boundaries[i - 1];
- rangemap.rangemap-line-numbers[i]
- := rangemap.rangemap-line-numbers[i - 1];
-finally
- rangemap.rangemap-line-boundaries[i] := position;
- rangemap.rangemap-line-numbers[i]
- := line | rangemap.rangemap-line-numbers[i - 1] + 1;
-end;
-
-end method;
-
-define method rangemap-add-line-file
- (rangemap :: <source-location-rangemap>,
- position :: <integer>,
- line :: <integer>,
- file :: <file-locator>)
- => ();
- rangemap-add-line(rangemap, position, line);
-
-rangemap.rangemap-file-boundaries.size
- := rangemap.rangemap-file-boundaries.size + 1;
-rangemap.rangemap-file-names.size
- := rangemap.rangemap-file-names.size + 1;
-let file-boundaries = rangemap.rangemap-file-boundaries;
-for(i :: <integer> from file-boundaries.size - 1 above 0 by -1,
- while: file-boundaries[i - 1] > position)
- rangemap.rangemap-file-boundaries[i]
- := rangemap.rangemap-file-boundaries[i - 1];
- rangemap.rangemap-file-names[i]
- := rangemap.rangemap-file-names[i - 1];
-finally
- rangemap.rangemap-file-boundaries[i] := position;
- rangemap.rangemap-file-names[i] := file;
-end;
-
-end method;
-
+Module: source-location-rangemap
+
+
+define constant <boundary-vector> = <stretchy-object-vector>;
+ // = limited(<stretchy-vector>, of: <integer>);
+
+define class <source-location-rangemap> (<object>)
+ slot rangemap-one-to-one? :: <boolean> = #t,
+ init-keyword: one-to-one?:;
+
+constant slot rangemap-file-boundaries :: <boundary-vector>
+ = make(<boundary-vector>, size: 1, fill: $maximum-integer);
+constant slot rangemap-file-names :: <stretchy-object-vector>
+ = make(<stretchy-object-vector>, size: 1, fill: "");
+constant slot rangemap-line-boundaries :: <boundary-vector>
+ = make(<boundary-vector>, size: 1, fill: $maximum-integer);
+constant slot rangemap-line-numbers :: <stretchy-object-vector>
+ = make(<stretchy-object-vector>, size: 1, fill: $maximum-integer);
+
+end class;
+
+define method range-source-location
+ (rangemap :: <source-location-rangemap>,
+ start-position :: <integer>,
+ end-position :: <integer>)
+ => (location :: <source-location>);
+
+local
+ method locate-boundary
+ (boundary-vector :: <boundary-vector>,
+ position :: <integer>,
+ low-index :: <integer>, high-index :: <integer>)
+ => (index :: <integer>);
+ if (low-index > high-index)
+ -1;
+ else
+ let mid = ash(low-index + high-index, -1);
+ if (position < boundary-vector[mid])
+ locate-boundary(boundary-vector, position, low-index, mid);
+ elseif(position >= boundary-vector[mid + 1])
+ locate-boundary(boundary-vector, position, mid + 1, high-index);
+ else
+ mid;
+ end;
+ end if;
+ end method;
+
+let file-boundaries = rangemap.rangemap-file-boundaries;
+let start-file-boundary
+ = locate-boundary(file-boundaries, start-position,
+ 0, rangemap.rangemap-file-names.size - 1);
+if (start-file-boundary < 0
+ | end-position >= file-boundaries[start-file-boundary + 1])
+ make(<unknown-source-location>);
+else
+ let line-boundaries = rangemap.rangemap-line-boundaries;
+ let start-line-boundary
+ = locate-boundary(line-boundaries, start-position,
+ 0, rangemap.rangemap-line-numbers.size - 1);
+ let end-line-boundary
+ = locate-boundary(line-boundaries, end-position,
+ start-line-boundary,
+ rangemap.rangemap-line-numbers.size - 1);
+ if (start-line-boundary < 0 | end-line-boundary < 0)
+ make(<unknown-source-location>);
+ elseif (rangemap.rangemap-one-to-one?)
+
+let start-column
+ = start-position - line-boundaries[start-line-boundary] + 1;
+let end-column
+ = end-position - line-boundaries[end-line-boundary] + 1;
+make(<file-source-location>,
+ file: rangemap.rangemap-file-names[start-file-boundary],
+ start-line: rangemap.rangemap-line-numbers[start-line-boundary],
+ start-column: start-column,
+ end-line: rangemap.rangemap-line-numbers[end-line-boundary],
+ end-column: end-column);
+
+ else
+
+make(<file-source-location>,
+ file: rangemap.rangemap-file-names[start-file-boundary],
+ start-line: rangemap.rangemap-line-numbers[start-line-boundary],
+ end-line: rangemap.rangemap-line-numbers[end-line-boundary]);
+
+ end if;
+end if;
+
+end method;
+
+define method rangemap-add-line
+ (rangemap :: <source-location-rangemap>,
+ position :: <integer>,
+ line :: false-or(<integer>))
+ => ();
+
+rangemap.rangemap-line-boundaries.size
+ := rangemap.rangemap-line-boundaries.size + 1;
+rangemap.rangemap-line-numbers.size
+ := rangemap.rangemap-line-numbers.size + 1;
+let line-boundaries = rangemap.rangemap-line-boundaries;
+for(i :: <integer> from line-boundaries.size - 1 above 0 by -1,
+ while: line-boundaries[i - 1] > position)
+ rangemap.rangemap-line-boundaries[i]
+ := rangemap.rangemap-line-boundaries[i - 1];
+ rangemap.rangemap-line-numbers[i]
+ := rangemap.rangemap-line-numbers[i - 1];
+finally
+ rangemap.rangemap-line-boundaries[i] := position;
+ rangemap.rangemap-line-numbers[i]
+ := line | rangemap.rangemap-line-numbers[i - 1] + 1;
+end;
+
+end method;
+
+define method rangemap-add-line-file
+ (rangemap :: <source-location-rangemap>,
+ position :: <integer>,
+ line :: <integer>,
+ file :: <file-locator>)
+ => ();
+ rangemap-add-line(rangemap, position, line);
+
+rangemap.rangemap-file-boundaries.size
+ := rangemap.rangemap-file-boundaries.size + 1;
+rangemap.rangemap-file-names.size
+ := rangemap.rangemap-file-names.size + 1;
+let file-boundaries = rangemap.rangemap-file-boundaries;
+for(i :: <integer> from file-boundaries.size - 1 above 0 by -1,
+ while: file-boundaries[i - 1] > position)
+ rangemap.rangemap-file-boundaries[i]
+ := rangemap.rangemap-file-boundaries[i - 1];
+ rangemap.rangemap-file-names[i]
+ := rangemap.rangemap-file-names[i - 1];
+finally
+ rangemap.rangemap-file-boundaries[i] := position;
+ rangemap.rangemap-file-names[i] := file;
+end;
+
+end method;
+
Modified: trunk/libraries/packetizer/module.dylan
==============================================================================
--- trunk/libraries/packetizer/module.dylan (original)
+++ trunk/libraries/packetizer/module.dylan Thu Nov 30 00:23:17 2006
@@ -111,7 +111,6 @@
cache,
source-address, source-address-setter,
destination-address, destination-address-setter,
- payload-type,
container-frame-size,
get-protocol-magic, layer-magic,
layer,
Modified: trunk/libraries/packetizer/packetizer.dylan
==============================================================================
--- trunk/libraries/packetizer/packetizer.dylan (original)
+++ trunk/libraries/packetizer/packetizer.dylan Thu Nov 30 00:23:17 2006
@@ -207,8 +207,6 @@
"anonymous"
end;
-define open generic payload-type (frame :: type-union(<raw-frame>, <container-frame>)) => (res);
-
define open generic field-count (frame :: subclass(<container-frame>))
=> (res :: <integer>);
@@ -261,7 +259,7 @@
reverse-layer(bottom-layer)[decoded-class(upper-layer)] := magic;
end;
-define inline method payload-type (frame :: <header-frame>) => (res :: <type>)
+define function payload-type (frame :: <container-frame>) => (res :: <type>)
let table = layer(frame.object-class);
element(table, frame.layer-magic, default: <raw-frame>);
end;
@@ -275,6 +273,13 @@
get-protocol-magic(frame, frame.payload);
end;
+define inline method fixup-protocol-magic (frame :: <container-frame>) => (magic)
+ let res = choose(rcurry(instance?, <variably-typed-field>), fields(frame));
+ if (res.size = 1)
+ get-protocol-magic(frame, res[0].getter(frame));
+ end;
+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)
@@ -290,7 +295,7 @@
end;
-define inline method get-protocol-magic (frame :: <header-frame>, payload :: <frame>) => (magic)
+define inline method get-protocol-magic (frame :: <container-frame>, payload :: <frame>) => (magic)
let reverse-layering = reverse-layer(frame.object-class);
let res = element(reverse-layering, decoded-class(payload.object-class), default: #f);
unless (res)
Modified: trunk/libraries/packetizer/protocol-definer-macro.dylan
==============================================================================
--- trunk/libraries/packetizer/protocol-definer-macro.dylan (original)
+++ trunk/libraries/packetizer/protocol-definer-macro.dylan Thu Nov 30 00:23:17 2006
@@ -61,27 +61,17 @@
$protocols[?#"name"] := "$" ## ?name ## "-fields";
end;
end;
- define constant "$" ## ?name ## "-layering"
- = if (subtype?(?name, <header-frame>))
- make(<table>);
- elseif (?superclasses == <variably-typed-container-frame>)
- make(<table>);
- end;
+ define constant "$" ## ?name ## "-layering" = make(<table>);
define inline method layer (frame :: subclass(?name)) => (res :: false-or(<table>))
"$" ## ?name ## "-layering";
end;
- define constant "$" ## ?name ## "-reverse-layering"
- = if (subtype?(?name, <header-frame>))
- make(<table>);
- elseif (?superclasses == <variably-typed-container-frame>)
- make(<table>);
- end;
+ define constant "$" ## ?name ## "-reverse-layering" = make(<table>);
define inline method reverse-layer (frame :: subclass(?name)) => (res :: false-or(<table>))
"$" ## ?name ## "-reverse-layering"
end;
define inline method recursive-reverse-layer (frame :: subclass(?name), #next next-method)
=> (res :: false-or(<table>))
- if ("$" ## ?name ## "-reverse-layering")
+ if ("$" ## ?name ## "-reverse-layering".size > 0)
"$" ## ?name ## "-reverse-layering"
else
next-method()
Modified: trunk/libraries/protocols/dns.dylan
==============================================================================
--- trunk/libraries/protocols/dns.dylan (original)
+++ trunk/libraries/protocols/dns.dylan Thu Nov 30 00:23:17 2006
@@ -4,6 +4,7 @@
define protocol dns-frame (container-frame)
+ over <udp-frame> 53;
summary "DNS ID=%=, %= questions, %= answers",
identifier, question-count, answer-count;
field identifier :: <2byte-big-endian-unsigned-integer> = 2342;
@@ -132,39 +133,33 @@
define protocol dns-resource-record (container-frame)
field domainname :: <domain-name>;
- field rr-type :: <2byte-big-endian-unsigned-integer>;
+ layering field rr-type :: <2byte-big-endian-unsigned-integer>;
field rr-class :: <2byte-big-endian-unsigned-integer> = 1;
field ttl :: <big-endian-unsigned-integer-4byte>;
field rdlength :: <2byte-big-endian-unsigned-integer>,
fixup: frame.rdata.frame-size.byte-offset;
variably-typed-field rdata,
- type-function: select (frame.rr-type)
- 1 => <a-host-address>;
- 2 => <name-server>;
- 5 => <canonical-name>;
- 6 => <start-of-authority>;
- 12 => <domain-name-pointer>;
- 13 => <host-information>;
- 15 => <mail-exchange>;
- 16 => <text-strings>;
- otherwise => <raw-frame>;
- end,
+ type-function: payload-type(frame),
length: frame.rdlength * 8;
end;
define protocol a-host-address (container-frame)
+ over <dns-resource-record> 1;
field ipv4-address :: <ipv4-address>;
end;
define protocol name-server (container-frame)
+ over <dns-resource-record> 2;
field ns-name :: <domain-name>;
end;
define protocol canonical-name (container-frame)
+ over <dns-resource-record> 5;
field cname :: <domain-name>;
end;
define protocol start-of-authority (container-frame)
+ over <dns-resource-record> 6;
field nameserver :: <domain-name>;
field hostmaster :: <domain-name>;
field serial :: <big-endian-unsigned-integer-4byte>;
@@ -175,6 +170,7 @@
end;
define protocol domain-name-pointer (container-frame)
+ over <dns-resource-record> 12;
field ptr-name :: <domain-name>;
end;
@@ -185,21 +181,24 @@
end;
define protocol host-information (container-frame)
+ over <dns-resource-record> 13;
field cpu :: <character-string>;
field operating-system :: <character-string>;
end;
define method as (class == <string>, frame :: <character-string>)
=> (res :: <string>)
- as(<string>, frame.data);
+ as(<string>, frame.string-data);
end;
define protocol mail-exchange (container-frame)
+ over <dns-resource-record> 15;
field preference :: <2byte-big-endian-unsigned-integer>;
field exchange :: <domain-name>;
end;
define protocol text-strings (container-frame)
+ over <dns-resource-record> 16;
field text-data :: <character-string>;
end;
Modified: trunk/libraries/protocols/ipv4.dylan
==============================================================================
--- trunk/libraries/protocols/ipv4.dylan (original)
+++ trunk/libraries/protocols/ipv4.dylan Thu Nov 30 00:23:17 2006
@@ -149,8 +149,8 @@
define protocol udp-frame (header-frame)
summary "UDP port %= -> %=", source-port, destination-port;
over <ipv4-frame> 17;
- field source-port :: <2byte-big-endian-unsigned-integer>;
- layering field destination-port :: <2byte-big-endian-unsigned-integer>;
+ layering field source-port :: <2byte-big-endian-unsigned-integer>;
+ field destination-port :: <2byte-big-endian-unsigned-integer>;
field payload-size :: <2byte-big-endian-unsigned-integer>,
fixup: byte-offset(frame-size(frame.payload)) + 8;
field checksum :: <2byte-big-endian-unsigned-integer> = 0;
@@ -159,18 +159,6 @@
type-function: payload-type(frame);
end;
-/*define inline method payload-type (frame :: <udp-frame>) => (res :: <type>)
- select (frame.source-port)
- 53 => <dns-frame>;
- 5353 => <dns-frame>;
- otherwise => select (frame.destination-port)
- 53 => <dns-frame>;
- 5353 => <dns-frame>;
- otherwise => <raw-frame>;
- end;
- end;
-end;
-*/
define protocol tcp-frame (header-frame)
summary "TCP %s port %= -> %=", flags-summary, source-port, destination-port;
over <ipv4-frame> 6;
Modified: trunk/libraries/protocols/protocols-library.dylan
==============================================================================
--- trunk/libraries/protocols/protocols-library.dylan (original)
+++ trunk/libraries/protocols/protocols-library.dylan Thu Nov 30 00:23:17 2006
@@ -279,7 +279,7 @@
use packetizer;
use byte-vector, import: { copy-bytes };
use simple-io;
- use ipv4, import: { <ipv4-address> };
+ use ipv4, import: { <ipv4-address>, <udp-frame> };
export <dns-frame>,
identifier, identifier-setter,
More information about the chatter
mailing list