[Gd-chatter] r11691 - in trunk/libraries: gui-sniffer layer network/ip-stack/layers/media-access network/ip-stack/layers/media-access/802-1q network/ip-stack/layers/media-access/bridge-group network/ip-stack/layers/physical/pcap-live-interface registry/generic
andreas at gwydiondylan.org
andreas at gwydiondylan.org
Fri Feb 22 02:17:32 CET 2008
Author: andreas
Date: Fri Feb 22 02:17:31 2008
New Revision: 11691
Added:
trunk/libraries/layer/socket.dylan (contents, props changed)
trunk/libraries/network/ip-stack/layers/media-access/
trunk/libraries/network/ip-stack/layers/media-access/802-1q/
trunk/libraries/network/ip-stack/layers/media-access/bridge-group/
trunk/libraries/network/ip-stack/layers/media-access/bridge-group/bridge-group.dylan (contents, props changed)
trunk/libraries/network/ip-stack/layers/media-access/bridge-group/bridge-group.lid (contents, props changed)
trunk/libraries/network/ip-stack/layers/media-access/bridge-group/library.dylan (contents, props changed)
trunk/libraries/registry/generic/bridge-group (contents, props changed)
Modified:
trunk/libraries/gui-sniffer/commands.dylan
trunk/libraries/gui-sniffer/gui-sniffer.dylan
trunk/libraries/gui-sniffer/layer-commands.dylan
trunk/libraries/gui-sniffer/library.dylan
trunk/libraries/gui-sniffer/module.dylan
trunk/libraries/layer/layer.hdp
trunk/libraries/layer/library.dylan
trunk/libraries/layer/module.dylan
trunk/libraries/layer/new-layer.dylan
trunk/libraries/network/ip-stack/layers/physical/pcap-live-interface/library.dylan
trunk/libraries/network/ip-stack/layers/physical/pcap-live-interface/pcap-live-interface.dylan
Log:
job: 7299
Implementation of bridge-group, commands for connecting layers
and support infrastructure.
Modified: trunk/libraries/gui-sniffer/commands.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/commands.dylan (original)
+++ trunk/libraries/gui-sniffer/commands.dylan Fri Feb 22 02:17:31 2008
@@ -273,8 +273,15 @@
define method do-execute-command (context :: <nnv-context>, command :: <tap-command>)
let layer = command.%layer;
- connect(new-create-raw-socket(layer), context.nnv-context);
- new-set-property-value(layer, #"administrative-state", #"up");
+ if (context.nnv-context.tapping-socket)
+ new-close-socket(context.nnv-context.tapping-socket);
+ if (context.nnv-context.tapping-socket.new-flow-node.the-output.connected-input.node = context.nnv-context)
+ disconnect(context.nnv-context.tapping-socket.new-flow-node, context.nnv-context);
+ end;
+ end;
+ let tap = new-create-socket(layer);
+ context.nnv-context.tapping-socket := tap;
+ connect(tap.new-flow-node, context.nnv-context);
end;
define command-group layer-gui
(summary: "Layer command for the GUI",
Modified: trunk/libraries/gui-sniffer/gui-sniffer.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/gui-sniffer.dylan (original)
+++ trunk/libraries/gui-sniffer/gui-sniffer.dylan Fri Feb 22 02:17:31 2008
@@ -447,6 +447,7 @@
slot listening-socket = #f;
slot first-packet-arrived :: false-or(<date>) = #f;
slot filter-history :: <list> = make(<list>);
+ slot tapping-socket = #f;
pane filter-field (frame)
make(<combo-box>,
Modified: trunk/libraries/gui-sniffer/layer-commands.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/layer-commands.dylan (original)
+++ trunk/libraries/gui-sniffer/layer-commands.dylan Fri Feb 22 02:17:31 2008
@@ -63,6 +63,11 @@
define method do-execute-command (context :: <nnv-context>, command :: <show-layer-command>)
let out = context.context-server.server-output-stream;
do(curry(print-property, out), get-properties(command.%layer));
+ format(out, "services: ");
+ do(curry(format, out, "%s "), map(layer-name, command.%layer.upper-layers));
+ format(out, "\nsources: ");
+ do(curry(format, out, "%s "), map(layer-name, command.%layer.lower-layers));
+ format(out, "\n");
end;
define class <set-l-property-command> (<basic-command>)
@@ -84,6 +89,77 @@
read-into-property(property, chop(command.%property-value));
end;
+define class <connect-command> (<basic-command>)
+ constant slot %lower :: <layer>, required-init-keyword: lower:;
+ constant slot %upper :: <layer>, required-init-keyword: upper:;
+end;
+
+define command-line connect => <connect-command>
+ (summary: "Connect lower to upper layer",
+ documentation: "Tries to plug the upper layer into the lower layer.")
+ argument lower :: <layer> = "Name of lower layer to connect.";
+ argument upper :: <layer> = "Name of upper layer to connect.";
+end;
+
+define method do-execute-command (context :: <nnv-context>, command :: <connect-command>)
+ connect-layer(command.%lower, command.%upper);
+end;
+define class <disconnect-command> (<basic-command>)
+ constant slot %lower :: <layer>, required-init-keyword: lower:;
+ constant slot %upper :: <layer>, required-init-keyword: upper:;
+end;
+
+define command-line disconnect => <disconnect-command>
+ (summary: "Disconnect lower and upper layer",
+ documentation: "Unplugs the upper layer out of the lower layer.")
+ argument lower :: <layer> = "Name of lower layer to disconnect.";
+ argument upper :: <layer> = "Name of upper layer to disconnect.";
+end;
+
+define method do-execute-command (context :: <nnv-context>, command :: <disconnect-command>)
+ disconnect-layer(command.%lower, command.%upper);
+end;
+
+define class <layer-type> (<object>)
+ constant slot ltype :: subclass(<layer>), required-init-keyword: type:;
+end;
+
+define method parse-next-argument
+ (context :: <nnv-context>, type == <layer-type>,
+ text :: <string>,
+ #key start :: <integer> = 0, end: stop = #f)
+ => (value :: <layer-type>, next-index :: <integer>)
+ block (return)
+ let (name, next-index)
+ = parse-next-word(text, start: start, end: stop);
+ if (find-layer-type(name))
+ values(make(<layer-type>, type: find-layer-type(name)),
+ next-index)
+ else
+ parse-error("Missing argument.")
+ end
+ exception (e :: <condition>)
+ parse-error("Layer-type not found")
+ end;
+end;
+
+define class <create-command> (<basic-command>)
+ constant slot %layer-type :: <layer-type>, required-init-keyword: layer-type:;
+ constant slot %layer-name :: <string>, required-init-keyword: layer-name:;
+end;
+
+define command-line create => <create-command>
+ (summary: "Creates a new layer",
+ documentation: "Instantiates a new layer of given type.")
+ argument layer-type :: <layer-type> = "Type of layer to create.";
+ argument layer-name :: <string> = "Name of layer to create.";
+end;
+
+define method do-execute-command (context :: <nnv-context>, command :: <create-command>)
+ let layer = make(command.%layer-type.ltype, name: as(<symbol>, chop(command.%layer-name)));
+ let out = context.context-server.server-output-stream;
+ format(out, "Layer %s of type %s created\n", layer.layer-name, layer.default-name);
+end;
define command-group layer
(summary: "Layer commands",
documentation: "The set of commands for managing the layers.")
@@ -91,5 +167,8 @@
command show-layers;
command show-layer;
command !set;
+ command connect;
+ command disconnect;
+ command create;
end command-group;
Modified: trunk/libraries/gui-sniffer/library.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/library.dylan (original)
+++ trunk/libraries/gui-sniffer/library.dylan Fri Feb 22 02:17:31 2008
@@ -21,4 +21,5 @@
use layer;
use timer;
use pcap-live-interface;
+ use bridge-group;
end library gui-sniffer;
Modified: trunk/libraries/gui-sniffer/module.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/module.dylan (original)
+++ trunk/libraries/gui-sniffer/module.dylan Fri Feb 22 02:17:31 2008
@@ -81,4 +81,5 @@
use layer;
use timer;
use new-layer, prefix: "new-";
+ use socket, prefix: "new-";
end module gui-sniffer;
Modified: trunk/libraries/layer/layer.hdp
==============================================================================
--- trunk/libraries/layer/layer.hdp (original)
+++ trunk/libraries/layer/layer.hdp Fri Feb 22 02:17:31 2008
@@ -2,6 +2,7 @@
Files: library
module
new-layer
+ socket
layer
tcp
udp
Modified: trunk/libraries/layer/library.dylan
==============================================================================
--- trunk/libraries/layer/library.dylan (original)
+++ trunk/libraries/layer/library.dylan Fri Feb 22 02:17:31 2008
@@ -21,4 +21,5 @@
// Add any more module exports here.
export layer;
export new-layer;
+ export socket;
end library layer;
Modified: trunk/libraries/layer/module.dylan
==============================================================================
--- trunk/libraries/layer/module.dylan (original)
+++ trunk/libraries/layer/module.dylan Fri Feb 22 02:17:31 2008
@@ -73,12 +73,20 @@
use common-dylan;
use format;
- export <layer>, layer-name, initialize-layer,
- <event>, <event-source>,
+ export <layer>, layer-name, default-name,
+ lower-layers, upper-layers,
+ initialize-layer,
+ connect-layer, disconnect-layer,
+ register-lower-layer, register-upper-layer,
+ deregister-lower-layer, deregister-upper-layer,
+ check-lower-layer?, check-upper-layer?;
+
+
+ export <event>, <event-source>,
event-notify, register-event, deregister-event,
register-property-changed-event, deregister-property-changed-event;
- export find-layer, find-all-layers,
+ export find-layer, find-layer-type, find-all-layers,
print-layer, print-config;
export create-raw-socket,
@@ -102,3 +110,18 @@
\add-properties-to-table,
\layer-getter-and-setter-definer;
end;
+
+define module socket
+ use common-dylan;
+ use format;
+ use network-flow;
+ use flow;
+ use new-layer;
+
+ export <socket>, <flow-node-socket>,
+ create-socket, flow-node, socket-owner,
+ check-socket-arguments?;
+
+ export send, close-socket;
+end;
+
Modified: trunk/libraries/layer/new-layer.dylan
==============================================================================
--- trunk/libraries/layer/new-layer.dylan (original)
+++ trunk/libraries/layer/new-layer.dylan Fri Feb 22 02:17:31 2008
@@ -1,11 +1,75 @@
module: new-layer
define open abstract class <layer> (<object>)
- slot layer-name :: <symbol>;
+ slot layer-name :: <symbol>, init-keyword: name:;
slot properties :: <table> = make(<table>);
constant each-subclass slot default-name :: <symbol>;
+ slot upper-layers :: <sequence> = #();
+ slot lower-layers :: <sequence> = #();
end;
+define open generic register-lower-layer (upper :: <layer>, lower :: <layer>);
+define open generic register-upper-layer (lower :: <layer>, upper :: <layer>);
+
+define method register-lower-layer (upper :: <layer>, lower :: <layer>)
+end;
+
+define method register-upper-layer (lower :: <layer>, upper :: <layer>);
+end;
+
+define open generic deregister-lower-layer (upper :: <layer>, lower :: <layer>);
+define open generic deregister-upper-layer (lower :: <layer>, upper :: <layer>);
+
+define method deregister-lower-layer (upper :: <layer>, lower :: <layer>)
+end;
+
+define method deregister-upper-layer (lower :: <layer>, upper :: <layer>);
+end;
+
+define open generic check-lower-layer? (upper :: <layer>, lower :: <layer>) => (allowed? :: <boolean>);
+define open generic check-upper-layer? (lower :: <layer>, upper :: <layer>) => (allowed? :: <boolean>);
+
+define method check-lower-layer? (upper :: <layer>, lower :: <layer>) => (allowed? :: <boolean>)
+ #f
+end;
+
+define method check-upper-layer? (lower :: <layer>, upper :: <layer>) => (allowed? :: <boolean>);
+ #f
+end;
+
+define function connect-layer (lower :: <layer>, upper :: <layer>) => ();
+ if (member?(upper, lower.upper-layers)
+ | member?(lower, upper.lower-layers))
+ error("Layer connection already established!")
+ end;
+ unless (check-upper-layer?(lower, upper))
+ error("Lower layer refused new upper")
+ end;
+ unless (check-lower-layer?(upper, lower))
+ error("Upper layer refused new lower")
+ end;
+
+ register-upper-layer(lower, upper);
+ block ()
+ register-lower-layer(upper, lower);
+ lower.upper-layers := add(lower.upper-layers, upper);
+ upper.lower-layers := add(upper.lower-layers, lower);
+ exception (e :: <error>)
+ deregister-upper-layer(lower, upper);
+ signal(e);
+ end;
+end;
+
+define function disconnect-layer (lower :: <layer>, upper :: <layer>) => ();
+ unless (member?(upper, lower.upper-layers)
+ & member?(lower, upper.lower-layers))
+ error("Layers not connected")
+ end;
+ deregister-upper-layer(lower, upper);
+ deregister-lower-layer(upper, lower);
+ lower.upper-layers := remove(lower.upper-layers, upper);
+ upper.lower-layers := remove(upper.lower-layers, lower);
+end;
define constant <socket> = <object>;
@@ -13,6 +77,7 @@
define constant $layer-registry = make(<table>);
+define constant $layer-type-registry = make(<table>);
define constant $layer-startups :: <stretchy-vector> = make(<stretchy-vector>);
define function register-startup-function (function :: <function>) => ()
@@ -22,7 +87,14 @@
define function start-layer () => ()
do(method(x) x() end, $layer-startups);
end;
-
+
+define function find-layer-type (name :: type-union(<symbol>, <string>))
+ => (layer :: false-or(subclass(<layer>)))
+ if (instance?(name, <string>))
+ name := as(<symbol>, name);
+ end;
+ element($layer-type-registry, name, default: #f);
+end;
define function find-layer (name :: type-union(<symbol>, <string>)) => (layer :: false-or(<layer>))
if (instance?(name, <string>))
name := as(<symbol>, name);
@@ -51,6 +123,9 @@
end;
end;
end;
+ for (upper in layer.upper-layers)
+ format(stream, " service %s\n", upper.layer-name);
+ end;
format(stream, "}\n\n");
end;
@@ -135,6 +210,8 @@
{ layer-getter-and-setter-definer("<" ## ?name ## "-layer>"; ?properties);
layer-class-definer(?attr; ?name (?superclass); ?properties);
+ $layer-type-registry[?#"name"] := "<" ## ?name ## "-layer>";
+
define variable "$" ## ?name ## "-instance-count" :: <integer> = 0;
define method make (class == "<" ## ?name ## "-layer>",
#next next-method, #rest rest, #key name, #all-keys)
@@ -163,10 +240,12 @@
define inline function init-properties (layer :: <layer>, args :: <collection>)
for (i from 0 below args.size by 2)
- if (get-property(layer, args[i]))
- let prop = get-property(layer, args[i]);
- prop.property-default-value := args[i + 1];
- prop.%property-value := args[i + 1];
+ unless (args[i] == #"name")
+ if (get-property(layer, args[i]))
+ let prop = get-property(layer, args[i]);
+ prop.property-default-value := args[i + 1];
+ prop.%property-value := args[i + 1];
+ end;
end;
end;
end;
@@ -213,7 +292,7 @@
end;
define inline function print-property (stream :: <stream>, prop :: <property>) => ()
- format(stream, "%s %=\n", prop.property-name, prop.property-value);
+ format(stream, "%s: %=\n", prop.property-name, prop.property-value);
end;
define inline function get-properties
(object :: <layer>) => (res :: <collection>)
Added: trunk/libraries/layer/socket.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/layer/socket.dylan Fri Feb 22 02:17:31 2008
@@ -0,0 +1,26 @@
+module: socket
+
+define open abstract class <socket> (<object>)
+ constant slot socket-owner, required-init-keyword: owner:;
+end;
+
+define open generic check-socket-arguments? (layer :: <layer>, #key, #all-keys)
+ => (valid-socket-arguments? :: <boolean>);
+
+define method check-socket-arguments? (layer :: <layer>, #rest rest, #key, #all-keys)
+ => (valid-socket-arguments? :: <boolean>);
+ #f;
+end;
+define open generic create-socket (layer :: <layer>, #key, #all-keys) => (socket :: <socket>);
+
+define open generic send (socket :: <socket>, data);
+define open generic close-socket (socket :: <socket>);
+define method close-socket (socket :: <socket>) end;
+
+define class <flow-node-socket> (<socket>)
+ constant slot flow-node /* :: <node> */, required-init-keyword: flow-node:;
+end;
+
+define method send (node :: <flow-node-socket>, data)
+ push-data(node.flow-node.the-output, data)
+end;
Added: trunk/libraries/network/ip-stack/layers/media-access/bridge-group/bridge-group.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/network/ip-stack/layers/media-access/bridge-group/bridge-group.dylan Fri Feb 22 02:17:31 2008
@@ -0,0 +1,56 @@
+module: bridge-group
+
+define layer repeater-group (<layer>)
+ property administrative-state :: <symbol> = #"down";
+ slot sockets :: <stretchy-vector> = make(<stretchy-vector>);
+end;
+
+define class <output-node> (<single-push-output-node>)
+end;
+define method create-socket (repeater :: <repeater-group-layer>, #rest rest, #key, #all-keys)
+ => (res :: <socket>)
+ let socket = make(<flow-node-socket>,
+ owner: repeater,
+ flow-node: make(<output-node>));
+ add!(repeater.sockets, socket);
+ socket;
+end;
+
+define method check-upper-layer? (lower :: <repeater-group-layer>, upper :: <layer>) => (allowed? :: <boolean>);
+ #f;
+end;
+
+define method check-lower-layer? (upper :: <repeater-group-layer>, lower :: <layer>) => (allowed? :: <boolean>);
+ check-socket-arguments?(lower, type: <ethernet-frame>);
+end;
+
+define method register-upper-layer (lower :: <repeater-group-layer>, upper :: <layer>)
+
+end;
+
+define method register-lower-layer (upper :: <repeater-group-layer>, lower :: <layer>)
+ let ethernet-socket = create-socket(lower, type: <ethernet-frame>);
+ let node = make(<closure-node>,
+ closure: method (x :: <ethernet-frame>)
+ if (upper. at administrative-state == #"up")
+ for (socket in upper.sockets)
+ unless (socket == ethernet-socket)
+ send(socket, x)
+ end
+ end
+ end
+ end);
+ connect(ethernet-socket.flow-node, node);
+ add!(upper.sockets, ethernet-socket);
+end;
+
+define method deregister-lower-layer (upper :: <repeater-group-layer>, lower :: <layer>)
+ let layer-sockets = choose-by(curry(\=, lower),
+ map(socket-owner, upper.sockets),
+ upper.sockets);
+ for (s in layer-sockets)
+ disconnect(s.flow-node, s.flow-node.the-output.connected-input);
+ remove!(upper.sockets, s);
+ end;
+end;
+
Added: trunk/libraries/network/ip-stack/layers/media-access/bridge-group/bridge-group.lid
==============================================================================
--- (empty file)
+++ trunk/libraries/network/ip-stack/layers/media-access/bridge-group/bridge-group.lid Fri Feb 22 02:17:31 2008
@@ -0,0 +1,3 @@
+library: bridge-group
+files: library
+ bridge-group
Added: trunk/libraries/network/ip-stack/layers/media-access/bridge-group/library.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/network/ip-stack/layers/media-access/bridge-group/library.dylan Fri Feb 22 02:17:31 2008
@@ -0,0 +1,20 @@
+module: dylan-user
+
+define library bridge-group
+ use common-dylan;
+ use layer;
+ use packetizer;
+ use protocols;
+ use flow;
+ use network-flow;
+end;
+
+define module bridge-group
+ use common-dylan;
+ use new-layer;
+ use ethernet;
+ use packetizer;
+ use flow;
+ use network-flow;
+ use socket;
+end;
Modified: trunk/libraries/network/ip-stack/layers/physical/pcap-live-interface/library.dylan
==============================================================================
--- trunk/libraries/network/ip-stack/layers/physical/pcap-live-interface/library.dylan (original)
+++ trunk/libraries/network/ip-stack/layers/physical/pcap-live-interface/library.dylan Fri Feb 22 02:17:31 2008
@@ -18,8 +18,9 @@
define module pcap-live-interface
use common-dylan;
use new-layer;
+ use socket;
use c-ffi;
- use winsock2;
+ use winsock2, import: { <timeval>, <lpsockaddr>, <C-buffer-offset> };
use physical-layer;
//use format-out;
use standard-io;
Modified: trunk/libraries/network/ip-stack/layers/physical/pcap-live-interface/pcap-live-interface.dylan
==============================================================================
--- trunk/libraries/network/ip-stack/layers/physical/pcap-live-interface/pcap-live-interface.dylan (original)
+++ trunk/libraries/network/ip-stack/layers/physical/pcap-live-interface/pcap-live-interface.dylan Fri Feb 22 02:17:31 2008
@@ -16,9 +16,6 @@
slot pcap-flow-node :: <pcap-flow-node>;
end;
-define method create-raw-socket (pcap :: <pcap-layer>) => (res :: <node>)
- pcap.pcap-flow-node;
-end;
define method initialize-layer
(layer :: <pcap-layer>, #key, #all-keys)
=> ()
@@ -27,6 +24,22 @@
register-property-changed-event(layer, #"administrative-state", toggle-administrative-state);
end;
+define method check-upper-layer? (lower :: <pcap-layer>, upper :: <layer>)
+ => (allowed? :: <boolean>);
+ lower.upper-layers.size == 0;
+end;
+
+define method check-socket-arguments? (lower :: <pcap-layer>, #rest rest, #key type, #all-keys)
+ => (valid-arguments? :: <boolean>)
+ //XXX: if (valid-type?)
+ type == <ethernet-frame>
+end;
+
+define method create-socket (lower :: <pcap-layer>, #rest rest, #key, #all-keys)
+ => (socket :: <socket>)
+ make(<flow-node-socket>, owner: lower, flow-node: lower.pcap-flow-node);
+end;
+
define function toggle-administrative-state (event :: <property-changed-event>) => ();
let property = event.property-changed-event-property;
let layer = property.property-owner;
Added: trunk/libraries/registry/generic/bridge-group
==============================================================================
--- (empty file)
+++ trunk/libraries/registry/generic/bridge-group Fri Feb 22 02:17:31 2008
@@ -0,0 +1 @@
+abstract://dylan/network/ip-stack/layers/media-access/bridge-group/bridge-group.lid
\ No newline at end of file
More information about the chatter
mailing list