[Gd-chatter] r11688 - in trunk/libraries: gui-sniffer layer network/ip-stack/layers network/ip-stack/layers/physical network/ip-stack/layers/physical/pcap-live-interface registry/generic
andreas at gwydiondylan.org
andreas at gwydiondylan.org
Wed Feb 20 02:13:29 CET 2008
Author: andreas
Date: Wed Feb 20 02:13:28 2008
New Revision: 11688
Added:
trunk/libraries/gui-sniffer/layer-commands.dylan (contents, props changed)
trunk/libraries/network/ip-stack/layers/
trunk/libraries/network/ip-stack/layers/physical/
trunk/libraries/network/ip-stack/layers/physical/library.dylan (contents, props changed)
trunk/libraries/network/ip-stack/layers/physical/pcap-live-interface/
trunk/libraries/network/ip-stack/layers/physical/pcap-live-interface/library.dylan (contents, props changed)
trunk/libraries/network/ip-stack/layers/physical/pcap-live-interface/pcap-live-interface.dylan (contents, props changed)
trunk/libraries/network/ip-stack/layers/physical/pcap-live-interface/pcap-live-interface.lid (contents, props changed)
trunk/libraries/network/ip-stack/layers/physical/physical.dylan (contents, props changed)
trunk/libraries/network/ip-stack/layers/physical/physical.lid (contents, props changed)
trunk/libraries/registry/generic/pcap-live-interface (contents, props changed)
trunk/libraries/registry/generic/physical-layer (contents, props changed)
Modified:
trunk/libraries/gui-sniffer/command-line.dylan
trunk/libraries/gui-sniffer/commands.dylan
trunk/libraries/gui-sniffer/gui-sniffer.hdp
trunk/libraries/gui-sniffer/library.dylan
trunk/libraries/gui-sniffer/module.dylan
trunk/libraries/layer/module.dylan
trunk/libraries/layer/new-layer.dylan
Log:
Job: 7299
* use layer definer for physical and pcap layers
* provide a command set for layers for gui-sniffer
* integrate new command "tap" using new layer API
Modified: trunk/libraries/gui-sniffer/command-line.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/command-line.dylan (original)
+++ trunk/libraries/gui-sniffer/command-line.dylan Wed Feb 20 02:13:28 2008
@@ -8,6 +8,14 @@
"NNV shell"
end method mode-name;
+define function chop (string :: <string>) => (string :: <string>)
+ if (string[string.size - 1] = '\n')
+ copy-sequence(string, end: string.size - 1)
+ else
+ string;
+ end;
+end;
+
define method shell-input-complete?
(mode :: <nnv-shell-mode>,
buffer :: <basic-shell-buffer>, section :: <basic-shell-section>)
Modified: trunk/libraries/gui-sniffer/commands.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/commands.dylan (original)
+++ trunk/libraries/gui-sniffer/commands.dylan Wed Feb 20 02:13:28 2008
@@ -246,7 +246,6 @@
do(curry(write-line, stream), docstrings);
end;
-
define command-group network
(summary: "Networking commands",
documentation: "The set of commands for managing the network.")
@@ -262,12 +261,35 @@
command filter;
end command-group;
+define class <tap-command> (<basic-command>)
+ slot %layer :: new-<layer>, required-init-keyword: layer:
+end;
+
+define command-line tap => <tap-command>
+ (summary: "Taps a layer",
+ documentation: "Tap a layer")
+ argument layer :: new-<layer> = "The layer to tap";
+end;
+
+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");
+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;
+end;
+
define command-group nnv
(summary: "Network Night Vision commands",
documentation: "The set of commands provided by Network Night Vision.")
group basic;
group property;
group network;
+ group layer;
+ group layer-gui;
property key-bindings;
end command-group;
Modified: trunk/libraries/gui-sniffer/gui-sniffer.hdp
==============================================================================
--- trunk/libraries/gui-sniffer/gui-sniffer.hdp (original)
+++ trunk/libraries/gui-sniffer/gui-sniffer.hdp Wed Feb 20 02:13:28 2008
@@ -5,6 +5,7 @@
module
hex-view
command-line
+ layer-commands
gui-sniffer
commands
main
Added: trunk/libraries/gui-sniffer/layer-commands.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/gui-sniffer/layer-commands.dylan Wed Feb 20 02:13:28 2008
@@ -0,0 +1,95 @@
+module: layer-commands
+
+begin
+ start-layer();
+end;
+
+define class <show-config-command> (<basic-command>)
+end;
+
+define command-line show-config => <show-config-command>
+ (summary: "Shows config",
+ documentation: "Shows config of all layers")
+end;
+
+define method do-execute-command (context :: <nnv-context>, command :: <show-config-command>)
+ let out = context.context-server.server-output-stream;
+ do(curry(print-config, out), find-all-layers());
+end;
+
+
+define class <show-layers-command> (<basic-command>)
+end;
+
+define command-line show-layers => <show-layers-command>
+ (summary: "Shows all layers",
+ documentation: "Shows all registered layers")
+end;
+
+define method do-execute-command (context :: <nnv-context>, command :: <show-layers-command>)
+ let out = context.context-server.server-output-stream;
+ do(curry(print-layer, out), find-all-layers());
+end;
+
+
+define method parse-next-argument
+ (context :: <nnv-context>, type == <layer>,
+ text :: <string>,
+ #key start :: <integer> = 0, end: stop = #f)
+ => (value :: <layer>, next-index :: <integer>)
+ block (return)
+ let (name, next-index)
+ = parse-next-word(text, start: start, end: stop);
+ if (find-layer(name))
+ values(find-layer(name), next-index)
+ else
+ parse-error("Missing argument.")
+ end
+ exception (e :: <condition>)
+ parse-error("Layer not found")
+ end;
+end;
+
+define class <show-layer-command> (<basic-command>)
+ constant slot %layer :: <layer>, required-init-keyword: layer:;
+end;
+
+define command-line show-layer => <show-layer-command>
+ (summary: "Show properties of a layer",
+ documentation: "Shows properties of a layer")
+ argument layer :: <layer> = "The layer which properties should be displayed"
+end;
+
+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));
+end;
+
+define class <set-l-property-command> (<basic-command>)
+ constant slot %layer :: <layer>, required-init-keyword: layer:;
+ constant slot %property-name :: <symbol>, required-init-keyword: property-name:;
+ constant slot %property-value :: <string>, required-init-keyword: property-value:;
+end;
+
+define command-line !set => <set-l-property-command>
+ (summary: "Set layer property",
+ documentation: "Sets a given property to the given value in the given layer")
+ argument layer :: <layer> = "Layer to work on";
+ argument property-name :: <symbol> = "Property name";
+ argument property-value :: <string> = "Property value";
+end;
+
+define method do-execute-command (context :: <nnv-context>, command :: <set-l-property-command>)
+ let property = get-property(command.%layer, command.%property-name);
+ read-into-property(property, chop(command.%property-value));
+end;
+
+define command-group layer
+ (summary: "Layer commands",
+ documentation: "The set of commands for managing the layers.")
+ command show-config;
+ command show-layers;
+ command show-layer;
+ command !set;
+end command-group;
+
Modified: trunk/libraries/gui-sniffer/library.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/library.dylan (original)
+++ trunk/libraries/gui-sniffer/library.dylan Wed Feb 20 02:13:28 2008
@@ -20,4 +20,5 @@
use network-interfaces;
use layer;
use timer;
+ use pcap-live-interface;
end library gui-sniffer;
Modified: trunk/libraries/gui-sniffer/module.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/module.dylan (original)
+++ trunk/libraries/gui-sniffer/module.dylan Wed Feb 20 02:13:28 2008
@@ -25,9 +25,22 @@
use commands;
use command-lines;
- export make-nnv-shell-pane, command-line-server, nnv-context, nnv-context-setter, <nnv-context>;
+ export make-nnv-shell-pane, command-line-server, nnv-context, nnv-context-setter, <nnv-context>,
+ chop;
end;
+define module layer-commands
+ use common-dylan;
+ use new-layer;
+ use command-line;
+ use commands;
+ use command-lines;
+ use format;
+
+ export $layer-command-group;
+end;
+
+
define module gui-sniffer
use common-dylan, exclude: { format-to-string };
use dylan-extensions, import: { debug-name };
@@ -48,6 +61,7 @@
use network-flow;
use flow;
use command-line;
+ use layer-commands;
use commands;
use command-lines;
use hex-view;
@@ -66,4 +80,5 @@
use network-interfaces;
use layer;
use timer;
+ use new-layer, prefix: "new-";
end module gui-sniffer;
Modified: trunk/libraries/layer/module.dylan
==============================================================================
--- trunk/libraries/layer/module.dylan (original)
+++ trunk/libraries/layer/module.dylan Wed Feb 20 02:13:28 2008
@@ -71,19 +71,28 @@
define module new-layer
use common-dylan;
+ use format;
- export <layer>, layer-name,
+ export <layer>, layer-name, initialize-layer,
<event>, <event-source>,
- event-notify, register-event, deregister-event;
+ event-notify, register-event, deregister-event,
+ register-property-changed-event, deregister-property-changed-event;
+
+ export find-layer, find-all-layers,
+ print-layer, print-config;
+
+ export create-raw-socket,
+ start-layer, register-startup-function;
export <property>, property-name,
property-type, property-default-value,
property-value, property-value-setter,
- property-owner;
+ property-owner, read-into-property,
+ read-as;
- export get-property,
+ export get-property, get-properties,
set-property-value, get-property-value,
- check-property;
+ check-property, print-property;
export <property-changed-event>,
property-changed-event-property,
Modified: trunk/libraries/layer/new-layer.dylan
==============================================================================
--- trunk/libraries/layer/new-layer.dylan (original)
+++ trunk/libraries/layer/new-layer.dylan Wed Feb 20 02:13:28 2008
@@ -2,17 +2,64 @@
define open abstract class <layer> (<object>)
slot layer-name :: <symbol>;
- each-subclass slot instance-count :: <integer> = 0;
slot properties :: <table> = make(<table>);
+ constant each-subclass slot default-name :: <symbol>;
end;
+
+define constant <socket> = <object>;
+
+define open generic create-raw-socket (layer :: <layer>) => (res :: <socket>);
+
define constant $layer-registry = make(<table>);
+define constant $layer-startups :: <stretchy-vector> = make(<stretchy-vector>);
+
+define function register-startup-function (function :: <function>) => ()
+ add!($layer-startups, function);
+end;
+
+define function start-layer () => ()
+ do(method(x) x() end, $layer-startups);
+end;
+
+define function find-layer (name :: type-union(<symbol>, <string>)) => (layer :: false-or(<layer>))
+ if (instance?(name, <string>))
+ name := as(<symbol>, name);
+ end;
+ element($layer-registry, name, default: #f);
+end;
+
+define function find-all-layers () => (layers :: <collection>)
+ $layer-registry;
+end;
+
+define function print-layer (stream :: <stream>, layer :: <layer>) => ()
+ format(stream, "%s %s\n", layer.default-name, layer.layer-name);
+end;
+
+define function print-config (stream :: <stream>, layer :: <layer>) => ()
+ format(stream, "%s %s {\n", layer.default-name, layer.layer-name);
+ for (prop in properties(layer))
+ if (instance?(prop, <user-property>))
+ if (slot-initialized?(prop, %property-value))
+ unless (slot-initialized?(prop, property-default-value)
+ & (prop.property-default-value = prop.property-value))
+ format(stream, " ");
+ print-property(stream, prop);
+ end;
+ end;
+ end;
+ end;
+ format(stream, "}\n\n");
+end;
define macro layer-getter-and-setter-definer
{ layer-getter-and-setter-definer(?:name) }
=> { }
- { layer-getter-and-setter-definer(?:name; property ?pname:name :: ?type:expression = ?default:expression; ?rest:*) }
+ { layer-getter-and-setter-definer(?:name; slot ?rest2:*; ?rest:*) }
+ => { layer-getter-and-setter-definer(?name; ?rest) }
+ { layer-getter-and-setter-definer(?:name; ?attr:* property ?pname:name :: ?type:expression ?foo:*; ?rest:*) }
=> {
define method "@" ## ?pname (lay :: ?name) => (res :: ?type)
get-property-value(lay, ?#"pname");
@@ -32,48 +79,88 @@
properties:
{ } => { }
+ { slot ?rest:*; ... } => { ... }
+ { system property ?:name :: ?type:expression; ... } =>
+ { owner.properties[?#"name"] := make(<system-property>,
+ name: ?#"name",
+ type: ?type,
+ owner: owner);
+ ... }
+ { system property ?:name :: ?type:expression = ?default:expression; ... } =>
+ { owner.properties[?#"name"] := make(<system-property>,
+ name: ?#"name",
+ type: ?type,
+ default: ?default,
+ value: ?default,
+ owner: owner);
+ ... }
+ { property ?:name :: ?type:expression; ... } =>
+ { owner.properties[?#"name"] := make(<user-property>,
+ name: ?#"name",
+ type: ?type,
+ owner: owner);
+ ... }
{ property ?:name :: ?type:expression = ?default:expression; ... } =>
- { owner.properties[?#"name"] := make(<property>,
+ { owner.properties[?#"name"] := make(<user-property>,
name: ?#"name",
type: ?type,
default: ?default,
owner: owner,
value: ?default);
- //getter: ?name,
- //setter: ?name ## "-setter");
... }
end;
+define macro layer-class-definer
+ { layer-class-definer(?attr:*; ?:name (?superclass:expression); ?properties:*) }
+ => { define ?attr class "<" ## ?name ## "-layer>" (?superclass)
+ inherited slot default-name = ?#"name";
+ ?properties
+ end }
+
+ properties:
+ { } => { }
+ { slot ?rest:*; ... } => { slot ?rest; ... }
+ { ?attr:* property ?foo:*; ... } => { ... }
+end;
+
+define open generic initialize-layer (layer :: <layer>, #key, #all-keys) => ();
+
+define method initialize-layer (layer :: <layer>, #key, #all-keys) => () end;
+
define macro layer-definer
- { define layer ?:name
+ { define ?attr:* layer ?:name (?superclass:expression)
?properties:*
end }
=>
- { layer-getter-and-setter-definer("<" ## ?name ## ">"; ?properties);
- define class "<" ## ?name ## ">" (<layer>) end;
+ { layer-getter-and-setter-definer("<" ## ?name ## "-layer>"; ?properties);
+ layer-class-definer(?attr; ?name (?superclass); ?properties);
+
+ define variable "$" ## ?name ## "-instance-count" :: <integer> = 0;
+ define method make (class == "<" ## ?name ## "-layer>",
+ #next next-method, #rest rest, #key name, #all-keys)
+ => (layer :: "<" ## ?name ## "-layer>")
+ unless(name)
+ name := as(<symbol>, format-to-string("%s%=", ?"name", "$" ## ?name ## "-instance-count"));
+ "$" ## ?name ## "-instance-count" := "$" ## ?name ## "-instance-count" + 1;
+ end;
+ if (element($layer-registry, name, default: #f))
+ error("Can't create layer: name duplication");
+ end;
+ let layer = next-method();
+ init-properties(layer, rest);
+ layer.layer-name := name;
+ $layer-registry[name] := layer;
+ apply(initialize-layer, layer, rest);
+ layer;
+ end;
- define method initialize (layer :: "<" ## ?name ## ">",
+ define method initialize (layer :: "<" ## ?name ## "-layer>",
#next next-method, #rest rest, #key name, #all-keys);
next-method();
- init-layer(layer, ?"name", name);
add-properties-to-table(layer; ?properties);
- init-properties(layer, rest);
end; }
end;
-define inline function init-layer
- (layer :: <layer>, default-name :: <string>, name)
- unless(name)
- name := as(<symbol>, format-to-string("%s%=", default-name, layer.instance-count));
- layer.instance-count := layer.instance-count + 1;
- end;
- if (element($layer-registry, name, default: #f))
- error("Can't create layer: name duplication");
- end;
- layer.layer-name := name;
- $layer-registry[name] := layer;
-end;
-
define inline function init-properties (layer :: <layer>, args :: <collection>)
for (i from 0 below args.size by 2)
if (get-property(layer, args[i]))
@@ -83,10 +170,10 @@
end;
end;
end;
-define class <event> (<object>)
+define abstract class <event> (<object>)
end;
-define class <event-source> (<object>)
+define abstract class <event-source> (<object>)
slot listeners = #();
end;
@@ -95,28 +182,29 @@
do(method (x) x(event) end, source.listeners)
end;
-define inline function register-event
+define inline function register-property-changed-event
(source :: <layer>, name :: <symbol>, callback :: <function>) => ()
let prop = get-property(source, name);
prop.listeners := add!(prop.listeners, callback);
end;
-define inline function deregister-event
+define inline function deregister-property-changed-event
(source :: <layer>, name :: <symbol>, callback :: <function>) => ()
let prop = get-property(source, name);
prop.listeners := remove!(prop.listeners, callback);
end;
-define class <property> (<event-source>)
+define abstract class <property> (<event-source>)
constant slot property-name :: <symbol>, init-keyword: name:;
constant slot property-type :: <type>, init-keyword: type:;
slot property-default-value, init-keyword: default:;
slot %property-value, init-keyword: value:;
constant slot property-owner, init-keyword: owner:;
- //constant slot property-getter, init-keyword: getter:;
- //constant slot property-setter, init-keyword: setter:;
end;
+define class <system-property> (<property>) end;
+define class <user-property> (<property>) end;
+
define open generic check-property (owner, property-name :: <symbol>, value)
=> ();
@@ -124,12 +212,45 @@
//move along
end;
+define inline function print-property (stream :: <stream>, prop :: <property>) => ()
+ format(stream, "%s %=\n", prop.property-name, prop.property-value);
+end;
+define inline function get-properties
+ (object :: <layer>) => (res :: <collection>)
+ object.properties
+end;
define inline function get-property
(object :: <layer>, property-name :: <symbol>)
=> (property :: <property>)
element(object.properties, property-name);
end;
+define method read-into-property
+ (property :: <system-property>, value :: <string>)
+ error("Unable to set system property");
+end;
+
+define method read-into-property
+ (property :: <user-property>, value :: <string>)
+ property.property-value := read-as(property.property-type, value);
+end;
+
+define open generic read-as (type, value) => (value);
+
+define method read-as (type == <symbol>, value :: <string>) => (res :: <symbol>)
+ as(<symbol>, value);
+end;
+
+define method read-as (type == <string>, value :: <string>) => (res :: <string>)
+ value;
+end;
+
+define method read-as (type == <boolean>, value :: <string>) => (res :: <boolean>)
+ if ((value = "#t") | (value = "true") | (value = "t"))
+ #t;
+ end;
+end;
+
define inline function set-property-value
(object :: <layer>, property-name :: <symbol>, new-value)
=> (value)
Added: trunk/libraries/network/ip-stack/layers/physical/library.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/network/ip-stack/layers/physical/library.dylan Wed Feb 20 02:13:28 2008
@@ -0,0 +1,14 @@
+module: dylan-user
+
+define library physical-layer
+ use common-dylan;
+ use layer;
+ export physical-layer;
+end;
+
+define module physical-layer
+ use common-dylan;
+ use new-layer;
+
+ export <physical-layer>;
+end;
Added: trunk/libraries/network/ip-stack/layers/physical/pcap-live-interface/library.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/network/ip-stack/layers/physical/pcap-live-interface/library.dylan Wed Feb 20 02:13:28 2008
@@ -0,0 +1,43 @@
+module: dylan-user
+
+define library pcap-live-interface
+ use common-dylan;
+ use layer;
+ use physical-layer;
+ use c-ffi;
+ use system;
+ use io;
+ use collection-extensions;
+ use functional-dylan;
+ use flow;
+ use network;
+ use packetizer;
+ use protocols, import: { ethernet, ipv4, cidr };
+end;
+
+define module pcap-live-interface
+ use common-dylan;
+ use new-layer;
+ use c-ffi;
+ use winsock2;
+ use physical-layer;
+ //use format-out;
+ use standard-io;
+ use subseq;
+ use dylan-direct-c-ffi;
+ use machine-words;
+ use byte-vector;
+ use flow;
+ use print;
+ use format;
+ use threads;
+ use ethernet, import: { <ethernet-frame> };
+ use ipv4, import: { <ipv4-address> };
+ use cidr, import: { <cidr>, netmask-from-byte-vector };
+ use packetizer,
+ import: { parse-frame,
+ <frame>,
+ assemble-frame,
+ packet,
+ <stretchy-vector-subsequence> };
+end;
Added: trunk/libraries/network/ip-stack/layers/physical/pcap-live-interface/pcap-live-interface.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/network/ip-stack/layers/physical/pcap-live-interface/pcap-live-interface.dylan Wed Feb 20 02:13:28 2008
@@ -0,0 +1,190 @@
+module: pcap-live-interface
+
+define class <pcap-flow-node> (<filter>)
+ slot pcap-t :: <C-void*>;
+end;
+
+define constant $ethernet-buffer-size = 1600;
+define constant $timeout = 100;
+
+define layer pcap (<physical-layer>)
+ property administrative-state :: <symbol> = #"down";
+ property promiscuous? :: <boolean> = #t;
+ system property running-state :: <symbol> = #"down";
+ system property device-id :: <string>;
+ system property device-description :: <string>;
+ 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)
+ => ()
+ layer.pcap-flow-node := make(<pcap-flow-node>);
+ register-c-dylan-object(layer.pcap-flow-node);
+ register-property-changed-event(layer, #"administrative-state", toggle-administrative-state);
+end;
+
+define function toggle-administrative-state (event :: <property-changed-event>) => ();
+ let property = event.property-changed-event-property;
+ let layer = property.property-owner;
+ if (property.property-value == #"up")
+ make(<thread>, function: curry(run-interface, layer));
+ else
+ layer. at running-state := #"down";
+ end;
+end;
+
+define method pcap-receive-callback
+ (interface, packet :: <pcap-packet-header*>, bytes)
+ let real-interface = import-c-dylan-object(interface);
+ let res = make(<byte-vector>, size: packet.caplen);
+ //XXX: performance!
+ for (i from 0 below packet.caplen)
+ res[i] := bytes[i];
+ end;
+ push-data(real-interface.the-output, parse-frame(<ethernet-frame>, res));
+end;
+
+define C-callable-wrapper receive-callback of pcap-receive-callback
+ parameter user :: <C-dylan-object>;
+ parameter packet :: <pcap-packet-header*>;
+ parameter bytes :: <C-unsigned-char*>;
+ c-name: "pcap_receive_callback";
+end;
+
+define method push-data-aux (input :: <push-input>,
+ node :: <pcap-flow-node>,
+ frame :: <frame>)
+ let buffer = as(<byte-vector>, assemble-frame(frame).packet);
+ pcap-inject(node.pcap-t, buffer-offset(buffer, 0), buffer.size);
+end;
+
+define function run-interface (layer :: <pcap-layer>)
+ block(return)
+ let node = layer.pcap-flow-node;
+ let pcap-handle =
+ with-c-string (null-string = "")
+ pcap-open-live(layer. at device-id,
+ $ethernet-buffer-size,
+ if (layer. at promiscuous?) 1 else 0 end,
+ $timeout,
+ null-string);
+ end;
+ if (pcap-handle = null-pointer(<C-void*>))
+ layer. at running-state := #"error";
+ return();
+ end;
+ node.pcap-t := pcap-handle;
+ layer. at running-state := #"up";
+ while(layer. at running-state == #"up")
+ pcap-dispatch(pcap-handle,
+ 1,
+ receive-callback,
+ export-c-dylan-object(node));
+ end;
+ pcap-close(node.pcap-t);
+ end;
+end;
+
+define C-function pcap-dispatch
+ parameter p :: <C-void*>;
+ parameter count :: <C-int>;
+ parameter callback :: <C-function-pointer>;
+ parameter user :: <C-dylan-object>;
+ c-name: "pcap_dispatch";
+end;
+
+define C-function pcap-open-live
+ parameter name :: <C-string>;
+ parameter buffer-sizer :: <C-int>;
+ parameter promisc :: <C-int>;
+ parameter timeout :: <C-int>;
+ parameter errbuf :: <C-string>;
+ result pcap-t :: <C-void*>;
+ c-name: "pcap_open_live";
+end;
+
+define C-struct <pcap-packet-header>
+ slot ts :: <timeval>;
+ slot caplen :: <C-int>;
+ slot len :: <C-int>;
+ pointer-type-name: <pcap-packet-header*>;
+ c-name: "pcap_pkthdr";
+end;
+
+
+
+define constant <sockaddr*> = <LPSOCKADDR>;
+define C-struct <pcap-addr>
+ slot next :: <pcap-addr*>;
+ slot address :: <sockaddr*>;
+ slot netmask :: <sockaddr*>;
+ slot broadcast-address :: <sockaddr*>;
+ slot destination-address :: <sockaddr*>;
+ pointer-type-name: <pcap-addr*>;
+ c-name: "pcap_addr";
+end;
+
+define C-struct <pcap-if>
+ slot next :: <pcap-if*>;
+ slot name :: <C-string>;
+ slot description :: <C-string>;
+ slot addresses :: <pcap-addr*>;
+ slot flags :: <C-unsigned-int>;
+ pointer-type-name: <pcap-if*>;
+ c-name: "pcap_if";
+end;
+
+define C-pointer-type <pcap-if**> => <pcap-if*>;
+define C-function pcap-find-all-devices
+ output parameter pcap-if-list :: <pcap-if**>;
+ parameter errbuf :: <C-string>;
+ result errcode :: <C-int>;
+ c-name: "pcap_findalldevs";
+end;
+
+define C-function pcap-free-all-devices
+ parameter pcap-if-list :: <pcap-if*>;
+ c-name: "pcap_freealldevs";
+end;
+
+define function buffer-offset
+ (the-buffer :: <byte-vector>, data-offset :: <integer>)
+ => (result-offset :: <machine-word>)
+ u%+(data-offset,
+ primitive-wrap-machine-word
+ (primitive-repeated-slot-as-raw
+ (the-buffer, primitive-repeated-slot-offset(the-buffer))))
+end function;
+
+define C-function pcap-inject
+ parameter pcap-t :: <C-void*>;
+ parameter buffer :: <C-buffer-offset>;
+ parameter size :: <C-int>;
+ result error :: <C-int>;
+ c-name: "pcap_sendpacket";
+end;
+
+define C-function pcap-close
+ parameter pcap-t :: <C-void*>;
+ //result error :: <C-void>;
+ c-name: "pcap_close";
+end;
+
+define function start-pcap ()
+ with-c-string (errbuf = "")
+ let (errorcode, devices) = pcap-find-all-devices(errbuf);
+ for (device = devices then device.next, while: device ~= null-pointer(<pcap-if*>))
+ make(<pcap-layer>, device-id: as(<byte-string>, device.name), device-description: as(<byte-string>, device.description));
+ end;
+ pcap-free-all-devices(devices);
+ end;
+end;
+
+begin
+ register-startup-function(start-pcap);
+end;
+
Added: trunk/libraries/network/ip-stack/layers/physical/pcap-live-interface/pcap-live-interface.lid
==============================================================================
--- (empty file)
+++ trunk/libraries/network/ip-stack/layers/physical/pcap-live-interface/pcap-live-interface.lid Wed Feb 20 02:13:28 2008
@@ -0,0 +1,4 @@
+library: pcap-live-interface
+files: library
+ pcap-live-interface
+c-libraries: wpcap.lib
\ No newline at end of file
Added: trunk/libraries/network/ip-stack/layers/physical/physical.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/network/ip-stack/layers/physical/physical.dylan Wed Feb 20 02:13:28 2008
@@ -0,0 +1,7 @@
+module: physical-layer
+
+
+define open layer physical (<layer>)
+end;
+
+
Added: trunk/libraries/network/ip-stack/layers/physical/physical.lid
==============================================================================
--- (empty file)
+++ trunk/libraries/network/ip-stack/layers/physical/physical.lid Wed Feb 20 02:13:28 2008
@@ -0,0 +1,3 @@
+library: physical-layer
+files: library
+ physical
Added: trunk/libraries/registry/generic/pcap-live-interface
==============================================================================
--- (empty file)
+++ trunk/libraries/registry/generic/pcap-live-interface Wed Feb 20 02:13:28 2008
@@ -0,0 +1 @@
+abstract://dylan/network/ip-stack/layers/physical/pcap-live-interface/pcap-live-interface.lid
\ No newline at end of file
Added: trunk/libraries/registry/generic/physical-layer
==============================================================================
--- (empty file)
+++ trunk/libraries/registry/generic/physical-layer Wed Feb 20 02:13:28 2008
@@ -0,0 +1 @@
+abstract://dylan/network/ip-stack/layers/physical/physical.lid
\ No newline at end of file
More information about the chatter
mailing list