[Gd-chatter] r11529 - in trunk/libraries: gui-sniffer layer network-flow protocols
andreas at gwydiondylan.org
andreas at gwydiondylan.org
Fri Dec 7 02:29:40 CET 2007
Author: andreas
Date: Fri Dec 7 02:29:38 2007
New Revision: 11529
Modified:
trunk/libraries/gui-sniffer/command-line.dylan
trunk/libraries/gui-sniffer/commands.dylan
trunk/libraries/gui-sniffer/gui-sniffer.dylan
trunk/libraries/gui-sniffer/module.dylan
trunk/libraries/layer/dhcp.dylan
trunk/libraries/layer/layer.dylan
trunk/libraries/layer/module.dylan
trunk/libraries/layer/udp.dylan
trunk/libraries/network-flow/module.dylan
trunk/libraries/network-flow/network-flow.dylan
trunk/libraries/protocols/cidr.dylan
trunk/libraries/protocols/protocols-library.dylan
Log:
job: 7299
A whole lot of new commands for Network Night Vision, including
DHCP auto-configuration.
Modified: trunk/libraries/gui-sniffer/command-line.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/command-line.dylan (original)
+++ trunk/libraries/gui-sniffer/command-line.dylan Fri Dec 7 02:29:38 2007
@@ -22,9 +22,10 @@
#key window = frame-window(*editor-frame*)) => ()
let text = as(<string>, section);
let bp = line-end(section-end-line(section));
- queue-redisplay(window, $display-text);
shell-execute-code(window, text, bp);
- move-point!(bp, window: window)
+ move-point!(bp, window: window);
+ queue-redisplay(window, $display-text);
+ redisplay-window(window);
end method do-process-shell-input;
define method shell-execute-code
@@ -90,8 +91,9 @@
dynamic-bind (*editor-frame* = window)
let buffer = buffer | make-shell();
let stream
- = make(<interval-stream>,
+ = make(<repainting-interval-stream>,
interval: buffer,
+ window: window,
direction: #"output");
let server
= make-command-line-server
Modified: trunk/libraries/gui-sniffer/commands.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/commands.dylan (original)
+++ trunk/libraries/gui-sniffer/commands.dylan Fri Dec 7 02:29:38 2007
@@ -18,6 +18,24 @@
end;
end;
+define method parse-next-argument
+ (context :: <nnv-context>, type == <cidr>,
+ text :: <string>,
+ #key start :: <integer> = 0, end: stop = #f)
+ => (value :: <cidr>, next-index :: <integer>)
+ block (return)
+ let (name, next-index)
+ = parse-next-word(text, start: start, end: stop);
+ if (name)
+ values(as(<cidr>, name), next-index)
+ else
+ parse-error("Missing argument.")
+ end
+ exception (e :: <condition>)
+ parse-error("Not a valid target.")
+ end;
+end;
+
define class <ping-command> (<basic-command>)
constant slot %target :: <ipv4-address>, required-init-keyword: target:;
end;
@@ -31,16 +49,115 @@
define method do-execute-command (context :: <nnv-context>, command :: <ping-command>)
let target = command.%target;
let stream = context.context-server.server-output-stream;
+ let demux-output = create-output-for-filter(context.nnv-context.ip-layer.demultiplexer,
+ format-to-string("(icmp) & (ipv4.source-address = %s)",
+ target));
+ let response-handler = make(<closure-node>,
+ closure: method(packet)
+ format(stream, "Host %s is alive\n", target);
+ //refresh-output(context);
+ //disconnect(demux-output, response-handler);
+ remove-output(context.nnv-context.ip-layer.demultiplexer,
+ demux-output);
+ end);
+ connect(demux-output, response-handler);
let icmp = icmp-frame(code: 0, icmp-type: 8,
payload: read-frame(<raw-frame>, "123412341234123412341234123412341234123412341234"));
send(context.nnv-context.ip-layer, target, icmp);
format(stream, "Ping sent!\n");
end;
+define class <dhcp-client-command> (<basic-command>)
+end;
+
+define command-line dhcp-client => <dhcp-client-command>
+ (summary: "Aquire IP address via DHCP.",
+ documentation: "Initiates a DHCP client session, and configures IP stack with the acquired IP address.")
+end;
+
+define method do-execute-command (context :: <nnv-context>, command :: <dhcp-client-command>)
+ let socket = create-socket(context.nnv-context.udp-layer, 67, client-port: 68);
+ local method set-ip (frame :: <dhcp-message>)
+ let ip = frame.your-ip-address;
+ let subnet-mask = netmask-from-byte-vector(data(find-option(frame, <dhcp-subnet-mask>).subnet-mask));
+ let router = find-option(frame, <dhcp-router-option>).addresses[0];
+ set-ip-address(context.nnv-context.ip-over-ethernet-adapter, ip, subnet-mask);
+ let default-cidr = as(<cidr>, "0.0.0.0/0");
+ delete-route(context.nnv-context.ip-layer, default-cidr);
+ add-next-hop-route(context.nnv-context.ip-layer, router, default-cidr);
+ //format(context.context-server.server-output-stream, "received ack %s\n", as(<string>, frame));
+ end;
+ let dhcp = make(<dhcp-client>, send-socket: socket, response-callback: set-ip);
+ connect(socket.decapsulator, dhcp);
+ process-event(dhcp, #"send-discover");
+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 command-group nnv
(summary: "Network Night Vision commands",
documentation: "The set of commands provided by Network Night Vision.")
command ping;
+ command dhcp-client;
+ command set-ip-address;
+ command add-route;
+ command show-arp-table;
+ command show-forwarding-table;
group basic;
group property;
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 Fri Dec 7 02:29:38 2007
@@ -440,6 +440,8 @@
slot filter-expression = #f;
slot ethernet-layer = #f;
slot ip-layer = #f;
+ slot ip-over-ethernet-adapter = #f;
+ slot udp-layer = #f;
slot listening-socket = #f;
slot first-packet-arrived :: false-or(<date>) = #f;
slot filter-history :: <list> = make(<list>);
@@ -817,14 +819,17 @@
define method open-interface (frame :: <gui-sniffer-frame>)
let (interface-name, promiscuous?) = prompt-for-interface(owner: frame);
if (interface-name)
+ reinit-gui(frame);
format-out("Listening on interface %=\n", interface-name);
let ethernet-layer
= build-ethernet-layer(interface-name, promiscuous?: promiscuous?);
let ethernet-socket = create-raw-socket(ethernet-layer);
connect(ethernet-socket, frame);
connect(frame, ethernet-socket);
- frame.ip-layer := build-ip-layer(ethernet-layer, ip-address: ipv4-address("192.168.0.69"));
- reinit-gui(frame);
+ let (layer, adapter) = build-ip-layer(ethernet-layer);
+ frame.ip-layer := layer;
+ frame.ip-over-ethernet-adapter := adapter;
+ frame.udp-layer := build-udp-layer(frame.ip-layer);
frame.ethernet-layer := ethernet-layer;
frame.listening-socket := ethernet-socket;
gadget-label(frame.sniffer-status-bar) := concatenate("Capturing ", interface-name);
Modified: trunk/libraries/gui-sniffer/module.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/module.dylan (original)
+++ trunk/libraries/gui-sniffer/module.dylan Fri Dec 7 02:29:38 2007
@@ -57,6 +57,8 @@
use ipv4, import: { <ipv4-frame>, <udp-frame>, source-port, destination-port,
acknowledgement-number, sequence-number, ipv4-address, <ipv4-address> };
use icmp, import: { <icmp-frame>, icmp-frame };
+ use dhcp, import: { <dhcp-message>, <dhcp-subnet-mask>, <dhcp-router-option>, subnet-mask, addresses, your-ip-address };
+ use cidr;
use tcp;
use ipv6;
// Add binding exports here.
Modified: trunk/libraries/layer/dhcp.dylan
==============================================================================
--- trunk/libraries/layer/dhcp.dylan (original)
+++ trunk/libraries/layer/dhcp.dylan Fri Dec 7 02:29:38 2007
@@ -2,6 +2,7 @@
define class <dhcp-client> (<filter>, <dhcp-client-state>)
slot send-socket, init-keyword: send-socket:;
+ slot received-response-callback = identity, init-keyword: response-callback:;
end;
define method push-data-aux (input :: <push-input>,
@@ -22,7 +23,8 @@
if (frame.operation = 2)
if (message-type-frame.message-type = 5) //ack
process-event(node, #"receive-ack");
- format-out("received ack %s\n", as(<string>, frame));
+ node.received-response-callback(frame);
+ //format-out("received ack %s\n", as(<string>, frame));
elseif (message-type-frame.message-type = 6) //nak
process-event(node, #"receive-nak")
end
Modified: trunk/libraries/layer/layer.dylan
==============================================================================
--- trunk/libraries/layer/layer.dylan (original)
+++ trunk/libraries/layer/layer.dylan Fri Dec 7 02:29:38 2007
@@ -201,7 +201,8 @@
let from-addr = arp-handler.send-socket.listen-address;
let from-ip = find-key(arp-handler.arp-table,
method(x)
- x.arp-mac-address = from-addr
+ instance?(x, <known-arp-entry>) &
+ (x.arp-mac-address = from-addr)
end);
let arp-request = make(<arp-frame>,
operation: 1,
@@ -228,6 +229,25 @@
define constant $broadcast-ethernet-address = mac-address("ff:ff:ff:ff:ff:ff");
+define function set-ip-address (ip-over-ethernet :: <ip-over-ethernet-adapter>, address :: <ipv4-address>, netmas :: <integer>)
+ unregister-adapter(ip-over-ethernet.ip-layer, ip-over-ethernet);
+ remove-key!(ip-over-ethernet.arp-handler.arp-table, ip-over-ethernet.v4-address);
+ ip-over-ethernet.v4-address := address;
+ ip-over-ethernet.netmask := netmas;
+ reconfigure-ip-address(ip-over-ethernet);
+end;
+
+define function reconfigure-ip-address (ip-over-ethernet :: <ip-over-ethernet-adapter>)
+ unless (ip-over-ethernet.v4-address = ipv4-address("0.0.0.0"))
+ ip-over-ethernet.arp-handler.arp-table[ip-over-ethernet.v4-address]
+ := make(<advertised-arp-entry>,
+ ip-address: ip-over-ethernet.v4-address,
+ mac-address: ip-over-ethernet.ethernet-layer.default-mac-address);
+ end;
+ register-adapter(ip-over-ethernet.ip-layer, ip-over-ethernet);
+ ip-over-ethernet.ip-layer.default-ip-address := ip-over-ethernet.v4-address;
+end;
+
define method initialize (ip-over-ethernet :: <ip-over-ethernet-adapter>,
#rest rest, #key, #all-keys);
let arp-socket = create-socket(ip-over-ethernet.ethernet-layer, #x806);
@@ -241,12 +261,6 @@
ip-over-ethernet.arp-handler.send-socket := arp-socket;
- unless (ip-over-ethernet.v4-address = ipv4-address("0.0.0.0"))
- ip-over-ethernet.arp-handler.arp-table[ip-over-ethernet.v4-address]
- := make(<advertised-arp-entry>,
- ip-address: ip-over-ethernet.v4-address,
- mac-address: ip-over-ethernet.ethernet-layer.default-mac-address);
- end;
let ip-socket = create-socket(ip-over-ethernet.ethernet-layer, #x800);
let ip-broadcast-socket = create-socket(ip-over-ethernet.ethernet-layer,
@@ -258,9 +272,7 @@
connect(ip-socket.decapsulator, ipv4-fan-in);
connect(ip-broadcast-socket.decapsulator, ipv4-fan-in);
connect(ipv4-fan-in, ip-over-ethernet.ip-layer.reassembler);
-
- register-adapter(ip-over-ethernet.ip-layer, ip-over-ethernet);
- ip-over-ethernet.ip-layer.default-ip-address := ip-over-ethernet.v4-address;
+ reconfigure-ip-address(ip-over-ethernet);
end;
@@ -369,11 +381,23 @@
constant slot next-hop :: <ipv4-address>, required-init-keyword: next-hop:;
end;
+define method print-object (object :: <next-hop-route>, stream :: <stream>) => ()
+ format(stream, "%= -> %s", object.cidr, object.next-hop);
+end;
define generic adapter (object :: <connected-route>) => (res :: <adapter>);
define class <connected-route> (<route>)
constant slot adapter :: <adapter>, required-init-keyword: adapter:;
end;
+define method print-object (object :: <connected-route>, stream :: <stream>) => ()
+ format(stream, "%= -> %=", object.cidr, object.adapter);
+end;
+
+define function print-forwarding-table (stream :: <stream>, ip-layer :: <ip-layer>)
+ for (route in ip-layer.routes)
+ format(stream, "%=\n", route);
+ end;
+end;
define method register-route (ip :: <ip-layer>, route :: <route>)
add!(ip.routes, route);
sort!(ip.routes, test: method(x, y) x.cidr.cidr-netmask > y.cidr.cidr-netmask end)
@@ -431,6 +455,9 @@
define method unregister-adapter (ip :: <ip-layer>,
adapter :: <adapter>)
+ //unregister-route
+ let my-cidr = make(<cidr>, netmask: adapter.netmask, network-address: adapter.v4-address);
+ delete-route(ip, my-cidr);
remove!(ip.adapters, adapter);
end;
@@ -583,6 +610,26 @@
define class <advertised-arp-entry> (<static-arp-entry>)
end;
+define method print-object (object :: <outstanding-arp-request>, stream :: <stream>) => ()
+ format(stream, "? %s", object.ip-address);
+end;
+
+define method print-object (object :: <static-arp-entry>, stream :: <stream>) => ()
+ format(stream, "S %s %s", object.ip-address, object.arp-mac-address);
+end;
+
+define method print-object (object :: <advertised-arp-entry>, stream :: <stream>) => ()
+ format(stream, "A %s %s", object.ip-address, object.arp-mac-address);
+end;
+define method print-object (object :: <dynamic-arp-entry>, stream :: <stream>) => ()
+ 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)
+ format(stream, "%=\n", arp);
+ end;
+end;
define open generic arp-timestamp (object :: <dynamic-arp-entry>) => (res :: <date>);
define class <dynamic-arp-entry> (<known-arp-entry>)
constant slot arp-timestamp :: <date> = current-date()
@@ -709,6 +756,16 @@
ethernet-layer;
end;
+define function add-next-hop-route (ip-layer :: <ip-layer>, next-hop :: <ipv4-address>, cidr :: <cidr>)
+ register-route(ip-layer, make(<next-hop-route>,
+ next-hop: next-hop,
+ cidr: cidr));
+end;
+
+define function delete-route (ip-layer :: <ip-layer>, mycidr :: <cidr>)
+ let route = choose(method(x) x.cidr = mycidr end, ip-layer.routes);
+ do(curry(remove!, ip-layer.routes), route);
+end;
define function build-ip-layer (ethernet-layer,
#key ip-address :: false-or(<ipv4-address>),
@@ -726,10 +783,9 @@
ip-layer: ip-layer,
ipv4-address: ip-address | ipv4-address("0.0.0.0"),
netmask: netmask);
+
if (default-gateway)
- register-route(ip-layer, make(<next-hop-route>,
- next-hop: default-gateway,
- cidr: make(<cidr>, network-address: ipv4-address("0.0.0.0"), netmask: 0)));
+ add-next-hop-route(ip-layer, default-gateway, make(<cidr>, network-address: ipv4-address("0.0.0.0"), netmask: 0));
end;
if (ip-address)
send-gratitious-arp(arp-handler, ip-address);
@@ -740,3 +796,4 @@
// icmp-handler: icmp-handler);
values(ip-layer, ip-over-ethernet);
end;
+
Modified: trunk/libraries/layer/module.dylan
==============================================================================
--- trunk/libraries/layer/module.dylan (original)
+++ trunk/libraries/layer/module.dylan Fri Dec 7 02:29:38 2007
@@ -17,7 +17,7 @@
use byte-vector;
use date, import: {<date>, current-date };
use tcp-state-machine;
- use state-machine;
+ use state-machine, export: { process-event };
use simple-random;
use streams;
use ipv4;
@@ -28,12 +28,16 @@
use ethernet;
use dns, exclude: { ipv4-address };
use cidr;
+ use print;
// Add binding exports here.
export <ethernet-layer>,
ethernet-interface,
<ip-over-ethernet-adapter>,
+ arp-handler,
+ print-arp-table,
<ip-layer>,
+ print-forwarding-table,
<icmp-handler>,
<icmp-over-ip-adapter>,
<arp-handler>,
@@ -45,8 +49,14 @@
build-ethernet-layer,
build-ip-layer,
send-socket,
- send;
+ send,
+ set-ip-address,
+ delete-route,
+ add-next-hop-route,
+ demultiplexer; // HACK: remove me!
- export <udp-layer>,
+ export <udp-layer>, build-udp-layer,
<tcp-layer>;
+
+ export <dhcp-client>, find-option;
end module layer;
Modified: trunk/libraries/layer/udp.dylan
==============================================================================
--- trunk/libraries/layer/udp.dylan (original)
+++ trunk/libraries/layer/udp.dylan Fri Dec 7 02:29:38 2007
@@ -51,6 +51,10 @@
send(socket.udp-layer.ip-send-socket, destination, udp);
end;
+define function build-udp-layer (ip-layer :: <ip-layer>)
+ make(<udp-layer>, ip-layer: ip-layer)
+end;
+
define function udp-begin()
let ip-layer = init-ip-layer();
let udp = make(<udp-layer>, ip-layer: ip-layer);
Modified: trunk/libraries/network-flow/module.dylan
==============================================================================
--- trunk/libraries/network-flow/module.dylan (original)
+++ trunk/libraries/network-flow/module.dylan Fri Dec 7 02:29:38 2007
@@ -24,5 +24,5 @@
<pcap-file-writer>,
<malformed-packet-writer>,
<fan-out>, <fan-in>,
- create-input, create-output;
+ create-input, create-output, remove-output;
end module network-flow;
Modified: trunk/libraries/network-flow/network-flow.dylan
==============================================================================
--- trunk/libraries/network-flow/network-flow.dylan (original)
+++ trunk/libraries/network-flow/network-flow.dylan Fri Dec 7 02:29:38 2007
@@ -59,13 +59,16 @@
end;
define open class <fan-in> (<single-push-output-node>)
- slot inputs :: <stretchy-vector> = make(<stretchy-vector>);
+ constant slot inputs :: <stretchy-vector> = make(<stretchy-vector>);
+ constant slot %lock :: <lock> = make(<lock>);
end;
define method create-input
(fan-in :: <fan-in>)
let res = make(<push-input>, node: fan-in);
- add!(fan-in.inputs, res);
+ with-lock(fan-in.%lock)
+ add!(fan-in.inputs, res);
+ end;
res;
end;
@@ -76,7 +79,9 @@
define method disconnect (output :: <object>, fan-in :: <fan-in>)
let in = output.connected-input;
disconnect(output, in);
- remove!(fan-in.inputs, in);
+ with-lock(fan-in.%lock)
+ remove!(fan-in.inputs, in);
+ end
end;
define method push-data-aux (input :: <push-input>,
@@ -85,13 +90,16 @@
push-data(node.the-output, frame);
end;
define class <fan-out> (<single-push-input-node>)
- slot outputs :: <stretchy-vector> = make(<stretchy-vector>);
+ constant slot outputs :: <stretchy-vector> = make(<stretchy-vector>);
+ constant slot %lock :: <lock> = make(<lock>);
end;
define method create-output
(fan-out :: <fan-out>)
let res = make(<push-output>, node: fan-out);
- add!(fan-out.outputs, res);
+ with-lock(fan-out.%lock)
+ add!(fan-out.outputs, res);
+ end;
res;
end;
@@ -102,12 +110,18 @@
define method disconnect (fan-out :: <fan-out>, input :: <object>)
let out = input.connected-output;
disconnect(out, input);
- remove!(fan-out.outputs, out);
+ with-lock(fan-out.%lock)
+ remove!(fan-out.outputs, out);
+ end;
end;
define method push-data-aux (input :: <push-input>,
node :: <fan-out>,
frame :: <frame>)
- for (output in node.outputs)
+ let the-outputs =
+ with-lock(node.%lock)
+ copy-sequence(node.outputs)
+ end;
+ for (output in the-outputs)
push-data(output, frame)
end;
end;
@@ -119,6 +133,7 @@
define class <demultiplexer> (<single-push-input-node>)
slot outputs :: <stretchy-vector> = make(<stretchy-vector>);
+ constant slot %lock :: <lock> = make(<lock>);
end;
define method create-output-for-filter
@@ -133,14 +148,28 @@
let output = make(<filtered-push-output>,
frame-filter: filter,
node: demux);
- add!(demux.outputs, output);
+ with-lock(demux.%lock)
+ add!(demux.outputs, output);
+ end;
output
end;
+define method remove-output
+ (demux :: <demultiplexer>, filter-output :: <filtered-push-output>)
+ => ();
+ with-lock(demux.%lock)
+ remove!(demux.outputs, filter-output);
+ end;
+end;
+
define method push-data-aux (input :: <push-input>,
node :: <demultiplexer>,
frame :: <frame>)
- for (output in node.outputs)
+ let the-outputs =
+ with-lock(node.%lock)
+ copy-sequence(node.outputs)
+ end;
+ for (output in the-outputs)
if(matches?(frame, output.frame-filter))
push-data(output, frame)
end
Modified: trunk/libraries/protocols/cidr.dylan
==============================================================================
--- trunk/libraries/protocols/cidr.dylan (original)
+++ trunk/libraries/protocols/cidr.dylan Fri Dec 7 02:29:38 2007
@@ -10,6 +10,23 @@
required-init-keyword: netmask:;
end class;
+define method base-network-address (cidr :: <cidr>)
+ => (ip-address :: <ipv4-address>)
+ let (bytes, bits) = truncate/(cidr.cidr-netmask, 8);
+ let data-vector = make(<vector>, size: 4, fill: 0);
+ for (i from 0 below bytes)
+ data-vector[i] := cidr.cidr-network-address.data[i];
+ end;
+ if ((bytes < 4) & (bits > 0))
+ let mask = logand(#xff, ash(#xff, 8 - bits));
+ data-vector[bytes] := logand(mask, cidr.cidr-network-address.data[bytes]);
+ end;
+ parse-frame(<ipv4-address>, data-vector)
+end;
+
+define method \= (a :: <cidr>, b :: <cidr>) => (res :: <boolean>)
+ (a.cidr-netmask == b.cidr-netmask) & (base-network-address(a) = base-network-address(b))
+end;
define method ip-in-cidr? (cidr :: <cidr>, ipv4-address :: <ipv4-address>)
let (bytes, bits) = truncate/(cidr.cidr-netmask, 8);
block(ret)
@@ -38,12 +55,17 @@
integer-to-string(cidr.cidr-netmask));
end;
-define method as (class == <cidr>, string :: <string>)
+define method as(class == <cidr>, string :: <string>)
=> (res :: <cidr>)
- let (ip, mask) = apply(values, split(string, '/'));
- make(<cidr>,
- network-address: ipv4-address(ip),
- netmask: string-to-integer(mask));
+ let address-and-mask = split(string, '/');
+ unless (address-and-mask.size = 2)
+ signal(make(<error>, error: "CIDR syntax wrong IP/Netmask[prefixlen]"));
+ end;
+ let network-address = address-and-mask[0];
+ let netmask = address-and-mask[1];
+ network-address := ipv4-address(network-address);
+ netmask := string-to-integer(netmask);
+ make(<cidr>, network-address: network-address, netmask: netmask)
end;
define method broadcast-address (cidr :: <cidr>) => (res :: <ipv4-address>);
Modified: trunk/libraries/protocols/protocols-library.dylan
==============================================================================
--- trunk/libraries/protocols/protocols-library.dylan (original)
+++ trunk/libraries/protocols/protocols-library.dylan Fri Dec 7 02:29:38 2007
@@ -318,6 +318,10 @@
<dhcp-message-type-option>,
<dhcp-requested-ip-address-option>,
<dhcp-server-identifier-option>,
+ <dhcp-subnet-mask>,
+ <dhcp-router-option>,
+ subnet-mask,
+ addresses,
message-type,
dhcp-options,
your-ip-address,
@@ -448,6 +452,7 @@
use common-extensions, exclude: { format-to-string };
export <cidr>,
+ base-network-address,
cidr-network-address, cidr-netmask,
ip-in-cidr?, broadcast-address,
netmask-from-byte-vector;
More information about the chatter
mailing list