[Gd-chatter] r11653 - trunk/libraries/packetizer
andreas at gwydiondylan.org
andreas at gwydiondylan.org
Thu Jan 24 20:55:29 CET 2008
Author: andreas
Date: Thu Jan 24 20:55:28 2008
New Revision: 11653
Modified:
trunk/libraries/packetizer/filter-parser.dylan
trunk/libraries/packetizer/filter.dylan
trunk/libraries/packetizer/packetizer.dylan
trunk/libraries/packetizer/protocol-definer-macro.dylan
Log:
job: 7299
Re-write of packet filtering, so that abstract base frames can be matched
too.
Modified: trunk/libraries/packetizer/filter-parser.dylan
==============================================================================
--- trunk/libraries/packetizer/filter-parser.dylan (original)
+++ trunk/libraries/packetizer/filter-parser.dylan Thu Jan 24 20:55:28 2008
@@ -63,18 +63,13 @@
production filter => [Name], action:
method(p :: <simple-parser>, data, s, e)
let (res, frame-name) = find-protocol(p[0]);
- make(<frame-present>, frame: as(<symbol>, frame-name));
+ make(<frame-present>, type: res);
end;
production filter => [Name DOT Name EQUALS value], action:
method(p :: <simple-parser>, data, s, e)
- let (field, frame-name) = find-protocol-field(p[0], p[2]);
- make(<field-equals>,
- frame: as(<symbol>, frame-name),
- name: as(<symbol>, p[2]),
- value: read-frame(field.type, p[4]),
- field: field);
- //XXX: only works for statically typed fields, no support for repeated fields..
+ build-field-equals-filter(p[0], p[2], p[4]);
+ //XXX: only works for statically typed fields, no support for repeated fields..
end;
production compound-filter => [filter], action:
@@ -114,13 +109,13 @@
end;
define method print-object (filter :: <frame-present>, stream :: <stream>) => ();
- format(stream, "%s", filter.filter-frame-name);
+ format(stream, "%s", filter.filter-frame-type.frame-name);
end;
define method print-object (filter :: <field-equals>, stream :: <stream>) => ();
format(stream,
"%s.%s = %s",
- filter.filter-frame-name,
+ filter.filter-frame-type.frame-name,
filter.filter-field-name,
filter.filter-field-value);
end;
@@ -141,21 +136,19 @@
field-name :: type-union(<string>, <symbol>),
value)
=> (filter :: <field-equals>)
- if (instance?(frame-type, <symbol>))
- frame-type := as(<string>, frame-type)
- end;
- unless (instance?(frame-type, <string>))
- frame-type := frame-type.frame-name;
- end;
+ let protocol = select (frame-type by instance?)
+ <string>, <symbol> => find-protocol(frame-type);
+ otherwise => frame-type;
+ end;
if (instance?(field-name, <symbol>))
field-name := as(<string>, field-name)
end;
- let (field, frame-name) = find-protocol-field(frame-type, field-name);
+ let field = find-protocol-field(protocol, field-name);
unless (instance?(value, high-level-type(field.type)))
value := read-frame(field.type, value);
end;
make(<field-equals>,
- frame: as(<symbol>, frame-name),
+ type: protocol,
name: as(<symbol>, field-name),
value: value,
field: field);
Modified: trunk/libraries/packetizer/filter.dylan
==============================================================================
--- trunk/libraries/packetizer/filter.dylan (original)
+++ trunk/libraries/packetizer/filter.dylan Thu Jan 24 20:55:28 2008
@@ -14,12 +14,12 @@
end;
define class <frame-present> (<filter-expression>)
- slot filter-frame-name :: <symbol>, required-init-keyword: frame:;
+ slot filter-frame-type :: <class>, required-init-keyword: type:;
end;
define method matches? (packet :: <container-frame>, filter :: <frame-present>)
=> (match? :: <boolean>)
- as(<symbol>, packet.frame-name) = filter.filter-frame-name
+ instance?(packet, filter.filter-frame-type);
end;
define method matches? (packet :: <header-frame>, filter :: <frame-present>)
@@ -28,16 +28,16 @@
end;
define class <field-equals> (<filter-expression>)
- slot filter-frame-name :: <symbol>, required-init-keyword: frame:;
+ slot filter-frame-type :: <class>, required-init-keyword: type:;
slot filter-field-name :: <symbol>, required-init-keyword: name:;
slot filter-field :: <field>, required-init-keyword: field:;
slot filter-field-value, required-init-keyword: value:;
end;
define method matches? (packet :: <container-frame>, filter :: <field-equals>)
- => (match? :: <boolean>);
- (as(<symbol>, packet.frame-name) = filter.filter-frame-name)
- & (filter.filter-field.getter(packet) = filter.filter-field-value)
+ => (match? :: <boolean>);
+ instance?(packet, filter.filter-frame-type)
+ & (filter.filter-field.getter(packet) = filter.filter-field-value)
end;
define method matches? (packet :: <header-frame>, filter :: <field-equals>)
Modified: trunk/libraries/packetizer/packetizer.dylan
==============================================================================
--- trunk/libraries/packetizer/packetizer.dylan (original)
+++ trunk/libraries/packetizer/packetizer.dylan Thu Jan 24 20:55:28 2008
@@ -47,17 +47,17 @@
define constant $protocols = make(<table>);
define method find-protocol-aux (protocol :: <string>)
- => (res :: false-or(<simple-vector>))
+ => (res :: false-or(<class>))
find-protocol-aux(as(<symbol>, protocol));
end;
define method find-protocol-aux (protocol :: <symbol>)
- => (res :: false-or(<simple-vector>))
+ => (res :: false-or(<class>))
element($protocols, protocol, default: #f);
end;
define function find-protocol (name :: <string>)
- => (res :: <simple-vector>, frame-name :: <string>)
+ => (res :: <class>, frame-name :: <string>)
let protocol-name = name;
let res = find-protocol-aux(protocol-name);
unless(res)
@@ -74,15 +74,13 @@
values(res, protocol-name);
end;
-define function find-protocol-field (protocol-name :: <string>, field-name :: <string>)
- => (res :: <field>, frame-name :: <string>)
- let (protocol-fields, frame-name) = find-protocol(protocol-name);
- let field = find-field(field-name, protocol-fields);
- if (field)
- values(field, frame-name);
- else
- error("Field %s in protocol %s not found\n", field-name, protocol-name);
+define function find-protocol-field (protocol :: <class>, field-name :: <string>)
+ => (res :: <field>)
+ let field = find-field(field-name, fields(protocol));
+ unless (field)
+ error("Field %s in protocol %s not found\n", field-name, protocol.frame-name);
end;
+ field
end;
define abstract class <frame> (<object>)
@@ -217,7 +215,7 @@
0;
end;
-define open generic fields (frame :: <container-frame>)
+define open generic fields (frame :: type-union(<container-frame>, subclass(<container-frame>)))
=> (res :: <simple-vector>);
define open generic fields-initializer (frame :: subclass(<container-frame>))
Modified: trunk/libraries/packetizer/protocol-definer-macro.dylan
==============================================================================
--- trunk/libraries/packetizer/protocol-definer-macro.dylan (original)
+++ trunk/libraries/packetizer/protocol-definer-macro.dylan Thu Jan 24 20:55:28 2008
@@ -67,9 +67,13 @@
define inline method frame-name (frame :: subclass(?name)) => (res :: <string>)
?"name"
end;
+ // XXX: unify clients
define inline method fields (frame :: ?name) => (res :: <simple-vector>)
"$" ## ?name ## "-fields"
end;
+ define inline method fields (frame-type :: subclass(?name)) => (res :: <simple-vector>)
+ "$" ## ?name ## "-fields"
+ end;
define method fields-initializer
(frame :: subclass(?name), #next next-method) => (frame-fields :: <simple-vector>)
let res = concatenate(next-method(), vector(?fields-aux));
@@ -84,7 +88,7 @@
if (element($protocols, ?#"name", default: #f))
error("Protocol with same name already exists");
else
- $protocols[?#"name"] := "$" ## ?name ## "-fields";
+ $protocols[?#"name"] := ?name;
end;
end;
define constant "$" ## ?name ## "-layer-bonding"
More information about the chatter
mailing list