[chatter] r11811 - in trunk/libraries: flow flow-printer graphviz-renderer gui-sniffer layer network-flow network/ip-stack/layers/media-access/ethernet network/ip-stack/layers/network/arp network/ip-stack/layers/physical/linux-live-interface packetizer registry/generic
hannes at mccarthy.opendylan.org
hannes at mccarthy.opendylan.org
Tue May 13 23:54:12 CEST 2008
Author: hannes
Date: Tue May 13 23:54:10 2008
New Revision: 11811
Added:
trunk/libraries/flow-printer/
trunk/libraries/flow-printer/flow-printer-exports.dylan (contents, props changed)
trunk/libraries/flow-printer/flow-printer.dylan (contents, props changed)
trunk/libraries/flow-printer/flow-printer.lid (contents, props changed)
trunk/libraries/registry/generic/flow-printer (contents, props changed)
Modified:
trunk/libraries/flow/flow.dylan
trunk/libraries/flow/module.dylan
trunk/libraries/graphviz-renderer/dot-generator.dylan
trunk/libraries/graphviz-renderer/graph-classes.dylan
trunk/libraries/graphviz-renderer/library.dylan
trunk/libraries/gui-sniffer/commands.dylan
trunk/libraries/gui-sniffer/library.dylan
trunk/libraries/gui-sniffer/module.dylan
trunk/libraries/layer/module.dylan
trunk/libraries/layer/socket.dylan
trunk/libraries/network-flow/network-flow.dylan
trunk/libraries/network/ip-stack/layers/media-access/ethernet/ethernet.dylan
trunk/libraries/network/ip-stack/layers/network/arp/arp.dylan
trunk/libraries/network/ip-stack/layers/physical/linux-live-interface/linux-live-interface.dylan
trunk/libraries/packetizer/filter-parser.dylan
Log:
Bug: 7299
Implement flow-printer library which prints network flows using graphviz
added command to gui-sniffer
move <tapping-socket> up to sockets module of new-layer library
fix ARP layer
Added: trunk/libraries/flow-printer/flow-printer-exports.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/flow-printer/flow-printer-exports.dylan Tue May 13 23:54:10 2008
@@ -0,0 +1,21 @@
+module: dylan-user
+
+define library flow-printer
+ use common-dylan;
+ use io;
+ use flow;
+ use graphviz-renderer;
+
+ export flow-printer;
+end library;
+
+define module flow-printer
+ use common-dylan;
+ use format-out;
+ use format;
+ use streams;
+ use flow;
+ use graphviz-renderer, prefix: "graphviz-";
+
+ export print-flow;
+end module;
Added: trunk/libraries/flow-printer/flow-printer.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/flow-printer/flow-printer.dylan Tue May 13 23:54:10 2008
@@ -0,0 +1,26 @@
+module: flow-printer
+synopsis:
+author:
+copyright:
+
+define function print-flow (stream :: <stream>, graph :: <graph>) => ()
+ let graphviz = make(graphviz-<graph>);
+ for (n in graph.nodes)
+ let nod = graphviz-find-node!(graphviz, format-to-string("%=", n));
+
+ //format(stream, "processing %=\n", n);
+ for (out in n.get-outputs)
+ //format(stream, " looking at output %=\n", out);
+ if (out.connected-input)
+ let targ = format-to-string("%=", out.connected-input.node);
+ //format(stream, " adding output %s\n", targ);
+ graphviz-create-edge(graphviz, nod,
+ graphviz-find-node!(graphviz, targ),
+ label: output-label(out));
+ end;
+ end;
+ end;
+ let graph-file = graphviz-generate-graph(graphviz,
+ graphviz.graphviz-nodes.first);
+ format(stream, "%s\n", graph-file);
+end;
\ No newline at end of file
Added: trunk/libraries/flow-printer/flow-printer.lid
==============================================================================
--- (empty file)
+++ trunk/libraries/flow-printer/flow-printer.lid Tue May 13 23:54:10 2008
@@ -0,0 +1,4 @@
+library: flow-printer
+executable: flow-printer
+files: flow-printer-exports
+ flow-printer
Modified: trunk/libraries/flow/flow.dylan
==============================================================================
--- trunk/libraries/flow/flow.dylan (original)
+++ trunk/libraries/flow/flow.dylan Tue May 13 23:54:10 2008
@@ -43,9 +43,15 @@
define generic process (node :: <node>) => ();
-define generic get-inputs (node :: <node>) => (inputs);
+define open generic get-inputs (node :: <node>) => (inputs);
-define generic get-outputs (node :: <node>) => (outputs);
+define open generic get-outputs (node :: <node>) => (outputs);
+
+define open generic output-label (output :: <output>) => (res);
+
+define method output-label (output :: <output>) => (res);
+ ""
+end;
define open generic connect (output, input);
Modified: trunk/libraries/flow/module.dylan
==============================================================================
--- trunk/libraries/flow/module.dylan (original)
+++ trunk/libraries/flow/module.dylan Tue May 13 23:54:10 2008
@@ -18,7 +18,9 @@
push-data-aux, pull-data-aux,
connect, disconnect, toplevel;
- export
+ export get-inputs, get-outputs, output-label;
+
+ export
<single-push-input-node>, <single-pull-input-node>,
<single-push-output-node>, <single-pull-output-node>,
<filter>, <closure-node>;
Modified: trunk/libraries/graphviz-renderer/dot-generator.dylan
==============================================================================
--- trunk/libraries/graphviz-renderer/dot-generator.dylan (original)
+++ trunk/libraries/graphviz-renderer/dot-generator.dylan Tue May 13 23:54:10 2008
@@ -4,14 +4,15 @@
define function generate-dot
(graph :: <graph>, output :: <stream>, #key top-node) => ()
- let top-node = top-node | graph.nodes[0];
write(output, "digraph G {\n");
if (graph.attributes.size > 0)
for (value keyed-by name in graph.attributes)
write(output, concatenate(" ", name, " = \"", value ,"\";\n"));
end for;
end if;
- process-nodes(top-node, output);
+ for (node in graph.nodes)
+ process-node(node, output);
+ end;
write(output, "}\n");
end;
@@ -32,18 +33,25 @@
end;
define function process-node (node :: <node>, output :: <stream>) => ()
- local method print-edge (target :: <node>)
+ local method print-edge (edge :: <edge>)
write(output, concatenate(" \"", node.label, "\" -> \"",
- target.label, "\";\n"));
+ edge.target.label, "\""));
+ print-attributes(output, edge.attributes);
+ write(output, ";\n");
end;
- if (node.attributes.size > 0)
+ write(output, concatenate(" \"", node.label, "\""));
+ print-attributes(output, node.attributes);
+ write(output, ";\n");
+ do(print-edge, node.outgoing-edges);
+end;
+
+define function print-attributes (stream :: <stream>, attributes :: <string-table>)
+ if (attributes.size > 0)
let attrs = make(<stretchy-vector>);
- for (ele in key-sequence(node.attributes))
- add!(attrs, concatenate(ele, " = \"", node.attributes[ele], "\""));
+ for (ele in key-sequence(attributes))
+ add!(attrs, concatenate(ele, " = \"", attributes[ele], "\""));
end;
attrs := reduce1(method(x, y) concatenate(x, ",", y) end, attrs);
- write(output, concatenate(" \"", node.label, "\" [", attrs, "];\n"))
+ write(stream, concatenate(" [", attrs, "]"))
end;
- do(print-edge, node.successors);
end;
-
Modified: trunk/libraries/graphviz-renderer/graph-classes.dylan
==============================================================================
--- trunk/libraries/graphviz-renderer/graph-classes.dylan (original)
+++ trunk/libraries/graphviz-renderer/graph-classes.dylan Tue May 13 23:54:10 2008
@@ -22,6 +22,7 @@
constant slot label :: <string> = "", init-keyword: label:;
constant slot source :: <node>, required-init-keyword: source:;
constant slot target :: <node>, required-init-keyword: target:;
+ constant slot attributes :: <string-table> = make(<string-table>);
end;
define function create-node (graph :: <graph>, #key label)
@@ -41,6 +42,7 @@
source: source,
target: target,
label: label | integer-to-string(graph.edges.size));
+ edge.attributes["label"] := label;
add!(graph.edges, edge);
add!(source.outgoing-edges, edge);
add!(target.incoming-edges, edge);
@@ -66,6 +68,10 @@
end;
end;
+define function find-node! (graph :: <graph>, name :: <string>) => (res :: <node>)
+ find-node(graph, name) | create-node(graph, label: name)
+end;
+
define function add-successors (node :: <node>, pres :: <collection>) => ()
let nodes-to-connect = maybe-create-nodes(node.graph, pres);
map(curry(create-edge, node.graph, node), nodes-to-connect);
Modified: trunk/libraries/graphviz-renderer/library.dylan
==============================================================================
--- trunk/libraries/graphviz-renderer/library.dylan (original)
+++ trunk/libraries/graphviz-renderer/library.dylan Tue May 13 23:54:10 2008
@@ -23,7 +23,8 @@
export <graph>, <node>, <edge>,
create-node, create-edge,
generate-dot, generate-graph,
- find-node, add-successors,
+ find-node, find-node!,
+ add-successors,
add-predecessors, attributes,
nodes, edges, neighbours,
label;
Modified: trunk/libraries/gui-sniffer/commands.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/commands.dylan (original)
+++ trunk/libraries/gui-sniffer/commands.dylan Tue May 13 23:54:10 2008
@@ -280,10 +280,24 @@
context.nnv-context.tapping-socket := tap;
connect(tap.new-socket-output, context.nnv-context);
end;
+
+define class <flow-printer-command> (<basic-command>)
+end;
+
+define command-line flow-printer => <flow-printer-command>
+ (summary: "Prints flow",
+ documentation: "Prints the complete network flow")
+end;
+
+define method do-execute-command (context :: <nnv-context>, command :: <flow-printer-command>)
+ print-flow(context.context-server.server-output-stream, *global-flow*);
+end;
+
define command-group layer-gui
(summary: "Layer command for the GUI",
documentation: "The set of commands which connect the layer to the GUI")
command tap;
+ command flow-printer;
end;
define command-group nnv
Modified: trunk/libraries/gui-sniffer/library.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/library.dylan (original)
+++ trunk/libraries/gui-sniffer/library.dylan Tue May 13 23:54:10 2008
@@ -28,4 +28,5 @@
use arp;
use ip;
use ip-over-ethernet;
+ use flow-printer;
end library gui-sniffer;
Modified: trunk/libraries/gui-sniffer/module.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/module.dylan (original)
+++ trunk/libraries/gui-sniffer/module.dylan Tue May 13 23:54:10 2008
@@ -84,4 +84,5 @@
use timer;
use new-layer, prefix: "new-";
use socket, prefix: "new-";
+ use flow-printer;
end module gui-sniffer;
Modified: trunk/libraries/layer/module.dylan
==============================================================================
--- trunk/libraries/layer/module.dylan (original)
+++ trunk/libraries/layer/module.dylan Tue May 13 23:54:10 2008
@@ -126,5 +126,7 @@
export <input-output-socket>, socket-input, socket-output;
export send, close-socket, sendto;
+
+ export <tapping-socket>, create-tapping-socket;
end;
Modified: trunk/libraries/layer/socket.dylan
==============================================================================
--- trunk/libraries/layer/socket.dylan (original)
+++ trunk/libraries/layer/socket.dylan Tue May 13 23:54:10 2008
@@ -53,5 +53,42 @@
constant slot socket-output /* :: <output> */, required-init-keyword: output:;
end;
+define class <tapping-socket> (<socket>)
+ slot fan-in = make(<fan-in>);
+ slot socket-fan-out;
+ slot frame-filter :: <frame-filter>;
+ slot demux-output :: <output>;
+end;
+
+define method close-socket (socket :: <tapping-socket>)
+ socket.socket-owner.sockets := remove!(socket.socket-owner.sockets, socket);
+ disconnect(socket.socket-output, socket.socket-output.connected-input);
+ disconnect(socket.socket-fan-out, socket.frame-filter.the-input);
+ disconnect(socket.demux-output, socket.fan-in);
+end;
+
+define method socket-input (socket :: <tapping-socket>) => (res /* :: <input> */);
+ error("Tapping sockets are read-only");
+end;
+
+define method socket-output (socket :: <tapping-socket>) => (res /* :: <output> */);
+ socket.fan-in.the-output;
+end;
+define function create-tapping-socket
+ (layer :: <layer>,
+ fan-out :: <fan-out>,
+ demultiplexer :: <demultiplexer>,
+ #key filter-string)
+ => (res :: <tapping-socket>)
+ let socket = make(<tapping-socket>, owner: layer);
+ //XXX: frame-filter should be the frame-type we are interested in
+ socket.frame-filter := make(<frame-filter>, frame-filter: "");
+ socket.socket-fan-out := fan-out;
+ connect(fan-out, socket.frame-filter);
+ connect(socket.frame-filter, socket.fan-in);
+ socket.demux-output := create-output-for-filter(demultiplexer, filter-string);
+ connect(socket.demux-output, socket.fan-in);
+ socket;
+end;
Modified: trunk/libraries/network-flow/network-flow.dylan
==============================================================================
--- trunk/libraries/network-flow/network-flow.dylan (original)
+++ trunk/libraries/network-flow/network-flow.dylan Tue May 13 23:54:10 2008
@@ -94,6 +94,10 @@
constant slot %lock :: <lock> = make(<lock>);
end;
+define method get-outputs (fan-out :: <fan-out>) => (outputs)
+ fan-out.outputs;
+end;
+
define method create-output
(fan-out :: <fan-out>)
let res = make(<push-output>, node: fan-out);
@@ -131,6 +135,10 @@
required-init-keyword: frame-filter:;
end;
+define method output-label (output :: <filtered-push-output>) => (res)
+ format-to-string("%=", output.frame-filter);
+end;
+
define class <demultiplexer> (<single-push-input-node>)
slot outputs :: <stretchy-vector> = make(<stretchy-vector>);
constant slot %lock :: <lock> = make(<lock>);
@@ -182,6 +190,10 @@
end
end;
+define method get-outputs (node :: <demultiplexer>) => (outputs)
+ node.outputs;
+end;
+
define class <frame-filter> (<filter>)
slot frame-filter :: <filter-expression>,
required-init-keyword: frame-filter:;
Modified: trunk/libraries/network/ip-stack/layers/media-access/ethernet/ethernet.dylan
==============================================================================
--- trunk/libraries/network/ip-stack/layers/media-access/ethernet/ethernet.dylan (original)
+++ trunk/libraries/network/ip-stack/layers/media-access/ethernet/ethernet.dylan Tue May 13 23:54:10 2008
@@ -16,24 +16,28 @@
constant slot completer :: <completer>, required-init-keyword: completer:;
end;
-define method create-socket (layer :: <ethernet-layer>, #rest rest, #key filter-string, #all-keys)
+define method create-socket (layer :: <ethernet-layer>, #rest rest, #key filter-string, tap?, #all-keys)
=> (res :: <socket>)
unless(layer. at running-state == #"up")
error("Layer down");
end;
- let filter = format-to-string("ethernet.destination-address = %s", as(<string>, layer. at mac-address));
+ let filter = format-to-string("(ethernet.destination-address = %s) | (ethernet.destination-address = ff:ff:ff:ff:ff:ff)", as(<string>, layer. at mac-address));
if (filter-string)
filter := format-to-string("(%s) & (%s)", filter, filter-string);
end;
- let socket = create-socket(layer.lower-layers[0], filter-string: filter);
- let completer = make(<completer>, template-frame: ethernet-frame(source-address: layer. at mac-address));
- let res = make(<ethernet-socket>,
- owner: layer,
- lower-socket: socket,
- completer: completer);
- connect(socket.socket-output, res.decapsulator);
- connect(completer, socket.socket-input);
- res
+ if (tap?)
+ create-socket(layer.lower-layers[0], tap?: #t, filter-string: filter);
+ else
+ let socket = create-socket(layer.lower-layers[0], filter-string: filter);
+ let completer = make(<completer>, template-frame: ethernet-frame(source-address: layer. at mac-address));
+ let res = make(<ethernet-socket>,
+ owner: layer,
+ lower-socket: socket,
+ completer: completer);
+ connect(socket.socket-output, res.decapsulator);
+ connect(completer, socket.socket-input);
+ res
+ end;
end;
define method socket-input (socket :: <ethernet-socket>) => (res :: <input>)
Modified: trunk/libraries/network/ip-stack/layers/network/arp/arp.dylan
==============================================================================
--- trunk/libraries/network/ip-stack/layers/network/arp/arp.dylan (original)
+++ trunk/libraries/network/ip-stack/layers/network/arp/arp.dylan Tue May 13 23:54:10 2008
@@ -27,10 +27,10 @@
let socket = create-socket(lower, filter-string: "arp");
upper.arp-flow-node.send-socket := socket;
connect(socket.socket-output, upper.arp-flow-node.the-input);
- upper.arp-flow-node.arp-table[ipv4-address("23.23.23.23")]
+ upper.arp-flow-node.arp-table[ipv4-address("192.168.2.23")]
:= make(<advertised-arp-entry>,
mac-address: lower. at mac-address,
- ip-address: ipv4-address("23.23.23.23"));
+ ip-address: ipv4-address("192.168.2.23"));
upper. at running-state := #"up";
end;
@@ -71,7 +71,6 @@
source-ip-address: from-ip,
target-ip-address: destination,
target-mac-address: mac-address("00:00:00:00:00:00"));
- format-out
sendto(arp-handler.send-socket, $broadcast-ethernet-address, arp-request);
let outstanding-request = make(<outstanding-arp-request>,
handler: arp-handler,
@@ -168,7 +167,9 @@
let old-entry = element(node.arp-table, frame.source-ip-address, default: #f);
if (instance?(old-entry, <outstanding-arp-request>))
cancel(old-entry.timer);
- do(rcurry(apply, frame.source-mac-address), old-entry.outstanding-closures);
+ for (out in old-entry.outstanding-closures)
+ out(frame.source-mac-address);
+ end;
end;
maybe-add-response-to-table(old-entry, node, frame);
end
Modified: trunk/libraries/network/ip-stack/layers/physical/linux-live-interface/linux-live-interface.dylan
==============================================================================
--- trunk/libraries/network/ip-stack/layers/physical/linux-live-interface/linux-live-interface.dylan (original)
+++ trunk/libraries/network/ip-stack/layers/physical/linux-live-interface/linux-live-interface.dylan Tue May 13 23:54:10 2008
@@ -53,38 +53,12 @@
type == <ethernet-frame>
end;
-define class <tapping-socket> (<socket>)
- slot fan-in = make(<fan-in>);
- slot frame-filter :: <frame-filter>;
- slot demux-output :: <output>;
-end;
-
-define method close-socket (socket :: <tapping-socket>)
- socket.socket-owner.sockets := remove!(socket.socket-owner.sockets, socket);
- disconnect(socket.socket-output, socket.socket-output.connected-input);
- disconnect(socket.socket-owner.fan-out, socket.frame-filter);
- disconnect(socket.demux-output, socket.fan-in);
-end;
-
-define method socket-input (socket :: <tapping-socket>) => (res /* :: <input> */);
- error("Tapping sockets are read-only");
-end;
-
-define method socket-output (socket :: <tapping-socket>) => (res /* :: <output> */);
- socket.fan-in.the-output;
-end;
define method create-socket (lower :: <phy-layer>, #rest rest, #key type, filter-string, tap?, #all-keys)
=> (socket :: <socket>)
let filter-string = filter-string | "ethernet";
if (tap?)
- let socket = make(<tapping-socket>, owner: lower);
- socket.frame-filter := make(<frame-filter>, frame-filter: filter-string);
- connect(lower.fan-out, socket.frame-filter);
- connect(socket.frame-filter, socket.fan-in);
- socket.demux-output := create-output-for-filter(lower.demultiplexer, filter-string);
- connect(socket.demux-output, socket.fan-in);
- socket;
+ create-tapping-socket(lower, lower.fan-out, lower.demultiplexer, filter-string: filter-string);
else
let input = create-input(lower.fan-in);
let output = create-output-for-filter(lower.demultiplexer, filter-string);
Modified: trunk/libraries/packetizer/filter-parser.dylan
==============================================================================
--- trunk/libraries/packetizer/filter-parser.dylan (original)
+++ trunk/libraries/packetizer/filter-parser.dylan Tue May 13 23:54:10 2008
@@ -128,7 +128,7 @@
format(stream, "(%=) | (%=)", filter.left-expression, filter.right-expression);
end;
-define method print-filter (filter :: <not-expression>, stream :: <stream>) => ();
+define method print-object (filter :: <not-expression>, stream :: <stream>) => ();
format(stream, "~ (%=)", filter.expression);
end;
Added: trunk/libraries/registry/generic/flow-printer
==============================================================================
--- (empty file)
+++ trunk/libraries/registry/generic/flow-printer Tue May 13 23:54:10 2008
@@ -0,0 +1 @@
+abstract://dylan/flow-printer/flow-printer.lid
More information about the chatter
mailing list