[Gd-chatter] r10918 - in trunk/libraries: flow layer packetizer
hannes at gwydiondylan.org
hannes at gwydiondylan.org
Tue Oct 3 22:10:45 CEST 2006
Author: hannes
Date: Tue Oct 3 22:10:42 2006
New Revision: 10918
Added:
trunk/libraries/layer/cidr.dylan (contents, props changed)
Modified:
trunk/libraries/flow/flow.dylan
trunk/libraries/flow/module.dylan
trunk/libraries/layer/layer.dylan
trunk/libraries/layer/layer.hdp
trunk/libraries/packetizer/ipv4.dylan
Log:
Bug: 7299
*implement <closure-node>
*implement forwarding engine
Modified: trunk/libraries/flow/flow.dylan
==============================================================================
--- trunk/libraries/flow/flow.dylan (original)
+++ trunk/libraries/flow/flow.dylan Tue Oct 3 22:10:42 2006
@@ -97,6 +97,14 @@
node.the-input := make(<push-input>, node: node)
end;
+define class <closure-node> (<single-push-input-node>)
+ constant slot closure :: <function>, required-init-keyword: closure:;
+end;
+
+define method push-data-aux (input :: <push-input>, node :: <closure-node>, data) => ()
+ node.closure(data);
+end;
+
define method get-inputs (node :: <single-input-node>) => (inputs)
list(node.the-input)
end;
Modified: trunk/libraries/flow/module.dylan
==============================================================================
--- trunk/libraries/flow/module.dylan (original)
+++ trunk/libraries/flow/module.dylan Tue Oct 3 22:10:42 2006
@@ -21,7 +21,7 @@
export
<single-push-input-node>, <single-pull-input-node>,
<single-push-output-node>, <single-pull-output-node>,
- <filter>;
+ <filter>, <closure-node>;
export <queue>, the-input, the-output;
Added: trunk/libraries/layer/cidr.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/layer/cidr.dylan Tue Oct 3 22:10:42 2006
@@ -0,0 +1,49 @@
+module: layer
+
+
+define open generic cidr-network-address (cidr :: <cidr>) => (res :: <ipv4-address>);
+define open generic cidr-netmask (cidr :: <cidr>) => (res :: <integer>);
+
+define class <cidr> (<object>)
+ constant slot cidr-network-address :: <ipv4-address>,
+ required-init-keyword: network-address:;
+ constant slot cidr-netmask :: <integer>,
+ required-init-keyword: netmask:;
+end class;
+
+
+define method ip-in-cidr? (cidr :: <cidr>, ipv4-address :: <ipv4-address>)
+ let (bytes, bits) = truncate/(cidr.cidr-netmask, 8);
+ block(ret)
+ for (i from 0 below bytes)
+ unless (ipv4-address.data[i] = cidr.cidr-network-address.data[i])
+ ret(#f)
+ end;
+ end;
+ if ((bytes < 4) & (bits > 0))
+ let mask = logand(#xff, ash(#xff, 8 - bits));
+ unless (logand(mask, ipv4-address.data[bytes]) = logand(mask, cidr.cidr-network-address.data[bytes]))
+ ret(#f)
+ end;
+ end;
+ #t;
+ end;
+end;
+define method print-object (cidr :: <cidr>, stream :: <stream>)
+ => ()
+ format(stream, "%s", as(<string>, cidr));
+end;
+
+define method as (class == <string>, cidr :: <cidr>)
+ => (res :: <string>)
+ concatenate(as(<string>, cidr-network-address(cidr)), "/",
+ integer-to-string(cidr.cidr-netmask));
+end;
+
+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));
+end;
Modified: trunk/libraries/layer/layer.dylan
==============================================================================
--- trunk/libraries/layer/layer.dylan (original)
+++ trunk/libraries/layer/layer.dylan Tue Oct 3 22:10:42 2006
@@ -133,12 +133,14 @@
define open generic ip-layer-setter (value :: <ip-layer>, object :: <object>) => (res :: <ip-layer>);
define open generic ip-send-socket (object :: <ip-over-ethernet-adapter>) => (res :: <ethernet-socket>);
define open generic ip-send-socket-setter (value :: <ethernet-socket>, object :: <ip-over-ethernet-adapter>) => (res :: <ethernet-socket>);
+define open generic netmask (object :: <ip-over-ethernet-adapter>) => (res :: <integer>);
define class <ip-over-ethernet-adapter> (<adapter>)
constant slot ip-layer :: <ip-layer>, required-init-keyword: ip-layer:;
constant slot ethernet-layer :: <ethernet-layer>, required-init-keyword: ethernet:;
constant slot arp-handler :: <arp-handler>, required-init-keyword: arp:;
constant slot v4-address :: <ipv4-address>, required-init-keyword: ipv4-address:;
+ constant slot netmask :: <integer>, required-init-keyword: netmask:;
slot ip-send-socket :: <ethernet-socket>;
end;
@@ -181,7 +183,7 @@
connect(ip-broadcast-socket.decapsulator, ipv4-fan-in);
connect(ipv4-fan-in, ip-over-ethernet.ip-layer.demultiplexer);
- ip-over-ethernet.ip-layer.send-socket := ip-over-ethernet;
+ register-adapter(ip-over-ethernet.ip-layer, ip-over-ethernet);
ip-over-ethernet.ip-layer.default-ip-address := ip-over-ethernet.v4-address;
end;
@@ -190,11 +192,86 @@
define open generic send-socket-setter (value :: <object>, object :: <object>) => (res);
define generic default-ip-address (object :: <ip-layer>) => (res :: <ipv4-address>);
define generic default-ip-address-setter (value :: <ipv4-address>, object :: <ip-layer>) => (res :: <ipv4-address>);
+define open generic adapters (object :: <ip-layer>) => (res);
+define open generic routes (object :: <ip-layer>) => (res);
define class <ip-layer> (<layer>)
slot send-socket :: type-union(<socket>, <adapter>);
- //slot routing-table = make(<vector-table>);
+ constant slot adapters = make(<stretchy-vector>);
slot default-ip-address :: <ipv4-address>;
+ constant slot routes = make(<stretchy-vector>);
+end;
+
+define class <route> (<object>)
+ constant slot cidr :: <cidr>, required-init-keyword: cidr:;
+end;
+
+define generic next-hop (object :: <next-hop-route>) => (res :: <ipv4-address>);
+
+define class <next-hop-route> (<route>)
+ constant slot next-hop :: <ipv4-address>, required-init-keyword: 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 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)
+end;
+
+define method initialize (ip-layer :: <ip-layer>,
+ #rest rest, #key, #all-keys);
+ let cls = make(<closure-node>,
+ closure: method(x)
+ let (adapter, next-hop)
+ = find-adapter-for-forwarding(ip-layer, x.destination-address);
+ send(adapter, next-hop, x)
+ end);
+ connect(ip-layer.fan-in, cls);
+end;
+define method register-adapter (ip :: <ip-layer>,
+ adapter :: <ip-over-ethernet-adapter>)
+ add!(ip.adapters, adapter);
+ let route = make(<connected-route>,
+ cidr: make(<cidr>, netmask: adapter.netmask, network-address: adapter.v4-address),
+ adapter: adapter);
+ register-route(ip, route);
+end;
+
+define method unregister-adapter (ip :: <ip-layer>,
+ adapter :: <adapter>)
+ remove!(ip.adapters, adapter);
+end;
+
+define method find-route (forwarding-table, destination :: <ipv4-address>) => (route :: false-or(<route>))
+ block(ret)
+ for (ele in forwarding-table)
+ if (ip-in-cidr?(ele.cidr, destination))
+ ret(ele)
+ end;
+ end;
+ end;
+end;
+
+define method find-adapter-for-forwarding (ip-layer :: <ip-layer>, destination-address :: <ipv4-address>)
+ => (res :: <adapter>, next-hop :: <ipv4-address>);
+ let direct-route = find-route(ip-layer.routes, destination-address);
+ unless (direct-route)
+ error("No route to host")
+ end;
+ if (instance?(direct-route, <connected-route>))
+ values(direct-route.adapter, destination-address);
+ else
+ let route = find-route(ip-layer.routes, direct-route.next-hop);
+ if (instance?(route, <connected-route>))
+ values(route.adapter, direct-route.next-hop)
+ else
+ error("No direct route to next-hop");
+ end;
+ end;
end;
define open generic ip-protocol (object :: <ip-socket>) => (res :: <integer>);
@@ -231,17 +308,7 @@
payload: payload);
push-data-aux(ip-socket.completer.the-input, ip-socket.completer, frame);
end;
-/*
-define method add-static-route (ip-layer :: <ip-layer>, cidr :: <cidr>, adapter)
-end;
-
-define method find-route (ip-layer :: <ip-layer>, destination-address :: <ipv4-address>)
- => (adapter, next-hop)
-end;
-define method delete-static-route (ip-layer :: <ip-layer>, cidr :: <cidr>)
-end;
-*/
define generic ip-socket (object :: <icmp-handler>) => (res :: <ip-socket>);
define generic ip-socket-setter (value :: <ip-socket>, object :: <icmp-handler>) => (res :: <ip-socket>);
@@ -451,34 +518,37 @@
mac-address: mac-address("00:de:ad:be:ef:00"),
ip-address: ipv4-address("192.168.0.23"));
let ip-layer = make(<ip-layer>);
+ register-route(ip-layer, make(<next-hop-route>, cidr: as(<cidr>, "0.0.0.0/0"), next-hop: ipv4-address("192.168.0.1")));
let ip-over-ethernet = make(<ip-over-ethernet-adapter>,
ethernet: ethernet-layer,
arp: arp-handler,
ip-layer: ip-layer,
- ipv4-address: ipv4-address("192.168.0.24"));
+ ipv4-address: ipv4-address("192.168.0.24"),
+ netmask: 24);
let icmp-handler = make(<icmp-handler>);
let icmp-over-ip = make(<icmp-over-ip-adapter>,
ip-layer: ip-layer,
icmp-handler: icmp-handler);
let thr = make(<thread>, function: curry(toplevel, int));
- send(ip-layer.send-socket,
- ipv4-address("192.168.0.1"),
- make(<ipv4-frame>,
- identification: 23,
- protocol: 1,
- source-address: ipv4-address("192.168.0.24"),
- destination-address: ipv4-address("192.168.0.1"),
- options: make(<stretchy-vector>),
- payload: make(<icmp-frame>,
- type: 8,
- code: 0,
- payload: parse-frame(<raw-frame>, as(<byte-vector>, #(#x23, #x42, #x0, #x0))))));
+ send(icmp-handler.ip-socket,
+ ipv4-address("213.73.91.29"),
+ make(<icmp-frame>,
+ type: 8,
+ code: 0,
+ payload: parse-frame(<raw-frame>, as(<byte-vector>, #(#x23, #x42, #x0, #x0)))));
+ send(icmp-handler.ip-socket,
+ ipv4-address("212.202.174.224"),
+ make(<icmp-frame>,
+ type: 8,
+ code: 0,
+ payload: parse-frame(<raw-frame>, as(<byte-vector>, #(#x23, #x42, #x0, #x0)))));
send(icmp-handler.ip-socket,
ipv4-address("192.168.0.1"),
make(<icmp-frame>,
type: 8,
code: 0,
payload: parse-frame(<raw-frame>, as(<byte-vector>, #(#x23, #x42, #x0, #x0)))));
+
format-out("Mac 192.168.0.1: %=\n", find-mac-address(arp-handler, ipv4-address("192.168.0.1")));
sleep(1200);
end;
Modified: trunk/libraries/layer/layer.hdp
==============================================================================
--- trunk/libraries/layer/layer.hdp (original)
+++ trunk/libraries/layer/layer.hdp Tue Oct 3 22:10:42 2006
@@ -1,4 +1,5 @@
Library: layer
Files: library
module
+ cidr
layer
Modified: trunk/libraries/packetizer/ipv4.dylan
==============================================================================
--- trunk/libraries/packetizer/ipv4.dylan (original)
+++ trunk/libraries/packetizer/ipv4.dylan Tue Oct 3 22:10:42 2006
@@ -99,7 +99,6 @@
define method fixup! (frame :: <unparsed-ipv4-frame>,
#next next-method)
frame.header-checksum := calculate-checksum(frame.packet, frame.header-length * 4);
- break();
next-method();
end;
More information about the chatter
mailing list