[Gd-chatter] r10882 - in trunk/libraries: gui-sniffer packetizer
hannes at gwydiondylan.org
hannes at gwydiondylan.org
Sun Sep 3 03:13:02 CEST 2006
Author: hannes
Date: Sun Sep 3 03:12:58 2006
New Revision: 10882
Modified:
trunk/libraries/gui-sniffer/gui-sniffer.dylan
trunk/libraries/packetizer/ethernet.dylan
trunk/libraries/packetizer/ipv4.dylan
trunk/libraries/packetizer/logical-link.dylan
trunk/libraries/packetizer/module.dylan
trunk/libraries/packetizer/packetizer.dylan
trunk/libraries/packetizer/protocol-definer-macro.dylan
Log:
Bug: 7299
*provide layer-bonding macro to specify layering outside of the header-frame protocol definition
-> not really happy since it fails for the udp case:
frame.source-port = 53 | frame.destination-port = 53
*frame-name is now defined on the class, not on the instance (instance delegates to frame-name on its object-class)
*gui-sniffer uses nicer (and more correct) way to get source-address, destination-address, protocol and summary information
Modified: trunk/libraries/gui-sniffer/gui-sniffer.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/gui-sniffer.dylan (original)
+++ trunk/libraries/gui-sniffer/gui-sniffer.dylan Sun Sep 3 03:12:58 2006
@@ -138,82 +138,88 @@
end;
define method print-source (frame :: <frame-with-metadata>)
- print-source(frame.real-frame) | "Unknown"
-end;
-
-define method print-source (frame :: <header-frame>)
- print-source(frame.payload);
-end;
-
-define method print-source (frame :: <frame>)
- #f;
+ let source = find-source-address(frame.real-frame);
+ if (source)
+ as(<string>, source)
+ else
+ "Unknown"
+ end;
end;
-define method print-source (frame :: <ethernet-frame>)
- next-method() | as(<string>, frame.source-address)
+define method find-source-address (frame :: <header-frame>)
+ find-source-address(frame.payload) | next-method();
end;
-define method print-source (frame :: <ipv4-frame>)
- next-method() | as(<string>, frame.source-address)
+define method find-source-address (frame)
+ source-address(frame);
end;
-/*define method print-source (frame :: <arp-frame>)
- as(<string>, frame.source-ip-address)
-end;*/
-
-define method print-source (frame :: <ieee80211-management-frame>)
- next-method() | as(<string>, frame.source-address)
+define method source-address (frame :: type-union(<raw-frame>, <container-frame>)) => (res)
+ #f;
end;
define method print-destination (frame :: <frame-with-metadata>)
- print-destination(frame.real-frame) | "Unknown"
+ let destination = find-destination-address(frame.real-frame);
+ if (destination)
+ as(<string>, destination);
+ else
+ "Unknown"
+ end;
end;
-define method print-destination (frame :: <header-frame>)
- print-destination(frame.payload);
+define method find-destination-address (frame :: <header-frame>)
+ find-destination-address(frame.payload) | next-method();
end;
-define method print-destination (frame :: <frame>)
- #f;
+define method find-destination-address (frame)
+ destination-address(frame)
end;
-define method print-destination (frame :: <ethernet-frame>)
- next-method() | as(<string>, frame.destination-address)
+define method destination-address (frame :: type-union(<raw-frame>, <container-frame>)) => (res)
+ #f
end;
-define method print-destination (frame :: <ipv4-frame>)
- next-method() | as(<string>, frame.destination-address)
+define method print-protocol (frame :: <frame-with-metadata>)
+ let proto = find-protocol-name(frame.real-frame);
+ if (proto)
+ proto.frame-name;
+ else
+ "Unknown"
+ end;
end;
-define method print-destination (frame :: <ieee80211-management-frame>)
- next-method() | as(<string>, frame.destination-address)
+define method find-protocol-name (frame :: <header-frame>)
+ find-protocol-name(frame.payload) | next-method()
end;
-/*define method print-destination (frame :: <arp-frame>)
- if (frame.target-mac-address ~= mac-address("00:00:00:00:00:00"))
- as(<string>, frame.target-ip-address)
+define method find-protocol-name (frame :: type-union(<raw-frame>, <container-frame>))
+ let res = payload-type(frame);
+ if (res = <raw-frame>)
+ #f
else
- "Broadcast"
+ res;
end;
-end;*/
-
-define method print-protocol (frame :: <frame-with-metadata>)
- print-protocol(frame.real-frame) | "Unknown"
end;
-define method print-protocol (frame :: <ethernet-frame>)
- next-method() | frame.type-code
+define method payload-type (frame :: type-union(<raw-frame>, <container-frame>)) => (res)
+ #f
end;
-define method print-protocol (frame :: <header-frame>)
- print-protocol(frame.payload);
+define method print-info (frame :: <frame-with-metadata>)
+ find-print-info(frame.real-frame)
end;
-define method print-protocol (frame :: <frame>)
- #f
+define method find-print-info (frame :: <header-frame>) => (res)
+ find-print-info(frame.payload) | next-method()
end;
-define method print-info (frame :: <frame-with-metadata>)
- summary(frame.real-frame.payload)
+
+define method find-print-info (frame :: type-union(<raw-frame>, <container-frame>))
+ let cur = summary(frame);
+ if (cur = format-to-string("%=", frame.object-class))
+ #f
+ else
+ cur;
+ end;
end;
define method print-number (frame :: <frame-with-metadata>)
Modified: trunk/libraries/packetizer/ethernet.dylan
==============================================================================
--- trunk/libraries/packetizer/ethernet.dylan (original)
+++ trunk/libraries/packetizer/ethernet.dylan Sun Sep 3 03:12:58 2006
@@ -43,10 +43,11 @@
field source-address :: <mac-address>;
field type-code :: <2byte-big-endian-unsigned-integer>;
variably-typed-field payload,
- type-function:
- select (frame.type-code)
- #x800 => <ipv4-frame>;
- #x806 => <arp-frame>;
- otherwise <raw-frame>;
- end;
+ type-function: payload-type(frame);
end;
+
+define layer-bonding <ethernet-frame> (type-code)
+ #x800 => <ipv4-frame>;
+ #x806 => <arp-frame>
+end;
+
Modified: trunk/libraries/packetizer/ipv4.dylan
==============================================================================
--- trunk/libraries/packetizer/ipv4.dylan (original)
+++ trunk/libraries/packetizer/ipv4.dylan Sun Sep 3 03:12:58 2006
@@ -142,12 +142,13 @@
variably-typed-field payload,
start: frame.header-length * 4 * 8,
end: frame.total-length * 8,
- type-function: select (frame.protocol)
- 1 => <icmp-frame>;
- 6 => <tcp-frame>;
- 17 => <udp-frame>;
- otherwise => <raw-frame>;
- end;
+ type-function: payload-type(frame);
+end;
+
+define layer-bonding <ipv4-frame> (protocol)
+ 1 => <icmp-frame>;
+ 6 => <tcp-frame>;
+ 17 => <udp-frame>
end;
@@ -167,14 +168,19 @@
field checksum :: <2byte-big-endian-unsigned-integer>;
variably-typed-field payload,
end: frame.length * 8,
- type-function: if (frame.source-port = 53
- | frame.destination-port = 53
- | frame.source-port = 5353
- | frame.destination-port = 5353)
- <dns-frame>
- else
- <raw-frame>
- end;
+ 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;
// FIXME: must do for now
Modified: trunk/libraries/packetizer/logical-link.dylan
==============================================================================
--- trunk/libraries/packetizer/logical-link.dylan (original)
+++ trunk/libraries/packetizer/logical-link.dylan Sun Sep 3 03:12:58 2006
@@ -2,23 +2,19 @@
Author: Andreas Bogk, Hannes Mehnert
Copyright: (C) 2005, 2006, All rights reserved. Free for non-commercial use.
-define protocol logical-link-control (header-frame)
- summary "%s", compose(summary, payload);
- field type-code :: <2byte-big-endian-unsigned-integer>;
- variably-typed-field payload,
- type-function:
- select (frame.type-code)
- #x800 => <ipv4-frame>;
- #x806 => <arp-frame>;
- otherwise <raw-frame>;
- end;
-end;
-
define protocol link-control (header-frame)
summary "%s", compose(summary, payload);
field dsap :: <unsigned-byte>;
field ssap :: <unsigned-byte>;
field control :: <unsigned-byte>;
field organisation-code :: <3byte-big-endian-unsigned-integer>;
- field payload :: <logical-link-control>;
+ field type-code :: <2byte-big-endian-unsigned-integer>;
+ variably-typed-field payload,
+ type-function: payload-type(frame);
end;
+
+define layer-bonding <link-control> (type-code)
+ #x800 => <ipv4-frame>;
+ #x806 => <arp-frame>
+end;
+
Modified: trunk/libraries/packetizer/module.dylan
==============================================================================
--- trunk/libraries/packetizer/module.dylan (original)
+++ trunk/libraries/packetizer/module.dylan Sun Sep 3 03:12:58 2006
@@ -24,8 +24,7 @@
<ieee80211-data-frame>,
<ieee80211-management-frame>,
<ieee80211-control-frame>,
- operation, source-address, destination-address,
- type-code, <arp-frame>, target-mac-address,
+ operation, type-code, <arp-frame>, target-mac-address,
target-ip-address, source-ip-address, source-mac-address,
mac-address, ipv4-address,
<decoded-arp-frame>, <decoded-ethernet-frame>,
@@ -104,7 +103,10 @@
field-count,
fixup!,
parent,
- packet;
+ packet,
+ source-address,
+ destination-address,
+ payload-type;
export <header-frame>,
<unparsed-header-frame>,
Modified: trunk/libraries/packetizer/packetizer.dylan
==============================================================================
--- trunk/libraries/packetizer/packetizer.dylan (original)
+++ trunk/libraries/packetizer/packetizer.dylan Sun Sep 3 03:12:58 2006
@@ -197,12 +197,22 @@
virtual constant slot frame-name :: <string>;
end;
-define open generic frame-name (frame :: <container-frame>) => (res :: <string>);
+define open generic frame-name (frame :: type-union(subclass(<container-frame>), <container-frame>)) => (res :: <string>);
-define method frame-name(frame :: <container-frame>) => (res :: <string>)
+define inline method frame-name (frame :: <container-frame>) => (res :: <string>)
+ frame-name(frame.object-class);
+end;
+
+define method frame-name(frame :: subclass(<container-frame>)) => (res :: <string>)
"anonymous"
end;
+define open generic source-address (frame :: type-union(<raw-frame>, <container-frame>)) => (res);
+
+define open generic destination-address (frame :: type-union(<raw-frame>, <container-frame>)) => (res);
+
+define open generic payload-type (frame :: type-union(<raw-frame>, <container-frame>)) => (res);
+
define open generic field-count (frame :: subclass(<container-frame>))
=> (res :: <integer>);
Modified: trunk/libraries/packetizer/protocol-definer-macro.dylan
==============================================================================
--- trunk/libraries/packetizer/protocol-definer-macro.dylan (original)
+++ trunk/libraries/packetizer/protocol-definer-macro.dylan Sun Sep 3 03:12:58 2006
@@ -7,7 +7,7 @@
{ real-class-definer(?:name; ?superclasses:*; ?fields-aux:*) }
=> { define abstract class ?name (?superclasses)
end;
- define inline method frame-name (frame :: ?name) => (res :: <string>)
+ define inline method frame-name (frame :: subclass(?name)) => (res :: <string>)
?"name"
end;
define inline method fields (frame :: ?name) => (res :: <simple-vector>)
@@ -170,7 +170,7 @@
{ unparsed-frame-field-generator(?:name,
?frame-type:name,
?field-index:expression) }
- => { define inline method ?name (mframe :: ?frame-type)
+ => { define inline method ?name (mframe :: ?frame-type) => (res)
if (mframe.cache.?name)
mframe.cache.?name
else
@@ -183,8 +183,7 @@
end;
mframe.cache.?name
end;
- end;
- define sealed domain ?name (?frame-type); }
+ end; }
end;
define method parse-frame-field
@@ -393,6 +392,7 @@
{ summary-generator("<" ## ?name ## ">"; ?summary);
define protocol ?name (?superprotocol) ?fields end; }
+
{ define protocol ?:name (container-frame) end } =>
{ define abstract class "<" ## ?name ## ">" (<container-frame>) end;
define abstract class "<decoded-" ## ?name ## ">"
@@ -410,10 +410,44 @@
gen-classes(?name; ?superprotocol);
frame-field-generator("<unparsed-" ## ?name ## ">";
field-count("<unparsed-" ## ?superprotocol ## ">");
- ?fields);
- }
+ ?fields); }
+end;
+
+define macro forward-bonding
+ { forward-bonding(?:name; ?field:expression; ?bondings:*) }
+ => { define inline method payload-type (frame :: ?name) => (res :: <type>)
+ select (frame.?field)
+ ?bondings;
+ otherwise => <raw-frame>;
+ end;
+ end; }
end;
+define macro reverse-bonding
+ { reverse-bonding(?:name; ?field:expression; ?bondings:*) }
+ => { define inline method get-protocol-magic (frame :: ?name, payload :: <frame>)
+ let value =
+ select (payload.object-class)
+ ?bondings;
+ otherwise =>
+ error("Unknown layer bonding tried %= over %=", payload.frame-name, frame.frame-name)
+ end;
+ values(frame.?field, value)
+ end; }
+
+ bondings:
+ { } => { }
+ { ?key:expression => ?value:expression; ... } =>
+ { ?value => ?key; ... }
+end;
+define macro layer-bonding-definer
+ { define layer-bonding ?:name (?field:expression)
+ ?bondings:*
+ end } =>
+ { forward-bonding(?name; ?field; ?bondings);
+ reverse-bonding(?name; ?field; ?bondings); }
+end;
+
define macro leaf-frame-constructor-definer
{ define leaf-frame-constructor(?:name) end }
=>
More information about the chatter
mailing list