[Gd-chatter] r10925 - in trunk/libraries: layer packetizer pcap tcp
hannes at gwydiondylan.org
hannes at gwydiondylan.org
Sun Oct 8 02:47:40 CEST 2006
Author: hannes
Date: Sun Oct 8 02:47:37 2006
New Revision: 10925
Modified:
trunk/libraries/layer/layer.dylan
trunk/libraries/layer/module.dylan
trunk/libraries/layer/tcp.dylan
trunk/libraries/packetizer/ipv4.dylan
trunk/libraries/pcap/pcap.dylan
trunk/libraries/tcp/library.dylan
trunk/libraries/tcp/module.dylan
trunk/libraries/tcp/tcp.dylan
Log:
Bug: 7299
*some more tcp-stuff...
timeouts and retransmissions are not done yet
Modified: trunk/libraries/layer/layer.dylan
==============================================================================
--- trunk/libraries/layer/layer.dylan (original)
+++ trunk/libraries/layer/layer.dylan Sun Oct 8 02:47:37 2006
@@ -150,7 +150,7 @@
send(socket.ip-send-socket, arp-entry.arp-mac-address, payload);
else
let arp-handler = socket.arp-handler;
- with-lock(arp-handler.lock)
+ with-lock(arp-handler.table-lock)
if (arp-entry)
arp-entry.outstanding-packets := add!(arp-entry.outstanding-packets, payload);
else
@@ -374,11 +374,10 @@
end;
define generic arp-table (object :: <arp-handler>) => (res :: <vector-table>);
-define open generic lock (object) => (res :: <lock>);
-
+define generic table-lock (object :: <arp-handler>) => (res :: <lock>);
define class <arp-handler> (<filter>)
constant slot arp-table :: <vector-table> = make(<vector-table>);
- constant slot lock :: <lock> = make(<lock>);
+ constant slot table-lock :: <lock> = make(<lock>);
slot send-socket :: <socket>;
slot ip-send-socket :: <ethernet-socket>;
end;
@@ -421,7 +420,7 @@
end;
define method try-again (request :: <outstanding-arp-request>, handler :: <arp-handler>)
- with-lock(handler.lock)
+ with-lock(handler.table-lock)
if (request.counter > 3)
remove-key!(handler.arp-table, request.ip-address);
else
@@ -435,7 +434,6 @@
define method push-data-aux (input :: <push-input>,
node :: <arp-handler>,
frame :: <container-frame>)
- format-out("received arp frame %=\n", frame);
if (frame.operation = 1
& 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);
@@ -449,7 +447,7 @@
send(node.send-socket, frame.source-mac-address, arp-response);
end;
elseif (frame.operation = 2)
- with-lock(node.lock)
+ 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);
@@ -495,7 +493,7 @@
define function init-ethernet ()
- let int = make(<ethernet-interface>, name: "em0");
+ let int = make(<ethernet-interface>, name: "Intel");
let ethernet-layer = make(<ethernet-layer>, ethernet-interface: int);
let arp-handler = make(<arp-handler>);
arp-handler.arp-table[ipv4-address("192.168.0.23")]
@@ -503,12 +501,13 @@
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("23.23.23.1")));
+ 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("23.23.23.220"),
+ 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>,
Modified: trunk/libraries/layer/module.dylan
==============================================================================
--- trunk/libraries/layer/module.dylan (original)
+++ trunk/libraries/layer/module.dylan Sun Oct 8 02:47:37 2006
@@ -18,6 +18,7 @@
use date, import: {<date>, current-date };
use tcp;
use simple-random;
+ use streams;
// Add binding exports here.
Modified: trunk/libraries/layer/tcp.dylan
==============================================================================
--- trunk/libraries/layer/tcp.dylan (original)
+++ trunk/libraries/layer/tcp.dylan Sun Oct 8 02:47:37 2006
@@ -1,6 +1,9 @@
module: layer
define open generic connection-tracking (l :: <tcp-layer>) => (res :: <vector-table>);
+define open generic notification (t) => (res :: <notification>);
+define open generic notification-setter (value :: <notification>, t) => (res :: <notification>);
+
define class <tcp-layer> (<layer>)
constant slot ip-layer :: <ip-layer>, required-init-keyword: ip-layer:;
@@ -25,7 +28,8 @@
assemble-frame-as(<2byte-big-endian-unsigned-integer>, destination-port));
end;
define method initialize (layer :: <tcp-layer>,
- #rest rest, #key, #all-keys)
+ #next next-method, #rest rest, #key, #all-keys)
+ next-method();
let socket = create-socket(layer.ip-layer, 6);
let cls-node = make(<closure-node>,
closure: method(x)
@@ -37,24 +41,40 @@
let socket = find-listener-socket(layer.sockets, x.destination-port);
if (socket)
let connection = make(<tcp-connection>,
- socket: layer.ip-send-socket,
- acknowledgment-number: $transform-from-bv(x.sequence-number),
- source-port: x.source-port,
- destination-port: x.destination-port,
- source-address: x.parent.source-address,
- destination-address: x.parent.destination-address);
+ tcp-layer: layer,
+ acknowledgement-number: $transform-from-bv(x.sequence-number),
+ source-port: x.destination-port,
+ destination-port: x.source-port,
+ source-address: x.parent.destination-address,
+ destination-address: x.parent.source-address);
layer.connection-tracking[id] := connection;
passive-open(connection);
- with-lock (socket.lock)
- add!(socket.connections, connection);
+ with-lock (socket.listener-lock)
+ push-last(socket.connections, connection);
+ release(socket.notification);
end;
process-data(connection, x);
else
- format-out("Got a SYN to port %d, but found no listener, may send a RST\n",
- x.destination-port);
+ let ack = $transform-from-bv(x.sequence-number);
+ send(layer.ip-send-socket,
+ x.parent.source-address,
+ make(<tcp-frame>,
+ source-port: x.destination-port,
+ destination-port: x.source-port,
+ ack: 1, rst: 1,
+ acknowledgement-number: $transform-to-bv(ack + 1),
+ sequence-number: $transform-to-bv(0.0s0)));
end;
else
- format-out("Packet for unknown connection received\n");
+ let ack = $transform-from-bv(x.sequence-number);
+ send(layer.ip-send-socket,
+ x.parent.source-address,
+ make(<tcp-frame>,
+ source-port: x.destination-port,
+ destination-port: x.source-port,
+ ack: 1, rst: 1,
+ acknowledgement-number: $transform-to-bv(ack + 1),
+ sequence-number: $transform-to-bv(0.0s0)));
end;
end);
@@ -66,25 +86,40 @@
define generic receive-buffer (c :: <tcp-connection>) => (res);
define generic tcp-sequence-number (c :: <tcp-connection>) => (res :: <float>);
define generic tcp-sequence-number-setter (value :: <float>, c :: <tcp-connection>) => (res :: <float>);
-define generic tcp-acknowledgement-number (c :: <tcp-connection>) => (res :: <float>);
-define generic tcp-acknowledgement-number-setter (value :: <float>, c :: <tcp-connection>) => (res :: <float>);
+define generic tcp-acknowledgement-number (c :: <tcp-connection>) => (res :: false-or(<float>));
+define generic tcp-acknowledgement-number-setter (value :: false-or(<float>), c :: <tcp-connection>) => (res :: false-or(<float>));
define generic tcp-window-size (c :: <tcp-connection>) => (res :: <integer>);
define generic tcp-window-size-setter (value :: <integer>, c :: <tcp-connection>) => (res :: <integer>);
define generic tcp-source-port (c :: <tcp-connection>) => (res :: <integer>);
define generic tcp-destination-port (c :: <tcp-connection>) => (res :: <integer>);
define generic tcp-source-address (c :: <tcp-connection>) => (res :: <ipv4-address>);
define generic tcp-destination-address (c :: <tcp-connection>) => (res :: <ipv4-address>);
-define class <tcp-connection> (<filter>, <tcp-dingens>);
+define generic tcp-layer (c :: <tcp-connection>) => (res :: <tcp-layer>);
+define generic last-received-packet (c :: <tcp-connection>) => (res :: <tcp-frame>);
+define generic last-received-packet-setter (value :: <tcp-frame>, c :: <tcp-connection>) => (res :: <tcp-frame>);
+define generic established-notification (c :: <tcp-connection>) => (res :: <notification>);
+define generic established-notification-setter (value :: <notification>, c :: <tcp-connection>) => (res :: <notification>);
+define class <tcp-connection> (<tcp-dingens>, <stream>);
constant slot send-buffer = make(<deque>);
constant slot receive-buffer = make(<deque>);
- slot send-socket :: <socket>, required-init-keyword: socket:;
+ constant slot tcp-layer :: <tcp-layer>, required-init-keyword: tcp-layer:;
slot tcp-sequence-number :: <float> = as(<float>, random(2 ^ 16)), init-keyword: sequence-number:;
- slot tcp-acknowledgement-number :: <float> = 0.0s0, init-keyword: acknowledgement-number:;
+ slot tcp-acknowledgement-number :: false-or(<float>) = #f, init-keyword: acknowledgement-number:;
slot tcp-window-size :: <integer> = 1500, init-keyword: window-size:;
constant slot tcp-source-port :: <integer>, required-init-keyword: source-port:;
constant slot tcp-destination-port :: <integer>, required-init-keyword: destination-port:;
constant slot tcp-source-address :: <ipv4-address>, required-init-keyword: source-address:;
constant slot tcp-destination-address :: <ipv4-address>, required-init-keyword: destination-address:;
+ slot last-received-packet :: <tcp-frame>;
+ slot notification :: <notification>;
+ slot established-notification :: <notification>;
+end;
+
+define method initialize (tcp-connection :: <tcp-connection>,
+ #next next-method, #rest rest, #key, #all-keys)
+ next-method();
+ tcp-connection.notification := make(<notification>, lock: tcp-connection.lock);
+ tcp-connection.established-notification := make(<notification>, lock: tcp-connection.lock);
end;
define method generate-id (tcp :: <tcp-connection>) => (res :: <vector>)
@@ -97,7 +132,7 @@
define method send-via-tcp (conn :: <tcp-connection>,
#key ack, fin, rst, syn, urg, psh, data)
let payload = make(<stretchy-byte-vector-subsequence>);
- if (data & instance?(conn.state, <established>))
+ if (data & instance?(conn.state, type-union(<close-wait>, <established>)))
for (i from 0 below min(conn.tcp-window-size, data.size))
payload[i] := data[i];
end;
@@ -106,185 +141,299 @@
source-port: conn.tcp-source-port,
destination-port: conn.tcp-destination-port,
sequence-number: $transform-to-bv(conn.tcp-sequence-number),
- acknowledgement-number: $transform-to-bv(if (ack) conn.tcp-acknowledgement-number else 0.0s0 end),
+ acknowledgement-number: $transform-to-bv(if (ack) conn.tcp-acknowledgement-number else 0.0d0 end),
urg: if (urg) 1 else 0 end,
ack: if (ack) 1 else 0 end,
psh: if (psh) 1 else 0 end,
rst: if (rst) 1 else 0 end,
syn: if (syn) 1 else 0 end,
fin: if (fin) 1 else 0 end,
- window: 1500 - conn.receive-buffer.size,
- payload: make(<raw-frame>, data: payload),
- options-and-padding: make(<raw-frame>, data: make(<stretchy-byte-vector-subsequence>)));
+ window: 65535 - conn.receive-buffer.size,
+ payload: make(<raw-frame>, data: payload));
if (syn | fin)
conn.tcp-sequence-number := conn.tcp-sequence-number + 1;
end;
if (data)
conn.tcp-sequence-number := conn.tcp-sequence-number + payload.size;
end;
- send(conn.send-socket, conn.tcp-destination-address, tcp-frame);
+ send(conn.tcp-layer.ip-send-socket, conn.tcp-destination-address, tcp-frame);
end;
-define method read-element (tcp-connection :: <tcp-connection>) => (res :: false-or(<byte>))
- if (tcp-connection.receive-buffer.size > 0)
- pop(tcp-connection.receive-buffer)
+define method read-element (tcp-connection :: <tcp-connection>, #key on-end-of-stream = $unsupplied)
+ => (res)
+ with-lock (tcp-connection.lock)
+ block(ret)
+ while (~ stream-input-available?(tcp-connection))
+ if (instance?(tcp-connection.state, type-union(<close-wait>, <last-ack>, <closing>, <time-wait>, <closed>)))
+ if (on-end-of-stream = $unsupplied)
+ signal(make(<end-of-stream-error>, stream: tcp-connection));
+ else
+ ret(on-end-of-stream)
+ end;
+ else
+ wait-for(tcp-connection.notification);
+ end;
+ end;
+ pop(tcp-connection.receive-buffer)
+ end;
end;
end;
-define method read (tcp-connection :: <tcp-connection>) => (res :: <collection>)
+define method stream-input-available? (tcp :: <tcp-connection>) => (res :: <boolean>)
+ tcp.receive-buffer.size > 0;
+end;
+define method read (tcp-connection :: <tcp-connection>, n :: <integer>, #key on-end-of-stream = $unsupplied) => (res)
let res = make(<stretchy-vector>);
block(ret)
- while(#t)
- let ele = read-element(tcp-connection);
+ for (i from 0 below n)
+ let ele = read-element(tcp-connection, on-end-of-stream: #f);
if (ele)
res := add!(res, ele);
+ elseif (on-end-of-stream = $unsupplied)
+ signal(make(<incomplete-read-error>, stream: tcp-connection, sequence: res, count: n))
else
- ret();
+ ret(on-end-of-stream)
end;
end;
+ res;
end;
- res;
end;
-define method write-element (tcp-connection :: <tcp-connection>, data :: <byte>)
- push-last(tcp-connection.send-buffer, data);
+define method write-element (tcp-connection :: <tcp-connection>, data :: <byte>) => ()
+ with-lock (tcp-connection.lock)
+ if (instance?(tcp-connection.state, type-union(<established>, <close-wait>)))
+ push-last(tcp-connection.send-buffer, data);
+ else
+ error("Stream closed for writing")
+ end;
+ end;
end;
-define method write-element (tcp-connection :: <tcp-connection>, data :: <character>)
+define method write-element (tcp-connection :: <tcp-connection>, data :: <character>) => ()
write-element(tcp-connection, as(<byte>, data));
end;
-define method write (tcp-connection :: <tcp-connection>, data :: <string>)
+define method write (tcp-connection :: <tcp-connection>, data :: <string>, #key start, end: last) => ()
write(tcp-connection, map-as(<vector>, curry(as, <byte>), data));
end;
-define method write (tcp-connection :: <tcp-connection>, data :: <sequence>)
+define method write (tcp-connection :: <tcp-connection>, data :: <sequence>, #key start, end: last) => ()
do(curry(write-element, tcp-connection), data);
- send-via-tcp(tcp-connection, data: data, ack: #t);
+ with-lock (tcp-connection.lock)
+ send-via-tcp(tcp-connection, data: data, ack: #t);
+ end;
end;
define method process-data (connection :: <tcp-connection>, packet :: <tcp-frame>)
- if ((connection.tcp-acknowledgement-number = 0) | ($transform-from-bv(packet.sequence-number) = connection.tcp-acknowledgement-number))
- if (packet.syn = 1)
- connection.tcp-acknowledgement-number := $transform-from-bv(packet.sequence-number) + 1;
- if (packet.ack = 1)
- syn-ack-received(connection);
- else
- syn-received(connection);
- end;
- elseif (packet.fin = 1)
- connection.tcp-acknowledgement-number := connection.tcp-acknowledgement-number + 1;
- if (packet.ack = 1)
- fin-ack-received(connection);
+ with-lock (connection.lock)
+ if ((~ connection.tcp-acknowledgement-number)
+ | ($transform-from-bv(packet.sequence-number) = connection.tcp-acknowledgement-number))
+ let last-ack = (connection.tcp-sequence-number = $transform-from-bv(packet.acknowledgement-number));
+ let event =
+ case
+ (packet.rst = 1) => #"rst-received";
+ ((packet.ack = 1) & (packet.syn = 0) & (packet.fin = 0) & (~ last-ack)) => #"ack-received";
+ ((packet.ack = 1) & (packet.syn = 0) & (packet.fin = 0) & last-ack) => #"last-ack-received";
+ ((packet.ack = 1) & (packet.syn = 0) & (packet.fin = 1) & last-ack) => #"fin-ack-received";
+ ((packet.ack = 1) & (packet.syn = 1) & (packet.fin = 0)) => #"syn-ack-received";
+ ((packet.ack = 0) & (packet.syn = 1) & (packet.fin = 0)) => #"syn-received";
+ ((packet.syn = 0) & (packet.fin = 1)) => #"fin-received";
+ otherwise => #f;
+ end;
+ if (event)
+ connection.last-received-packet := packet;
+ process-event(connection, event);
else
- fin-received(connection);
+ format-out("Unknown flag combination\n")
end;
- elseif (packet.ack = 1)
- connection.tcp-window-size := packet.window;
- for (i from connection.tcp-sequence-number - connection.send-buffer.size below $transform-from-bv(packet.acknowledgement-number))
- pop(connection.send-buffer);
- end;
- ack-received(connection);
- elseif (packet.rst = 1)
- rst-received(connection);
- else
- format-out("Unknown flag combination\n");
end;
- if (instance?(connection.state, <established>))
- do(curry(push-last, connection.receive-buffer), packet.payload.data);
- connection.tcp-acknowledgement-number
- := connection.tcp-acknowledgement-number + byte-offset(frame-size(packet.payload));
- send-via-tcp(connection, ack: #t);
+ end;
+end;
+
+define macro transition-definer
+ {
+ define transition (?old:expression => ?new:name)
+ ?:body
+ end
+ } => {
+ define method state-transition (?=tcp-connection :: <tcp-connection>,
+ ?=old-state :: ?old,
+ ?=new-state :: ?new,
+ #next next-method) => ();
+ let ?=send = curry(send-via-tcp, ?=tcp-connection);
+ ?body;
+ next-method();
+ end
+ }
+end;
+
+define transition (<tcp-state> => <established>)
+ release(tcp-connection.established-notification)
+end;
+
+define transition (<established> => <established>)
+ let packet = tcp-connection.last-received-packet;
+ let acknowledge = $transform-from-bv(packet.acknowledgement-number);
+ if (tcp-connection.tcp-sequence-number <= acknowledge)
+ tcp-connection.tcp-window-size := tcp-connection.last-received-packet.window;
+ for (i from tcp-connection.tcp-sequence-number - tcp-connection.send-buffer.size below acknowledge)
+ pop(tcp-connection.send-buffer);
+ end;
+ if (frame-size(packet.payload) > 0)
+ receive-data(tcp-connection);
+ send(ack: #t);
end;
end;
end;
-define method syn-received (tcp-connection :: <tcp-connection>) => (res :: <tcp-state>)
- let new-state = syn-received(tcp-connection.state);
- if (new-state ~= tcp-connection.state)
- send-via-tcp(tcp-connection, syn: #t, ack: #t);
- tcp-connection.state := new-state;
+define inline function receive-data (tcp-connection :: <tcp-connection>)
+ let packet = tcp-connection.last-received-packet;
+ do(curry(push-last, tcp-connection.receive-buffer), packet.payload.data);
+ tcp-connection.tcp-acknowledgement-number
+ := tcp-connection.tcp-acknowledgement-number + byte-offset(frame-size(packet.payload));
+ release(tcp-connection.notification);
+end;
+define transition (<listen> => <syn-received>)
+ tcp-connection.tcp-acknowledgement-number
+ := $transform-from-bv(tcp-connection.last-received-packet.sequence-number) + 1;
+ send(syn: #t, ack: #t)
+end;
+
+define transition (<syn-sent> => <established>)
+ tcp-connection.tcp-acknowledgement-number
+ := $transform-from-bv(tcp-connection.last-received-packet.sequence-number) + 1;
+ send(ack: #t)
+end;
+
+define transition (<syn-sent> => <syn-received>)
+ tcp-connection.tcp-acknowledgement-number
+ := $transform-from-bv(tcp-connection.last-received-packet.sequence-number) + 1;
+ send(syn: #t, ack: #t)
+end;
+
+define transition (<established> => <close-wait>)
+ if (frame-size(tcp-connection.last-received-packet.payload) > 0)
+ receive-data(tcp-connection);
end;
+ tcp-connection.tcp-acknowledgement-number := tcp-connection.tcp-acknowledgement-number + 1;
+ send(ack: #t);
+ release(tcp-connection.notification)
+end;
+
+define transition (<close-wait> => <last-ack>)
+ send(fin: #t, ack: #t) // theory says no ack, but in practice it's required
end;
-define method syn-ack-received (tcp-connection :: <tcp-connection>) => (res :: <tcp-state>)
- let new-state = syn-ack-received(tcp-connection.state);
- if (new-state ~= tcp-connection.state)
- send-via-tcp(tcp-connection, ack: #t);
- tcp-connection.state := new-state;
+define transition (<established> => <fin-wait1>)
+ send(fin: #t, ack: #t) // theory says no ack, but in practice it's required
+end;
+
+define transition (<fin-wait1> => <closing>)
+ if (frame-size(tcp-connection.last-received-packet.payload) > 0)
+ receive-data(tcp-connection);
end;
- tcp-connection.state
+ tcp-connection.tcp-acknowledgement-number := tcp-connection.tcp-acknowledgement-number + 1;
+ send(ack: #t);
+ release(tcp-connection.notification)
end;
-define method fin-ack-received (tcp-connection :: <tcp-connection>) => (res :: <tcp-state>)
- let new-state = fin-ack-received(tcp-connection.state);
- if (new-state ~= tcp-connection.state)
- send-via-tcp(tcp-connection, ack: #t);
- tcp-connection.state := new-state;
+define transition (<fin-wait1> => <fin-wait1>)
+ if (frame-size(tcp-connection.last-received-packet.payload) > 0)
+ receive-data(tcp-connection);
+ send(ack: #t);
end;
- tcp-connection.state
end;
-define method fin-received (tcp-connection :: <tcp-connection>) => (res :: <tcp-state>)
- let new-state = fin-received(tcp-connection.state);
- if (new-state ~= tcp-connection.state)
- send-via-tcp(tcp-connection, ack: #t);
- tcp-connection.state := new-state;
- end;
- tcp-connection.state
+define transition (<fin-wait2> => <fin-wait2>)
+ if (frame-size(tcp-connection.last-received-packet.payload) > 0)
+ receive-data(tcp-connection);
+ send(ack: #t);
+ end;
end;
-define method ack-received (tcp-connection :: <tcp-connection>) => (res :: <tcp-state>)
- let new-state = ack-received(tcp-connection.state);
- if (new-state ~= tcp-connection.state)
- tcp-connection.state := new-state;
+define transition (type-union(<fin-wait1>, <fin-wait2>) => <time-wait>)
+ if (frame-size(tcp-connection.last-received-packet.payload) > 0)
+ receive-data(tcp-connection);
end;
- tcp-connection.state
+ tcp-connection.tcp-acknowledgement-number := tcp-connection.tcp-acknowledgement-number + 1;
+ send(ack: #t);
+ release(tcp-connection.notification)
+end;
+
+define transition (<tcp-state> => <time-wait>)
+ make(<timer>, in: 30 * 2, event: curry(process-event-locked, tcp-connection, #"2msl-timeout"));
+end;
+
+define transition (<syn-received> => <fin-wait1>)
+ send(fin: #t)
end;
-define method rst-received (tcp-connection :: <tcp-connection>) => (res :: <tcp-state>)
- //NYI
+define transition (<closed> => <syn-sent>)
+ send(syn: #t)
end;
-define method passive-open (tcp-connection :: <tcp-connection>) => (res :: <tcp-state>)
- tcp-connection.state := passive-open(tcp-connection.state);
+define transition (<tcp-state> => <closed>)
+ release(tcp-connection.notification);
+ release(tcp-connection.established-notification);
+ remove-key!(tcp-connection.tcp-layer.connection-tracking, tcp-connection.generate-id);
end;
-define method active-open (tcp-connection :: <tcp-connection>) => (res :: <tcp-state>)
- send-via-tcp(tcp-connection, syn: #t);
- tcp-connection.state := active-open(tcp-connection.state);
+define method process-event-locked (tcp-connection :: <tcp-connection>, event) => ()
+ with-lock (tcp-connection.lock)
+ process-event(tcp-connection, event)
+ end;
end;
-define method close (tcp-connection :: <tcp-connection>) => (res :: <tcp-state>)
- send-via-tcp(tcp-connection, fin: #t);
- tcp-connection.state := close(tcp-connection.state);
+define method passive-open (tcp-connection :: <tcp-connection>)
+ process-event-locked(tcp-connection, #"passive-open")
+end;
+
+define method active-open (tcp-connection :: <tcp-connection>)
+ process-event-locked(tcp-connection, #"active-open");
+end;
+
+define method close (tcp-connection :: <tcp-connection>, #key) => ()
+ process-event-locked(tcp-connection, #"close")
end;
define open generic listen-port (t :: <tcp-listener-socket>) => (res :: <integer>);
-define open generic connections (t :: <tcp-listener-socket>) => (res :: <stretchy-vector>);
+define open generic connections (t :: <tcp-listener-socket>) => (res :: <deque>);
+define open generic listener-lock (t :: <tcp-listener-socket>) => (res :: <lock>);
+
-define class <tcp-listener-socket> (<socket>)
+define class <tcp-listener-socket> (<object>)
constant slot listen-port :: <integer>, required-init-keyword: listen-port:;
constant slot listen-address :: <ipv4-address>, required-init-keyword: listen-address:;
- constant slot connections :: <stretchy-vector> = make(<stretchy-vector>);
- constant slot lock :: <lock> = make(<lock>);
+ constant slot connections :: <deque> = make(<deque>);
+ constant slot listener-lock :: <lock> = make(<lock>);
+ slot notification :: <notification>;
+end;
+
+define method initialize (socket :: <tcp-listener-socket>,
+ #rest rest, #key, #all-keys)
+ next-method();
+ socket.notification := make(<notification>, lock: socket.listener-lock);
end;
define method create-server-socket (layer :: <tcp-layer>,
listen-port :: <integer>,
- #key listen-address :: <ipv4-address>);
+ #key listen-address :: false-or(<ipv4-address>));
let socket = make(<tcp-listener-socket>,
listen-port: listen-port,
listen-address: listen-address | layer.default-ip-address);
add!(layer.sockets, socket);
+ socket;
end;
define method accept (socket :: <tcp-listener-socket>) => (res :: false-or(<tcp-connection>));
- with-lock (socket.lock)
- if (socket.connections.size > 0)
- let conn = socket.connections[0];
- remove!(socket.connections, conn);
- conn;
+ with-lock (socket.listener-lock)
+ while (socket.connections.size = 0)
+ wait-for(socket.notification);
+ end;
+ let connection = pop(socket.connections);
+ with-lock (connection.lock)
+ wait-for(connection.established-notification); //XXX timeout!
end;
+ connection;
end;
end;
define method create-client-socket (layer :: <tcp-layer>,
@@ -295,7 +444,7 @@
let listen-port = source-port | random(2 ^ 16);
let listen-address = source-address | layer.default-ip-address;
let connection = make(<tcp-connection>,
- socket: layer.ip-send-socket,
+ tcp-layer: layer,
source-port: listen-port,
destination-port: destination-port,
destination-address: destination-address,
@@ -303,8 +452,14 @@
let id = generate-id(connection);
layer.connection-tracking[id] := connection;
active-open(connection);
- sleep(2);
- connection;
+ with-lock (connection.lock)
+ wait-for(connection.established-notification); //XXX: timeout
+ if (instance?(connection.state, <established>))
+ connection;
+ else
+ #f
+ end;
+ end;
end;
define method find-listener-socket (sockets, destination-port)
@@ -322,11 +477,23 @@
let ip-layer = init-ethernet();
let tcp = make(<tcp-layer>, ip-layer: ip-layer, default-ip-address: ip-layer.default-ip-address);
let s = create-client-socket(tcp, ipv4-address("213.73.91.29"), 80);
- write(s, "GET / HTTP/1.1\r\nHost: www.ccc.de\r\n\r\n");
- while(#t)
- let res = read(s);
- if (res & res.size > 0)
- format-out("Read %s\n", map-as(<string>, curry(as, <character>), res))
+ write(s, "GET / HTTP/1.1\r\nHost: www.ccc.de\r\nConnection: keep-alive\r\n\r\n");
+ block(ret)
+ while (#t)
+ let res = read(s, 20, on-end-of-stream: #f);
+ //if (res)
+ //format-out("Read %s\n", map-as(<string>, curry(as, <character>), res))
+ //else
+ close(s);
+ ret();
+ //end;
end;
end;
+ let ss = create-server-socket(tcp, 23);
+ while (#t)
+ let conn = accept(ss);
+ write(conn, "fnord");
+ close(conn);
+ end;
+ sleep(1000);
end;
Modified: trunk/libraries/packetizer/ipv4.dylan
==============================================================================
--- trunk/libraries/packetizer/ipv4.dylan (original)
+++ trunk/libraries/packetizer/ipv4.dylan Sun Oct 8 02:47:37 2006
@@ -198,8 +198,9 @@
field window :: <2byte-big-endian-unsigned-integer> = 0;
field checksum :: <2byte-big-endian-unsigned-integer> = 0;
field urgent-pointer :: <2byte-big-endian-unsigned-integer> = 0;
- field options-and-padding :: <raw-frame>;
- field payload :: <raw-frame>, start: frame.data-offset * 4 * 8;
+ field options-and-padding :: <raw-frame> = make(<raw-frame>, data: make(<stretchy-byte-vector-subsequence>));
+ field payload :: <raw-frame> = make(<raw-frame>, data: make(<stretchy-byte-vector-subsequence>)),
+ start: frame.data-offset * 4 * 8;
end;
define protocol pseudo-header (container-frame)
Modified: trunk/libraries/pcap/pcap.dylan
==============================================================================
--- trunk/libraries/pcap/pcap.dylan (original)
+++ trunk/libraries/pcap/pcap.dylan Sun Oct 8 02:47:37 2006
@@ -94,7 +94,7 @@
ret();
end;
end;
- open-interface(interface.interface-name);
+ //open-interface(interface.interface-name);
format-out("trying pcap-find-alldevices\n");
let (errorcode, devices) = pcap-find-all-devices(buffer-offset(errbuf, 0));
Modified: trunk/libraries/tcp/library.dylan
==============================================================================
--- trunk/libraries/tcp/library.dylan (original)
+++ trunk/libraries/tcp/library.dylan Sun Oct 8 02:47:37 2006
@@ -6,5 +6,6 @@
define library tcp
use common-dylan;
use io;
+
export tcp;
end library tcp;
Modified: trunk/libraries/tcp/module.dylan
==============================================================================
--- trunk/libraries/tcp/module.dylan (original)
+++ trunk/libraries/tcp/module.dylan Sun Oct 8 02:47:37 2006
@@ -5,19 +5,18 @@
define module tcp
use common-dylan, exclude: { close };
-
+ use threads;
use format-out;
use standard-io;
use streams, import: { read-line };
- export <tcp-dingens>, state, state-setter;
+ export <tcp-dingens>, state, lock;
export <tcp-state>, <closed>, <listen>,
<syn-sent>, <syn-received>, <established>,
<fin-wait1>, <fin-wait2>, <closing>,
<time-wait>, <close-wait>, <last-ack>;
- export passive-open, active-open, close,
- syn-received, syn-ack-received, rst-received,
- fin-received, ack-received, fin-ack-received;
+ export <tcp-events>, state-transition, process-event;
+
end module tcp;
Modified: trunk/libraries/tcp/tcp.dylan
==============================================================================
--- trunk/libraries/tcp/tcp.dylan (original)
+++ trunk/libraries/tcp/tcp.dylan Sun Oct 8 02:47:37 2006
@@ -4,236 +4,169 @@
Copyright: (C) 2006, All rights reserved.
define open class <tcp-dingens> (<object>)
+ constant slot lock :: <simple-lock> = make(<simple-lock>);
slot state :: <tcp-state> = make(<closed>);
end;
define abstract class <tcp-state> (<object>)
end;
-define class <closed> (<tcp-state>)
+define macro singleton-class-definer
+ { define singleton-class ?:name (?superclass:name) ?slots:* end }
+ =>
+ { define class ?name (?superclass) ?slots end;
+ define variable "*" ## ?name ## "-instance*" :: false-or(?name) = #f;
+ define method make(class == ?name, #next next-method, #rest rest, #key, #all-keys)
+ => (instance :: ?name);
+ "*" ## ?name ## "-instance*" | ("*" ## ?name ## "-instance*" := next-method())
+ end;
+ }
end;
-define class <listen> (<tcp-state>)
+define singleton-class <closed> (<tcp-state>)
end;
-
-
-
-define class <syn-sent> (<tcp-state>)
+define singleton-class <listen> (<tcp-state>)
end;
-define class <syn-received> (<tcp-state>)
+define singleton-class <syn-sent> (<tcp-state>)
end;
-define class <established> (<tcp-state>)
+define singleton-class <syn-received> (<tcp-state>)
end;
-define class <fin-wait1> (<tcp-state>)
+define singleton-class <established> (<tcp-state>)
end;
-define class <fin-wait2> (<tcp-state>)
+define singleton-class <fin-wait1> (<tcp-state>)
end;
-define class <closing> (<tcp-state>)
+define singleton-class <fin-wait2> (<tcp-state>)
end;
-define class <time-wait> (<tcp-state>)
+define singleton-class <closing> (<tcp-state>)
end;
-define class <close-wait> (<tcp-state>)
+define singleton-class <time-wait> (<tcp-state>)
end;
-define class <last-ack> (<tcp-state>)
+define singleton-class <close-wait> (<tcp-state>)
end;
-define open generic passive-open (dingens :: type-union(<tcp-dingens>, <tcp-state>)) => (new-state :: <tcp-state>);
-
-define open generic active-open (dingens :: type-union(<tcp-dingens>, <tcp-state>)) => (new-state :: <tcp-state>);
-
-define open generic close (dingens :: type-union(<tcp-dingens>, <tcp-state>)) => (new-state :: <tcp-state>);
-
-define open generic syn-received (dingens :: type-union(<tcp-dingens>, <tcp-state>)) => (new-state :: <tcp-state>);
-
-define open generic syn-ack-received (dingens :: type-union(<tcp-dingens>, <tcp-state>)) => (new-state :: <tcp-state>);
-
-define open generic rst-received (dingens :: type-union(<tcp-dingens>, <tcp-state>)) => (new-state :: <tcp-state>);
-
-define open generic fin-received (dingens :: type-union(<tcp-dingens>, <tcp-state>)) => (new-state :: <tcp-state>);
-
-define open generic ack-received (dingens :: type-union(<tcp-dingens>, <tcp-state>)) => (new-state :: <tcp-state>);
-
-define open generic fin-ack-received (dingens :: type-union(<tcp-dingens>, <tcp-state>)) => (new-type :: <tcp-state>);
-
-define method passive-open (dingens :: <tcp-dingens>) => (new-state :: <tcp-state>);
- dingens.state := passive-open(dingens.state)
-end;
-define method active-open (dingens :: <tcp-dingens>) => (new-state :: <tcp-state>);
- dingens.state := active-open(dingens.state)
+define singleton-class <last-ack> (<tcp-state>)
end;
-define method close (dingens :: <tcp-dingens>) => (new-state :: <tcp-state>);
- dingens.state := close(dingens.state)
-end;
+define constant <tcp-events> = one-of(#"passive-open", #"active-open", #"close", #"syn-received", #"syn-ack-received",
+ #"rst-received", #"fin-received", #"ack-received", #"fin-ack-received",
+ #"2msl-timeout", #"last-ack-received");
-define method syn-received (dingens :: <tcp-dingens>) => (new-state :: <tcp-state>);
- dingens.state := syn-received(dingens.state)
-end;
-
-define method syn-ack-received (dingens :: <tcp-dingens>) => (new-state :: <tcp-state>);
- dingens.state := syn-ack-received(dingens.state)
-end;
-
-define method rst-received (dingens :: <tcp-dingens>) => (new-state :: <tcp-state>);
- dingens.state := rst-received(dingens.state)
-end;
-
-define method fin-received (dingens :: <tcp-dingens>) => (new-state :: <tcp-state>);
- dingens.state := fin-received(dingens.state)
-end;
-
-define method ack-received (dingens :: <tcp-dingens>) => (new-state :: <tcp-state>);
- dingens.state := ack-received(dingens.state)
-end;
-
-define method fin-ack-received (dingens :: <tcp-dingens>) => (new-state :: <tcp-state>);
- dingens.state := fin-ack-received(dingens.state)
-end;
-
-define method passive-open (old-state :: <tcp-state>) => (new-state :: <tcp-state>);
- format-out("R\n");
- old-state
-end;
+define generic next-state (state :: <tcp-state>, event :: <tcp-events>) => (res :: <tcp-state>);
-define method active-open (old-state :: <tcp-state>) => (new-state :: <tcp-state>);
- format-out("R\n");
- old-state
+define method next-state (state :: <tcp-state>, event :: <tcp-events>) => (res :: <tcp-state>)
+ state
end;
-define method close (old-state :: <tcp-state>) => (new-state :: <tcp-state>);
- format-out("R\n");
- old-state
-end;
-
-define method syn-received (old-state :: <tcp-state>) => (new-state :: <tcp-state>);
- format-out("R\n");
- old-state
-end;
-
-define method syn-ack-received (old-state :: <tcp-state>) => (new-state :: <tcp-state>);
- format-out("R\n");
- old-state
-end;
-
-define method rst-received (old-state :: <tcp-state>) => (new-state :: <tcp-state>);
- format-out("R\n");
- old-state
-end;
-
-define method fin-received (old-state :: <tcp-state>) => (new-state :: <tcp-state>);
- format-out("R\n");
- old-state
-end;
-
-define method ack-received (old-state :: <tcp-state>) => (new-state :: <tcp-state>);
- format-out("R\n");
- old-state
+define method next-state (state :: <tcp-state>, event == #"rst-received") => (res :: <tcp-state>)
+ make(<closed>)
end;
-define method fin-ack-received (old-state :: <tcp-state>) => (new-state :: <tcp-state>);
- format-out("R\n");
- old-state
+define method next-state (state :: <closed>, event == #"active-open") => (res :: <tcp-state>)
+ make(<syn-sent>)
end;
-
-define method passive-open (old-state :: <closed>) => (new-state :: <tcp-state>);
- format-out("Listen");
+define method next-state (state :: <closed>, event == #"passive-open") => (new-state :: <tcp-state>);
make(<listen>)
end;
-define method active-open (old-state :: <closed>) => (new-state :: <tcp-state>);
- format-out("Syn");
- make(<syn-sent>);
-end;
-
-define method syn-received (old-state :: <listen>) => (new-state :: <tcp-state>);
- format-out("SynAck");
+define method next-state (state :: <listen>, event == #"syn-received") => (new-state :: <tcp-state>);
make(<syn-received>)
end;
-define method close (old-state :: <syn-sent>) => (new-state :: <tcp-state>);
- format-out("Close");
+define method next-state (state :: <syn-sent>, event == #"close") => (new-state :: <tcp-state>);
make(<closed>)
end;
-define method syn-received (old-state :: <syn-sent>) => (new-state :: <tcp-state>);
- format-out("SynAck");
+define method next-state (state :: <syn-sent>, event == #"syn-received") => (new-state :: <tcp-state>);
make(<syn-received>)
end;
-define method syn-ack-received (old-state :: <syn-sent>) => (new-state :: <tcp-state>);
- format-out("Ack");
+define method next-state (state :: <syn-sent>, event == #"syn-ack-received") => (new-state :: <tcp-state>);
make(<established>)
end;
-define method rst-received (old-state :: <syn-received>) => (new-state :: <tcp-state>);
- format-out("Rst->Listen");
+define method next-state (old-state :: <syn-received>, event == #"rst-received") => (new-state :: <tcp-state>);
make(<listen>)
end;
-define method ack-received (old-state :: <syn-received>) => (new-state :: <tcp-state>);
- format-out("Established");
+define method next-state (old-state :: <syn-received>, event == #"last-ack-received") => (new-state :: <tcp-state>);
make(<established>)
end;
-define method close (old-state :: <syn-received>) => (new-state :: <tcp-state>);
- format-out("FIN");
+define method next-state (old-state :: <syn-received>, event == #"close") => (new-state :: <tcp-state>);
make(<fin-wait1>)
end;
-define method close (old-state :: <established>) => (new-state :: <tcp-state>);
- format-out("FIN");
+define method next-state (old-state :: <established>, event == #"close") => (new-state :: <tcp-state>);
make(<fin-wait1>)
end;
-define method fin-received (old-state :: <established>) => (new-state :: <tcp-state>);
- format-out("ACK");
+define method next-state (old-state :: <established>, event == #"fin-received") => (new-state :: <tcp-state>);
+ make(<close-wait>)
+end;
+
+define method next-state (old-state :: <established>, event == #"fin-ack-received") => (new-state :: <tcp-state>);
make(<close-wait>)
end;
-define method close (old-state :: <close-wait>) => (new-state :: <tcp-state>);
- format-out("FIN");
+define method next-state (old-state :: <close-wait>, event == #"close") => (new-state :: <tcp-state>);
make(<last-ack>)
end;
-define method ack-received (old-state :: <last-ack>) => (new-state :: <tcp-state>);
- format-out("Closed");
+define method next-state (old-state :: <last-ack>, event == #"last-ack-received") => (new-state :: <tcp-state>);
make(<closed>)
end;
-define method fin-received (old-state :: <fin-wait1>) => (new-state :: <tcp-state>);
- format-out("ACK");
+define method next-state (old-state :: <fin-wait1>, event == #"fin-received") => (new-state :: <tcp-state>);
make(<closing>)
end;
-define method ack-received (old-state :: <fin-wait1>) => (new-state :: <tcp-state>);
- format-out("fin-wait2");
+define method next-state (old-state :: <fin-wait1>, event == #"last-ack-received") => (new-state :: <tcp-state>);
make(<fin-wait2>)
end;
-define method fin-ack-received (old-state :: <fin-wait1>) => (new-state :: <tcp-state>);
- format-out("ACK");
+define method next-state (old-state :: <fin-wait1>, event == #"fin-ack-received") => (new-state :: <tcp-state>);
+ make(<time-wait>)
+end;
+
+define method next-state (old-state :: <fin-wait2>, event == #"fin-received") => (new-state :: <tcp-state>);
make(<time-wait>)
end;
-define method fin-received (old-state :: <fin-wait2>) => (new-state :: <tcp-state>);
- format-out("ACK");
+define method next-state (old-state :: <fin-wait2>, event == #"fin-ack-received") => (new-state :: <tcp-state>);
make(<time-wait>)
end;
-define method ack-received (old-state :: <closing>) => (new-state :: <tcp-state>);
- format-out("time-wait");
+define method next-state (old-state :: <closing>, event == #"last-ack-received") => (new-state :: <tcp-state>);
make(<time-wait>)
end;
+define method next-state (state :: <time-wait>, event == #"2msl-timeout") => (new-state :: <tcp-state>)
+ make(<closed>)
+end;
+
+define method process-event (dingens :: <tcp-dingens>, event :: <tcp-events>)
+ let old-state = dingens.state;
+ let new-state = next-state(old-state, event);
+ format-out("State transition %= => %=\n", old-state, new-state);
+ dingens.state := new-state;
+ state-transition(dingens, old-state, new-state);
+end;
+
+define open generic state-transition (dingens :: <tcp-dingens>, old-state :: <tcp-state>, new-state :: <tcp-state>) => ();
+
+define method state-transition (dingens :: <tcp-dingens>, old-state :: <tcp-state>, new-state :: <tcp-state>) => ()
+ ignore(dingens, old-state, new-state)
+end;
+
/*
begin
let tcp = make(<tcp-dingens>);
More information about the chatter
mailing list