[chatter] r11790 - in trunk/libraries: gui-sniffer network/ip-stack/layers/media-access/ethernet network/ip-stack/layers/network network/ip-stack/layers/network/arp network/ip-stack/layers/network/ip network/ip-stack/layers/network/ip-adapter network/ip-stack/layers/network/ip-over-ethernet registry/generic
andreas at mccarthy.opendylan.org
andreas at mccarthy.opendylan.org
Wed Apr 30 01:01:37 CEST 2008
Author: andreas
Date: Wed Apr 30 01:01:35 2008
New Revision: 11790
Added:
trunk/libraries/network/ip-stack/layers/network/
trunk/libraries/network/ip-stack/layers/network/arp/
trunk/libraries/network/ip-stack/layers/network/arp/arp-exports.dylan (contents, props changed)
trunk/libraries/network/ip-stack/layers/network/arp/arp.dylan (contents, props changed)
trunk/libraries/network/ip-stack/layers/network/arp/arp.lid (contents, props changed)
trunk/libraries/network/ip-stack/layers/network/ip/
trunk/libraries/network/ip-stack/layers/network/ip-adapter/
trunk/libraries/network/ip-stack/layers/network/ip-adapter/ip-adapter-exports.dylan (contents, props changed)
trunk/libraries/network/ip-stack/layers/network/ip-adapter/ip-adapter.dylan (contents, props changed)
trunk/libraries/network/ip-stack/layers/network/ip-adapter/ip-adapter.lid (contents, props changed)
trunk/libraries/network/ip-stack/layers/network/ip-over-ethernet/
trunk/libraries/network/ip-stack/layers/network/ip-over-ethernet/ip-over-ethernet-exports.dylan (contents, props changed)
trunk/libraries/network/ip-stack/layers/network/ip-over-ethernet/ip-over-ethernet.dylan (contents, props changed)
trunk/libraries/network/ip-stack/layers/network/ip-over-ethernet/ip-over-ethernet.lid (contents, props changed)
trunk/libraries/network/ip-stack/layers/network/ip/ip-exports.dylan (contents, props changed)
trunk/libraries/network/ip-stack/layers/network/ip/ip.dylan (contents, props changed)
trunk/libraries/network/ip-stack/layers/network/ip/ip.lid (contents, props changed)
trunk/libraries/registry/generic/arp (contents, props changed)
trunk/libraries/registry/generic/ip (contents, props changed)
trunk/libraries/registry/generic/ip-adapter (contents, props changed)
trunk/libraries/registry/generic/ip-over-ethernet (contents, props changed)
Modified:
trunk/libraries/gui-sniffer/library.dylan
trunk/libraries/network/ip-stack/layers/media-access/ethernet/ethernet.dylan
trunk/libraries/network/ip-stack/layers/media-access/ethernet/library.dylan
Log:
job: 7299
Add stubs for ARP and IP implementation using new layer protocol.
Modified: trunk/libraries/gui-sniffer/library.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/library.dylan (original)
+++ trunk/libraries/gui-sniffer/library.dylan Wed Apr 30 01:01:35 2008
@@ -23,6 +23,9 @@
use pcap-live-interface;
use bridge-group;
use ieee802-1q;
- use ethernet;
+ use ethernet, rename: { ethernet => ethernet-layer };
use ppp-over-ethernet;
+ use arp;
+ use ip;
+ use ip-over-ethernet;
end library gui-sniffer;
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 Wed Apr 30 01:01:35 2008
@@ -52,6 +52,7 @@
let frame = ethernet-frame(destination-address: destination, payload: data);
send(socket, frame);
end;
+
define method check-upper-layer? (lower :: <ethernet-layer>, upper :: <layer>) => (allowed? :: <boolean>);
#t;
end;
Modified: trunk/libraries/network/ip-stack/layers/media-access/ethernet/library.dylan
==============================================================================
--- trunk/libraries/network/ip-stack/layers/media-access/ethernet/library.dylan (original)
+++ trunk/libraries/network/ip-stack/layers/media-access/ethernet/library.dylan Wed Apr 30 01:01:35 2008
@@ -7,6 +7,8 @@
use protocols, rename: { ethernet => ethernet-frame };
use flow;
use network-flow;
+
+ export ethernet;
end;
define module ethernet
@@ -17,4 +19,6 @@
use flow;
use network-flow;
use socket;
+
+ export @mac-address;
end;
Added: trunk/libraries/network/ip-stack/layers/network/arp/arp-exports.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/network/ip-stack/layers/network/arp/arp-exports.dylan Wed Apr 30 01:01:35 2008
@@ -0,0 +1,39 @@
+module: dylan-user
+
+
+define library arp
+ use common-dylan;
+ use io;
+ use system;
+ use layer;
+ use packetizer;
+ use protocols, rename: { ethernet => protocols-ethernet };
+ use flow;
+ use network-flow;
+ use timer;
+ use vector-table;
+ use ethernet;
+
+ export arp;
+end library;
+
+define module arp
+ use common-dylan;
+ use threads;
+ use vector-table;
+ use format-out;
+ use new-layer;
+ use ipv4;
+ use cidr;
+ use packetizer;
+ use flow;
+ use network-flow;
+ use socket;
+ use ethernet;
+ use date;
+ use format;
+ use timer;
+ use protocols-ethernet;
+
+ export arp-resolve, $broadcast-ethernet-address;
+end module;
Added: trunk/libraries/network/ip-stack/layers/network/arp/arp.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/network/ip-stack/layers/network/arp/arp.dylan Wed Apr 30 01:01:35 2008
@@ -0,0 +1,215 @@
+module: arp
+synopsis:
+author:
+copyright:
+
+define layer arp (<layer>)
+ system property running-state :: <symbol> = #"down";
+ slot arp-handler :: <arp-handler> = make(<arp-handler>);
+end;
+
+define method check-upper-layer? (lower :: <arp-layer>, upper :: <layer>) => (allowed? :: <boolean>);
+ #f;
+end;
+
+define method check-lower-layer? (upper :: <arp-layer>, lower :: <layer>) => (allowed? :: <boolean>);
+ upper. at running-state == #"down" &
+ check-socket-arguments?(lower, type: <arp-frame>);
+end;
+
+define method register-lower-layer (upper :: <arp-layer>, lower :: <layer>)
+ let socket = create-socket(lower, filter-string: "arp");
+ upper.arp-handler.send-socket := socket;
+ connect(socket, upper.arp-handler);
+ 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-handler.arp-table))
+ cancel(arp-entry.timer);
+ remove!(upper.arp-handler.arp-table, arp-entry);
+ end;
+ upper. at running-state := #"down";
+end;
+
+
+define class <arp-handler> (<filter>)
+ constant slot arp-table :: <vector-table> = make(<vector-table>);
+ constant slot table-lock :: <lock> = make(<lock>);
+ slot send-socket :: <socket>;
+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>) => ();
+ if (arp. at running-state == #"down")
+ error("arp layer down!");
+ end;
+ let arp-entry = element(arp.arp-handler.arp-table, destination, default: #f);
+ if (instance?(arp-entry, <known-arp-entry>))
+ clos(arp-entry.arp-mac-address);
+ else
+ let arp-handler = arp.arp-handler;
+ with-lock(arp-handler.table-lock)
+ if (arp-entry)
+ arp-entry.outstanding-closures := add!(arp-entry.outstanding-closures, clos);
+ else
+ let from-addr = arp.lower-layers[0]. at mac-address;
+ let from-ip = find-key(arp-handler.arp-table,
+ method(x)
+ instance?(x, <known-arp-entry>) &
+ (x.arp-mac-address = from-addr)
+ end);
+ let arp-request = make(<arp-frame>,
+ operation: #"arp-request",
+ source-mac-address: from-addr,
+ source-ip-address: from-ip,
+ target-ip-address: destination,
+ target-mac-address: mac-address("00:00:00:00:00:00"));
+ sendto(arp-handler.send-socket, $broadcast-ethernet-address, arp-request);
+ let outstanding-request = make(<outstanding-arp-request>,
+ handler: arp-handler,
+ request: arp-request,
+ destination: $broadcast-ethernet-address,
+ ip-address: destination,
+ outstanding-closures: list(clos));
+ let timer* = make(<timer>, in: 5, event: curry(try-again, outstanding-request, arp-handler));
+ outstanding-request.timer := timer*;
+ arp-handler.arp-table[destination] := outstanding-request;
+ arp-entry := outstanding-request;
+ end;
+ end;
+ end;
+end;
+
+define abstract class <arp-entry> (<object>)
+ constant slot ip-address :: <ipv4-address>, required-init-keyword: ip-address:;
+end;
+
+define class <outstanding-arp-request> (<arp-entry>)
+ constant slot original-request :: <frame>, required-init-keyword: request:;
+ constant slot destination :: <mac-address>, required-init-keyword: destination:;
+ slot timer :: <timer>;
+ slot counter = 0;
+ slot outstanding-closures :: <list>, required-init-keyword: outstanding-closures:;
+end;
+
+define abstract class <known-arp-entry> (<arp-entry>)
+ constant slot arp-mac-address :: <mac-address>, required-init-keyword: mac-address:;
+end;
+
+define class <static-arp-entry> (<known-arp-entry>)
+end;
+
+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 class <dynamic-arp-entry> (<known-arp-entry>)
+ constant slot arp-timestamp :: <date> = current-date()
+end;
+
+define method try-again (request :: <outstanding-arp-request>, handler :: <arp-handler>)
+ with-lock(handler.table-lock)
+ if (request.counter > 3)
+ remove-key!(handler.arp-table, request.ip-address);
+ else
+ sendto(handler.send-socket, request.destination, request.original-request);
+ request.timer := make(<timer>, in: 5, event: curry(try-again, request, handler));
+ request.counter := request.counter + 1;
+ end
+ end
+end;
+
+define method push-data-aux (input :: <push-input>,
+ node :: <arp-handler>,
+ frame :: <container-frame>)
+ if (frame.operation = #"arp-request"
+ & frame.target-mac-address = mac-address("00:00:00:00:00:00"))
+ let arp-entry = element(node.arp-table, frame.target-ip-address, default: #f);
+ if (arp-entry & instance?(arp-entry, <advertised-arp-entry>))
+ let arp-response = make(<arp-frame>,
+ operation: #"arp-response",
+ target-mac-address: frame.source-mac-address,
+ target-ip-address: frame.source-ip-address,
+ source-mac-address: arp-entry.arp-mac-address,
+ source-ip-address: arp-entry.ip-address);
+ sendto(node.send-socket, frame.source-mac-address, arp-response);
+ end;
+ elseif (frame.operation = #"arp-response")
+ with-lock(node.table-lock)
+ 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);
+ end;
+ maybe-add-response-to-table(old-entry, node, frame);
+ end
+ end;
+end;
+
+define method add-response-to-table (node :: <arp-handler>, frame :: <arp-frame>)
+ node.arp-table[frame.source-ip-address]
+ := make(<dynamic-arp-entry>,
+ ip-address: frame.source-ip-address,
+ mac-address: frame.source-mac-address);
+end;
+
+define method maybe-add-response-to-table
+ (old-entry == #f, node :: <arp-handler>, frame :: <arp-frame>)
+end;
+
+define method maybe-add-response-to-table
+ (old-entry :: <outstanding-arp-request>, node :: <arp-handler>, frame :: <arp-frame>)
+ add-response-to-table(node, frame);
+end;
+
+define method maybe-add-response-to-table
+ (old-entry :: <static-arp-entry>, node :: <arp-handler>, frame :: <arp-frame>)
+ ignore(old-entry, node, frame);
+end;
+
+define method maybe-add-response-to-table
+ (old-entry :: <dynamic-arp-entry>, node :: <arp-handler>, frame :: <arp-frame>)
+ if (frame.source-mac-address ~= old-entry.arp-mac-address)
+ format-out("ARP: IP %= moved from %= to %=\n",
+ old-entry.ip-address,
+ old-entry.arp-mac-address,
+ frame.source-mac-address);
+ end;
+ add-response-to-table(node, frame)
+end;
+
+define function send-gratitious-arp (arp-handler :: <arp-handler>, ip :: <ipv4-address>)
+ let arp-entry = element(arp-handler.arp-table, ip, default: #f);
+ if (arp-entry)
+ let arp-frame = make(<arp-frame>,
+ operation: #"arp-request",
+ source-mac-address: arp-entry.arp-mac-address,
+ source-ip-address: arp-entry.ip-address,
+ target-mac-address: mac-address("00:00:00:00:00:00"),
+ target-ip-address: arp-entry.ip-address);
+ sendto(arp-handler.send-socket, $broadcast-ethernet-address, arp-frame);
+ end;
+end;
Added: trunk/libraries/network/ip-stack/layers/network/arp/arp.lid
==============================================================================
--- (empty file)
+++ trunk/libraries/network/ip-stack/layers/network/arp/arp.lid Wed Apr 30 01:01:35 2008
@@ -0,0 +1,4 @@
+library: arp
+executable: arp
+files: arp-exports
+ arp
Added: trunk/libraries/network/ip-stack/layers/network/ip-adapter/ip-adapter-exports.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/network/ip-stack/layers/network/ip-adapter/ip-adapter-exports.dylan Wed Apr 30 01:01:35 2008
@@ -0,0 +1,30 @@
+module: dylan-user
+
+define library ip-adapter
+ use common-dylan;
+ use io;
+ use layer;
+ use packetizer;
+ use protocols;
+ use flow;
+ use network-flow;
+
+ export ip-adapter;
+end library;
+
+define module ip-adapter
+ use common-dylan;
+ use format-out;
+ use new-layer;
+ use ipv4;
+ use cidr;
+ use packetizer;
+ use flow;
+ use network-flow;
+ use socket;
+
+ export <ip-adapter-layer>,
+ @ip-address, @ip-address-setter,
+ @mtu, @mtu-setter,
+ @running-state, @running-state-setter;
+end module;
Added: trunk/libraries/network/ip-stack/layers/network/ip-adapter/ip-adapter.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/network/ip-stack/layers/network/ip-adapter/ip-adapter.dylan Wed Apr 30 01:01:35 2008
@@ -0,0 +1,17 @@
+module: ip-adapter
+synopsis:
+author:
+copyright:
+
+define open layer ip-adapter (<layer>)
+ property administrative-state :: <symbol> = #"up";
+ system property running-state :: <symbol> = #"down";
+ property ip-address :: <cidr>;
+ property mtu :: <integer> = 1524;
+end;
+
+define method read-as (type == <cidr>, value :: <string>) => (res)
+ as(<cidr>, value);
+end;
+
+
Added: trunk/libraries/network/ip-stack/layers/network/ip-adapter/ip-adapter.lid
==============================================================================
--- (empty file)
+++ trunk/libraries/network/ip-stack/layers/network/ip-adapter/ip-adapter.lid Wed Apr 30 01:01:35 2008
@@ -0,0 +1,4 @@
+library: ip-adapter
+executable: ip-adapter
+files: ip-adapter-exports
+ ip-adapter
Added: trunk/libraries/network/ip-stack/layers/network/ip-over-ethernet/ip-over-ethernet-exports.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/network/ip-stack/layers/network/ip-over-ethernet/ip-over-ethernet-exports.dylan Wed Apr 30 01:01:35 2008
@@ -0,0 +1,28 @@
+module: dylan-user
+
+define library ip-over-ethernet
+ use common-dylan;
+ use io;
+ use layer;
+ use packetizer;
+ use protocols;
+ use flow;
+ use network-flow;
+ use ip-adapter;
+ use arp;
+end library;
+
+define module ip-over-ethernet
+ use common-dylan;
+ use format-out;
+ use new-layer;
+ use ipv4;
+ use cidr;
+ use packetizer;
+ use flow;
+ use network-flow;
+ use socket;
+ use ip-adapter;
+ use ethernet;
+ use arp;
+end module;
Added: trunk/libraries/network/ip-stack/layers/network/ip-over-ethernet/ip-over-ethernet.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/network/ip-stack/layers/network/ip-over-ethernet/ip-over-ethernet.dylan Wed Apr 30 01:01:35 2008
@@ -0,0 +1,64 @@
+module: ip-over-ethernet
+synopsis:
+author:
+copyright:
+
+define layer ip-over-ethernet (<ip-adapter-layer>)
+ property arp-handler :: <layer>;
+end;
+
+define method check-upper-layer? (lower :: <ip-over-ethernet-layer>, upper :: <layer>) => (allowed? :: <boolean>);
+ #t;
+end;
+
+define method check-lower-layer? (upper :: <ip-over-ethernet-layer>, lower :: <layer>) => (allowed? :: <boolean>);
+ upper. at running-state == #"down" &
+ check-socket-arguments?(lower, type: <ipv4-frame>);
+end;
+
+define method register-lower-layer (upper :: <ip-over-ethernet-layer>, lower :: <layer>)
+ upper. at running-state := #"up";
+end;
+
+define method deregister-lower-layer (upper :: <ip-over-ethernet-layer>, lower :: <layer>)
+ do(close-socket, upper.sockets);
+ upper. at running-state := #"down";
+end;
+
+define class <ip-over-ethernet-socket> (<socket>)
+ constant slot lower-socket :: <socket>, required-init-keyword: lower-socket:;
+end;
+
+define method create-socket (layer :: <ip-over-ethernet-layer>, #key type, #all-keys)
+ => (res :: <ip-over-ethernet-socket>)
+ unless(layer. at running-state == #"up")
+ error("Layer down");
+ end;
+ let filter = "ipv4";
+ let socket = create-socket(layer.lower-layers[0], filter-string: filter);
+ let res = make(<ip-over-ethernet-socket>, owner: layer, lower-socket: socket);
+end;
+
+define method socket-input (socket :: <ip-over-ethernet-socket>) => (res :: <input>)
+ socket.lower-socket.socket-input
+end;
+define method socket-output (socket :: <ip-over-ethernet-socket>) => (res :: <output>)
+ socket.lower-socket.socket-output;
+end;
+
+define method close-socket (socket :: <ip-over-ethernet-socket>)
+ next-method();
+ close-socket(socket.lower-socket);
+end;
+
+define method sendto (socket :: <ip-over-ethernet-socket>, destination :: <ipv4-address>, data);
+ if (destination = broadcast-address(socket.socket-owner. at ip-address))
+ sendto(socket.lower-socket, $broadcast-ethernet-address, data)
+ else
+ arp-resolve(socket.socket-owner. at arp-handler, destination,
+ method(x) sendto(socket.lower-socket, x, data) end)
+ end
+end;
+
+
+
Added: trunk/libraries/network/ip-stack/layers/network/ip-over-ethernet/ip-over-ethernet.lid
==============================================================================
--- (empty file)
+++ trunk/libraries/network/ip-stack/layers/network/ip-over-ethernet/ip-over-ethernet.lid Wed Apr 30 01:01:35 2008
@@ -0,0 +1,4 @@
+library: ip-over-ethernet
+executable: ip-over-ethernet
+files: ip-over-ethernet-exports
+ ip-over-ethernet
Added: trunk/libraries/network/ip-stack/layers/network/ip/ip-exports.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/network/ip-stack/layers/network/ip/ip-exports.dylan Wed Apr 30 01:01:35 2008
@@ -0,0 +1,26 @@
+module: dylan-user
+
+define library ip
+ use common-dylan;
+ use io;
+ use layer;
+ use packetizer;
+ use protocols;
+ use flow;
+ use network-flow;
+ use ip-adapter;
+end library;
+
+define module ip
+ use common-dylan;
+ use format-out;
+ use new-layer;
+ use ipv4;
+ use packetizer;
+ use flow;
+ use network-flow;
+ use socket;
+ use cidr;
+ use ip-adapter;
+ use format;
+end module;
Added: trunk/libraries/network/ip-stack/layers/network/ip/ip.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/network/ip-stack/layers/network/ip/ip.dylan Wed Apr 30 01:01:35 2008
@@ -0,0 +1,108 @@
+module: ip
+synopsis:
+author:
+copyright:
+
+define layer ip (<layer>)
+ property administrative-state :: <symbol> = #"up";
+ slot routes = make(<stretchy-vector>);
+ slot fan-in = make(<fan-in>);
+end;
+
+define method initialize-layer (layer :: <ip-layer>, #key, #all-keys) => ()
+ let cls = make(<closure-node>,
+ closure: method(x)
+ let (socket, next-hop)
+ = find-forwarding-socket(layer, x.destination-address);
+ sendto(socket, next-hop, x);
+ end);
+ connect(layer.fan-in, cls);
+end;
+
+define method check-upper-layer? (lower :: <ip-layer>, upper :: <layer>) => (allowed? :: <boolean>);
+ #t;
+end;
+
+define method check-lower-layer? (upper :: <ip-layer>, lower :: <layer>) => (allowed? :: <boolean>);
+ instance?(lower, <ip-adapter-layer>) & check-socket-arguments?(lower, type: <ipv4-frame>);
+end;
+
+define method register-lower-layer (upper :: <ip-layer>, lower :: <ip-adapter-layer>)
+ let socket = create-socket(lower, type: <ipv4-frame>);
+ let route = make(<connected-route>,
+ cidr: lower. at ip-address,
+ socket: socket);
+ register-route(upper, route);
+ connect(socket, upper.fan-in);
+end;
+
+define method deregister-lower-layer (upper :: <ip-layer>, lower :: <ip-adapter-layer>)
+ delete-route(upper, lower. at ip-address);
+ close-socket(lower.sockets[0]);
+end;
+
+//XXX: probably should use radix trees
+//http://www.matasano.com/log/1009/aguri-coolest-data-structure-youve-never-heard-of/
+define class <route> (<object>)
+ constant slot cidr :: <cidr>, required-init-keyword: cidr:;
+end;
+
+define class <next-hop-route> (<route>)
+ 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 class <connected-route> (<route>)
+ constant slot socket :: <socket>, required-init-keyword: socket:;
+end;
+
+define method print-object (object :: <connected-route>, stream :: <stream>) => ()
+ format(stream, "%= -> %=", object.cidr, object.socket.socket-owner);
+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)
+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 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-forwarding-socket (ip-layer :: <ip-layer>, destination-address :: <ipv4-address>)
+ => (res :: <socket>, 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.socket, destination-address);
+ else
+ let route = find-route(ip-layer.routes, direct-route.next-hop);
+ if (instance?(route, <connected-route>))
+ values(route.socket, direct-route.next-hop)
+ else
+ error("No direct route to next-hop");
+ end;
+ end;
+end;
Added: trunk/libraries/network/ip-stack/layers/network/ip/ip.lid
==============================================================================
--- (empty file)
+++ trunk/libraries/network/ip-stack/layers/network/ip/ip.lid Wed Apr 30 01:01:35 2008
@@ -0,0 +1,4 @@
+library: ip
+executable: ip
+files: ip-exports
+ ip
Added: trunk/libraries/registry/generic/arp
==============================================================================
--- (empty file)
+++ trunk/libraries/registry/generic/arp Wed Apr 30 01:01:35 2008
@@ -0,0 +1 @@
+abstract://dylan/network/ip-stack/layers/network/arp/arp.lid
Added: trunk/libraries/registry/generic/ip
==============================================================================
--- (empty file)
+++ trunk/libraries/registry/generic/ip Wed Apr 30 01:01:35 2008
@@ -0,0 +1 @@
+abstract://dylan/network/ip-stack/layers/network/ip/ip.lid
Added: trunk/libraries/registry/generic/ip-adapter
==============================================================================
--- (empty file)
+++ trunk/libraries/registry/generic/ip-adapter Wed Apr 30 01:01:35 2008
@@ -0,0 +1 @@
+abstract://dylan/network/ip-stack/layers/network/ip-adapter/ip-adapter.lid
Added: trunk/libraries/registry/generic/ip-over-ethernet
==============================================================================
--- (empty file)
+++ trunk/libraries/registry/generic/ip-over-ethernet Wed Apr 30 01:01:35 2008
@@ -0,0 +1 @@
+abstract://dylan/network/ip-stack/layers/network/ip-over-ethernet/ip-over-ethernet.lid
More information about the chatter
mailing list