[chatter] r11814 - in trunk: fundev/sources/duim/gtk libraries/gui-sniffer libraries/layer libraries/network/ip-stack/layers/media-access/ppp-over-ethernet libraries/network/ip-stack/layers/network/arp libraries/network/ip-stack/layers/physical/linux-live-interface
andreas at mccarthy.opendylan.org
andreas at mccarthy.opendylan.org
Sat May 17 01:21:34 CEST 2008
Author: andreas
Date: Sat May 17 01:21:32 2008
New Revision: 11814
Modified:
trunk/fundev/sources/duim/gtk/gtk-debug.dylan
trunk/libraries/gui-sniffer/command-line.dylan
trunk/libraries/gui-sniffer/commands.dylan
trunk/libraries/gui-sniffer/gui-sniffer.dylan
trunk/libraries/gui-sniffer/layer-commands.dylan
trunk/libraries/gui-sniffer/main.dylan
trunk/libraries/gui-sniffer/module.dylan
trunk/libraries/layer/library.dylan
trunk/libraries/layer/module.dylan
trunk/libraries/layer/new-layer.dylan
trunk/libraries/network/ip-stack/layers/media-access/ppp-over-ethernet/ppp-over-ethernet.dylan
trunk/libraries/network/ip-stack/layers/network/arp/arp-exports.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
Log:
job: 7299
Loading and saving of configurations, some minor cleanups.
Modified: trunk/fundev/sources/duim/gtk/gtk-debug.dylan
==============================================================================
--- trunk/fundev/sources/duim/gtk/gtk-debug.dylan (original)
+++ trunk/fundev/sources/duim/gtk/gtk-debug.dylan Sat May 17 01:21:32 2008
@@ -12,4 +12,4 @@
apply(format-out, concatenate(message, "\n"), args);
end;
-*debug-duim-function* := dbg;
+//*debug-duim-function* := dbg;
Modified: trunk/libraries/gui-sniffer/command-line.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/command-line.dylan (original)
+++ trunk/libraries/gui-sniffer/command-line.dylan Sat May 17 01:21:32 2008
@@ -1,6 +1,6 @@
module: command-line
-define open class <nnv-shell-mode> (<shell-mode>)
+define class <nnv-shell-mode> (<shell-mode>)
end class <nnv-shell-mode>;
define method mode-name
Modified: trunk/libraries/gui-sniffer/commands.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/commands.dylan (original)
+++ trunk/libraries/gui-sniffer/commands.dylan Sat May 17 01:21:32 2008
@@ -124,77 +124,6 @@
process-event(pppoe, #"padi-sent");
end;
-define class <set-ip-address-command> (<basic-command>)
- constant slot %address :: <cidr>, required-init-keyword: address:;
-end;
-
-define command-line set-ip-address => <set-ip-address-command>
- (summary: "Set IP address.",
- documentation: "Sets the IP address of the current interface to the specified IP address")
- argument address :: <cidr> = "IP address and netmask in CIDR notation"
-end;
-
-define method do-execute-command (context :: <nnv-context>, command :: <set-ip-address-command>)
- let ip = context.nnv-context.ip-over-ethernet-adapter;
- set-ip-address(ip, command.%address.cidr-network-address, command.%address.cidr-netmask);
-end;
-
-define class <show-arp-table-command> (<basic-command>)
-end;
-
-define command-line show-arp-table => <show-arp-table-command>
- (summary: "Shows ARP table.",
- documentation: "Shows current ARP table")
-end;
-
-define method do-execute-command (context :: <nnv-context>, command :: <show-arp-table-command>)
- print-arp-table(context.context-server.server-output-stream,
- context.nnv-context.ip-over-ethernet-adapter.arp-handler);
-end;
-
-define class <show-forwarding-table-command> (<basic-command>)
-end;
-
-define command-line show-forwarding-table => <show-forwarding-table-command>
- (summary: "Shows forwarding table.",
- documentation: "Prints current forwarding table")
-end;
-
-define method do-execute-command (context :: <nnv-context>, command :: <show-forwarding-table-command>)
- print-forwarding-table(context.context-server.server-output-stream,
- context.nnv-context.ip-layer);
-end;
-
-define class <add-route-command> (<basic-command>)
- constant slot %gateway :: <ipv4-address>, required-init-keyword: gateway:;
- constant slot %network :: <cidr>, required-init-keyword: network:;
-end;
-
-define command-line add-route => <add-route-command>
- (summary: "Adds route.",
- documentation: "Adds route to forwarding table")
- argument network :: <cidr> = "Network";
- argument gateway :: <ipv4-address> = "Gateway";
-end;
-
-define method do-execute-command (context :: <nnv-context>, command :: <add-route-command>)
- add-next-hop-route(context.nnv-context.ip-layer, command.%gateway, command.%network);
-end;
-
-define class <delete-route-command> (<basic-command>)
- constant slot %network :: <cidr>, required-init-keyword: network:;
-end;
-
-define command-line delete-route => <delete-route-command>
- (summary: "Delete route.",
- documentation: "Deletes route from forwarding table")
- argument network :: <cidr> = "Network";
-end;
-
-define method do-execute-command (context :: <nnv-context>, command :: <delete-route-command>)
- delete-route(context.nnv-context.ip-layer, command.%network);
-end;
-
define class <filter-command> (<basic-command>)
constant slot %filter-expression :: <filter-expression>, required-init-keyword: expression:;
end;
@@ -253,11 +182,6 @@
command dhcp-client;
command pppoe-client;
command resolve;
- command set-ip-address;
- command add-route;
- command delete-route;
- command show-arp-table;
- command show-forwarding-table;
command filter;
end command-group;
Modified: trunk/libraries/gui-sniffer/gui-sniffer.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/gui-sniffer.dylan (original)
+++ trunk/libraries/gui-sniffer/gui-sniffer.dylan Sat May 17 01:21:32 2008
@@ -539,10 +539,10 @@
layout (frame) vertically()
frame.filter-pane;
make(<column-splitter>,
- children: vector(frame.packet-table,
- frame.packet-tree-view,
+ children: vector(//frame.packet-table,
+ //frame.packet-tree-view,
// scrolling (scroll-bars: #"both")
- frame.packet-hex-dump,
+ //frame.packet-hex-dump,
// end,
// scrolling (scroll-bars: #"both")
frame.nnv-shell
Modified: trunk/libraries/gui-sniffer/layer-commands.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/layer-commands.dylan (original)
+++ trunk/libraries/gui-sniffer/layer-commands.dylan Sat May 17 01:21:32 2008
@@ -13,6 +13,47 @@
do(curry(print-config, out), find-all-layers());
end;
+define class <save-config-command> (<basic-command>)
+ constant slot %filename :: <string>, required-init-keyword: filename:;
+end;
+
+define command-line save-config => <save-config-command>
+ (summary: "Saves config",
+ documentation: "Saves config of all layers")
+ argument filename :: <string> = "Filename where to save the config"
+end;
+
+define method do-execute-command (context :: <nnv-context>, command :: <save-config-command>)
+ let filename = if (command.%filename = "")
+ concatenate(environment-variable("HOME"), "/.nnv-config")
+ else
+ copy-sequence(command.%filename, end: command.%filename.size - 1);
+ end;
+ with-open-file (file = filename, direction: #"output", if-exists?: #"overwrite")
+ do(curry(print-config, file), find-all-layers());
+ end;
+end;
+
+define class <load-config-command> (<basic-command>)
+ constant slot %filename :: <string>, required-init-keyword: filename:;
+end;
+
+define command-line load-config => <load-config-command>
+ (summary: "Load config",
+ documentation: "Loads configuration from a given file")
+ argument filename :: <string> = "Filename where to load the config"
+end;
+
+define method do-execute-command (context :: <nnv-context>, command :: <load-config-command>)
+ let filename = if (command.%filename = "")
+ concatenate(environment-variable("HOME"), "/.nnv-config")
+ else
+ copy-sequence(command.%filename, end: command.%filename.size - 1);
+ end;
+ with-open-file (file = filename, direction: #"input")
+ read-config(file);
+ end;
+end;
define class <show-layers-command> (<basic-command>)
end;
@@ -205,6 +246,67 @@
end);
end;
+define class <show-arp-table-command> (<basic-command>)
+ constant slot %layer :: <layer>, required-init-keyword: layer:;
+end;
+
+define command-line show-arp-table => <show-arp-table-command>
+ (summary: "Shows ARP table.",
+ documentation: "Shows current ARP table")
+ argument layer :: <layer> = "ARP handler to query.";
+end;
+
+define method do-execute-command (context :: <nnv-context>, command :: <show-arp-table-command>)
+ print-arp-table(context.context-server.server-output-stream,
+ command.%layer);
+end;
+
+/*
+define class <show-forwarding-table-command> (<basic-command>)
+end;
+
+define command-line show-forwarding-table => <show-forwarding-table-command>
+ (summary: "Shows forwarding table.",
+ documentation: "Prints current forwarding table")
+end;
+
+define method do-execute-command (context :: <nnv-context>, command :: <show-forwarding-table-command>)
+ print-forwarding-table(context.context-server.server-output-stream,
+ context.nnv-context.ip-layer);
+end;
+
+define class <add-route-command> (<basic-command>)
+ constant slot %gateway :: <ipv4-address>, required-init-keyword: gateway:;
+ constant slot %network :: <cidr>, required-init-keyword: network:;
+end;
+
+define command-line add-route => <add-route-command>
+ (summary: "Adds route.",
+ documentation: "Adds route to forwarding table")
+ argument network :: <cidr> = "Network";
+ argument gateway :: <ipv4-address> = "Gateway";
+end;
+
+define method do-execute-command (context :: <nnv-context>, command :: <add-route-command>)
+ add-next-hop-route(context.nnv-context.ip-layer, command.%gateway, command.%network);
+end;
+
+define class <delete-route-command> (<basic-command>)
+ constant slot %network :: <cidr>, required-init-keyword: network:;
+end;
+
+define command-line delete-route => <delete-route-command>
+ (summary: "Delete route.",
+ documentation: "Deletes route from forwarding table")
+ argument network :: <cidr> = "Network";
+end;
+
+define method do-execute-command (context :: <nnv-context>, command :: <delete-route-command>)
+ delete-route(context.nnv-context.ip-layer, command.%network);
+end;
+
+*/
+
/*
define class <advertise-arp-command> (<basic-command>)
constant slot %layer :: <layer>, required-init-keyword: layer:;
@@ -230,6 +332,8 @@
(summary: "Layer commands",
documentation: "The set of commands for managing the layers.")
command show-config;
+ command save-config;
+ command load-config;
command show-layers;
command show-layer;
command !set;
@@ -239,5 +343,6 @@
command up;
command down;
command resolve-arp;
+ command show-arp-table;
end command-group;
Modified: trunk/libraries/gui-sniffer/main.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/main.dylan (original)
+++ trunk/libraries/gui-sniffer/main.dylan Sat May 17 01:21:32 2008
@@ -11,7 +11,7 @@
command-enabled?(close-interface, gui-sniffer) := #f;
gadget-enabled?(gui-sniffer.stop-button) := #f;
frame-mapped?(gui-sniffer) := #t;
- //*standard-output* := gui-sniffer.nnv-shell-pane.command-line-server.server-output-stream;
+ *standard-output* := gui-sniffer.nnv-shell-pane.command-line-server.server-output-stream;
write(*standard-output*, $about-text);
format(*standard-output*, "\n\nType 'help' down here to get started.\n");
recenter-window(gui-sniffer.nnv-shell-pane, gui-sniffer.nnv-shell-pane.window-point.bp-line, #"bottom");
Modified: trunk/libraries/gui-sniffer/module.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/module.dylan (original)
+++ trunk/libraries/gui-sniffer/module.dylan Sat May 17 01:21:32 2008
@@ -36,8 +36,10 @@
use commands;
use command-lines;
use format;
- use arp, import: { arp-resolve };
+ use arp, import: { arp-resolve, print-arp-table };
use ipv4, import: { <ipv4-address> };
+ use file-system, import: { with-open-file };
+ use operating-system, import: { environment-variable };
export $layer-command-group;
end;
Modified: trunk/libraries/layer/library.dylan
==============================================================================
--- trunk/libraries/layer/library.dylan (original)
+++ trunk/libraries/layer/library.dylan Sat May 17 01:21:32 2008
@@ -17,6 +17,7 @@
use protocols;
use dhcp-state-machine;
use ppp-state-machine;
+ use regular-expressions;
// Add any more module exports here.
export layer;
Modified: trunk/libraries/layer/module.dylan
==============================================================================
--- trunk/libraries/layer/module.dylan (original)
+++ trunk/libraries/layer/module.dylan Sat May 17 01:21:32 2008
@@ -73,6 +73,8 @@
use common-dylan;
use format;
use print;
+ use regular-expressions;
+ use streams;
export <layer>, layer-name, default-name,
lower-layers, upper-layers,
@@ -89,7 +91,7 @@
register-property-changed-event, deregister-property-changed-event;
export find-layer, find-layer-type, find-all-layers,
- print-layer, print-config;
+ print-layer, print-config, read-config;
export create-raw-socket,
start-layer, register-startup-function;
Modified: trunk/libraries/layer/new-layer.dylan
==============================================================================
--- trunk/libraries/layer/new-layer.dylan (original)
+++ trunk/libraries/layer/new-layer.dylan Sat May 17 01:21:32 2008
@@ -2,7 +2,7 @@
define open abstract class <layer> (<object>)
slot layer-name :: <symbol>, init-keyword: name:;
- slot properties :: <table> = make(<table>);
+ constant slot properties :: <table> = make(<table>);
constant each-subclass slot default-name :: <symbol>;
slot upper-layers :: <sequence> = #();
slot lower-layers :: <sequence> = #();
@@ -74,6 +74,19 @@
deregister-lower-layer(upper, lower);
lower.upper-layers := remove(lower.upper-layers, upper);
upper.lower-layers := remove(upper.lower-layers, lower);
+ deregister-all-property-changed-events(lower, upper);
+ deregister-all-property-changed-events(upper, lower);
+end;
+
+define function delete-layer (layer :: <layer>)
+ layer. at administrative-state := #"invalid";
+ for (upper in layer.upper-layers)
+ disconnect-layer(layer, upper);
+ end;
+ for (lower in layer.lower-layers)
+ disconnect-layer(lower, layer);
+ end;
+ remove-key!($layer-registry, layer.layer-name);
end;
define constant <socket> = <object>;
@@ -114,15 +127,15 @@
define function print-layer (out :: <stream>, layer :: <layer>) => ()
format(out, "%s %s\n", layer.default-name, layer.layer-name);
do(curry(print-property, out), get-properties(layer));
- format(out, " services: ");
+ format(out, " services ");
do(curry(format, out, "%s "), map(layer-name, layer.upper-layers));
- format(out, "\n sources: ");
+ format(out, "\n sources ");
do(curry(format, out, "%s "), map(layer-name, layer.lower-layers));
format(out, "\n\n");
end;
define function print-config (stream :: <stream>, layer :: <layer>) => ()
- format(stream, "%s %s {\n", layer.default-name, layer.layer-name);
+ 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))
@@ -133,10 +146,12 @@
end;
end;
end;
- for (upper in layer.upper-layers)
- format(stream, " service %s\n", upper.layer-name);
+ if (layer.upper-layers.size > 0)
+ format(stream, " services ");
+ do(curry(format, stream, "%s "), map(layer-name, layer.upper-layers));
+ format(stream, "\n");
end;
- format(stream, "}\n\n");
+ format(stream, "\n");
end;
define macro layer-getter-and-setter-definer
@@ -248,12 +263,19 @@
end; }
end;
+layer-getter-and-setter-definer(<layer>; property administrative-state :: <symbol> = #"down";);
+
+define method initialize (layer :: <layer>,
+ #next next-method, #rest rest, #key name, #all-keys);
+ next-method();
+ add-properties-to-table(layer; property administrative-state :: <symbol> = #"down";);
+end;
+
define inline function init-properties (layer :: <layer>, args :: <collection>)
for (i from 0 below args.size by 2)
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;
@@ -268,13 +290,13 @@
define inline function event-notify
(source :: <event-source>, event :: <event>) => ()
- do(method (x) x(event) end, source.listeners)
+ do(method (x) x(event) end, map(head, source.listeners))
end;
define inline function register-property-changed-event
- (source :: <layer>, name :: <symbol>, callback :: <function>) => ()
+ (source :: <layer>, name :: <symbol>, callback :: <function>, #key owner) => ()
let prop = get-property(source, name);
- prop.listeners := add!(prop.listeners, callback);
+ prop.listeners := add!(prop.listeners, pair(callback, owner));
if (slot-initialized?(prop, %property-value))
let event = make(<property-changed-event>,
property: prop,
@@ -286,13 +308,20 @@
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);
+ prop.listeners := choose(method(x) x.head ~== callback end, prop.listeners);
+end;
+
+define inline function deregister-all-property-changed-events
+ (source :: <layer>, owner) => ()
+ for (prop in source.get-properties)
+ prop.listeners := choose(method(x) x.tail ~== owner end, prop.listeners);
+ end;
end;
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:;
+ constant slot property-default-value, init-keyword: default:;
slot %property-value, init-keyword: value:;
constant slot property-owner, init-keyword: owner:;
end;
@@ -307,13 +336,39 @@
//move along
end;
+define generic print-property-value (stream :: <stream>, value);
+
+define method print-property-value (stream :: <stream>, value :: <object>);
+ print-object(value, stream);
+end;
+
+define method print-property-value (stream :: <stream>, value :: <symbol>);
+ format(stream, "%s", value);
+end;
+
+define method print-property-value (stream :: <stream>, value :: <string>);
+ format(stream, "%s", value);
+end;
+
+define method print-property-value (stream :: <stream>, value :: <boolean>);
+ if (value)
+ write(stream, "true")
+ else
+ write(stream, "false")
+ end
+end;
+
define inline function print-property (stream :: <stream>, prop :: <property>) => ()
- format(stream, " %s: %=\n", prop.property-name, prop.property-value);
+ format(stream, " %s ", prop.property-name);
+ print-property-value(stream, prop.property-value);
+ write(stream, "\n");
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>)
@@ -385,7 +440,6 @@
value
end;
-
define class <property-changed-event> (<event>)
constant slot property-changed-event-property :: <property>,
required-init-keyword: property:;
@@ -393,3 +447,78 @@
required-init-keyword: old-value:;
end;
+define function empty-line? (line :: <string>)
+ regex-search("^\\s*$", line) & #t
+end;
+
+define function read-config (stream :: <stream>)
+ flush-config();
+ let property-changes = make(<table>);
+ while(~ stream-at-end?(stream))
+ block(skip)
+ let line = read-line(stream);
+ if (empty-line?(line))
+ skip();
+ end;
+ let (class, name) = apply(values, split(line, ' '));
+ let layer-type = class & find-layer-type(class);
+ unless (layer-type)
+ error("Parse error reading config: unknown layer type %=", class);
+ end;
+ unless (name)
+ error("Parse error reading config: invalid layer name %=", name);
+ end;
+ name := as(<symbol>, name);
+ let layer = find-layer(name) | make(layer-type, name: name);
+ property-changes[layer] := #();
+ block (next)
+ while (~ stream-at-end?(stream))
+ let line = read-line(stream);
+ if (empty-line?(line))
+ next();
+ end;
+ let (_full, property-name, value) = regex-search-strings("^\\s+(\\S*)\\s+(.*)$",
+ line);
+ unless (property-name)
+ error("Parse error reading config for %s %s: invalid property name", class, name);
+ end;
+ property-name := as(<symbol>, property-name);
+ unless (element(layer.properties, property-name, default: #f)
+ | property-name == #"services")
+ error("Parse error reading config for %s %s: unknown property %s", class, name, property-name);
+ end;
+ if (value)
+ property-changes[layer] := pair(pair(property-name, value), property-changes[layer]);
+ end;
+ end;
+ end;
+ end;
+ end;
+ for (layer in key-sequence(property-changes))
+ for (prop in property-changes[layer])
+ unless (prop.head == #"services")
+ read-into-property(get-property(layer, prop.head), prop.tail);
+ end
+ end
+ end;
+ for (layer in key-sequence(property-changes))
+ for (prop in property-changes[layer])
+ if (prop.head == #"services")
+ let uppers = split(prop.tail, " ");
+ for (upper in uppers)
+ unless (empty-line?(upper))
+ connect-layer(layer, find-layer(upper));
+ end
+ end
+ end
+ end
+ end;
+end;
+
+define function flush-config ()
+ let layers = shallow-copy($layer-registry);
+ for (layer in layers)
+ delete-layer(layer);
+ end;
+end;
+
\ No newline at end of file
Modified: trunk/libraries/network/ip-stack/layers/media-access/ppp-over-ethernet/ppp-over-ethernet.dylan
==============================================================================
--- trunk/libraries/network/ip-stack/layers/media-access/ppp-over-ethernet/ppp-over-ethernet.dylan (original)
+++ trunk/libraries/network/ip-stack/layers/media-access/ppp-over-ethernet/ppp-over-ethernet.dylan Sat May 17 01:21:32 2008
@@ -66,7 +66,7 @@
process-event(upper, #"lower-layer-down")
end;
end;
- register-property-changed-event(lower, #"running-state", upper.property-changed-callback);
+ register-property-changed-event(lower, #"running-state", upper.property-changed-callback, owner: upper);
end;
define method deregister-lower-layer (upper :: <pppoe-client-layer>, lower :: <layer>)
Modified: trunk/libraries/network/ip-stack/layers/network/arp/arp-exports.dylan
==============================================================================
--- trunk/libraries/network/ip-stack/layers/network/arp/arp-exports.dylan (original)
+++ trunk/libraries/network/ip-stack/layers/network/arp/arp-exports.dylan Sat May 17 01:21:32 2008
@@ -33,7 +33,8 @@
use date;
use format;
use timer;
+ use print;
use protocols-ethernet;
- export arp-resolve, $broadcast-ethernet-address;
+ export arp-resolve, $broadcast-ethernet-address, print-arp-table;
end module;
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 Sat May 17 01:21:32 2008
@@ -24,26 +24,37 @@
end;
define method register-lower-layer (upper :: <arp-layer>, lower :: <layer>)
- 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("192.168.2.23")]
- := make(<advertised-arp-entry>,
- mac-address: lower. at mac-address,
- ip-address: ipv4-address("192.168.2.23"));
- upper. at running-state := #"up";
-end;
-
-define method deregister-lower-layer (upper :: <arp-layer>, lower :: <layer>)
- for (arp-entry in choose(rcurry(instance?, <outstanding-arp-request>),
- upper.arp-flow-node.arp-table))
- cancel(arp-entry.timer);
- remove!(upper.arp-flow-node.arp-table, arp-entry);
+ register-property-changed-event(lower, #"running-state",
+ curry(toggle-running-state, upper),
+ owner: upper);
+end;
+
+define function toggle-running-state (upper :: <arp-layer>, event :: <property-changed-event>)
+ => ();
+ let property = event.property-changed-event-property;
+ let lower = property.property-owner;
+ if (property.property-value == #"up")
+ 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("192.168.0.42")]
+ := make(<advertised-arp-entry>,
+ mac-address: lower. at mac-address,
+ ip-address: ipv4-address("192.168.0.42"));
+ upper. at running-state := #"up";
+ else
+ let remove-them = list();
+ for (arp-entry in upper.arp-flow-node.arp-table)
+ if (instance?(arp-entry, <outstanding-arp-request>))
+ cancel(arp-entry.timer);
+ remove-them := pair(arp-entry, remove-them);
+ end;
+ end;
+ do(curry(remove-key!, upper.arp-flow-node.arp-table), remove-them);
+ upper. at running-state := #"down";
end;
- upper. at running-state := #"down";
end;
-
define constant $broadcast-ethernet-address = mac-address("ff:ff:ff:ff:ff:ff");
define function arp-resolve (arp :: <arp-layer>, destination :: <ipv4-address>, clos :: <function>) => ();
@@ -124,8 +135,8 @@
format(stream, "D %s %s", object.ip-address, object.arp-mac-address);
end;
-define function print-arp-table (stream :: <stream>, arp-handler :: <arp-handler>)
- for (arp in arp-handler.arp-table)
+define function print-arp-table (stream :: <stream>, layer :: <arp-layer>)
+ for (arp in layer.arp-flow-node.arp-table)
format(stream, "%=\n", arp);
end;
end;
@@ -221,3 +232,4 @@
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 Sat May 17 01:21:32 2008
@@ -12,8 +12,8 @@
define layer phy (<physical-layer>)
property administrative-state :: <symbol> = #"down";
property promiscuous? :: <boolean> = #t;
+ property device-name :: <string> = "";
system property running-state :: <symbol> = #"down";
- system property device-name :: <string>;
slot packet-flow-node :: <packet-flow-node> = make(<packet-flow-node>);
slot demultiplexer :: <demultiplexer> = make(<demultiplexer>);
slot fan-in :: <fan-in> = make(<fan-in>);
More information about the chatter
mailing list