[Gd-chatter] r10920 - in trunk/libraries: layer network-flow packetizer packetizer/packetizer-test registry/generic tcp vector-table
hannes at gwydiondylan.org
hannes at gwydiondylan.org
Fri Oct 6 22:48:58 CEST 2006
Author: hannes
Date: Fri Oct 6 22:48:53 2006
New Revision: 10920
Added:
trunk/libraries/layer/tcp.dylan (contents, props changed)
trunk/libraries/registry/generic/tcp (contents, props changed)
Modified:
trunk/libraries/layer/layer.dylan
trunk/libraries/layer/layer.hdp
trunk/libraries/layer/library.dylan
trunk/libraries/layer/module.dylan
trunk/libraries/network-flow/network-flow.dylan
trunk/libraries/packetizer/ipv4.dylan
trunk/libraries/packetizer/leaf-frames.dylan
trunk/libraries/packetizer/module.dylan
trunk/libraries/packetizer/packetizer-test/packetizer-test.dylan
trunk/libraries/packetizer/packetizer-test/stretchy-byte-vector-test.dylan
trunk/libraries/packetizer/packetizer.dylan
trunk/libraries/packetizer/pcap.dylan
trunk/libraries/packetizer/stretchy-byte-vector.dylan
trunk/libraries/tcp/library.dylan
trunk/libraries/tcp/module.dylan
trunk/libraries/tcp/tcp.dylan
trunk/libraries/vector-table/vector-table.dylan
Log:
Bug: 7299
*implement some more layering stuff, tcp connections work now
Modified: trunk/libraries/layer/layer.dylan
==============================================================================
--- trunk/libraries/layer/layer.dylan (original)
+++ trunk/libraries/layer/layer.dylan Fri Oct 6 22:48:53 2006
@@ -131,8 +131,8 @@
define generic v4-address (object :: <ip-over-ethernet-adapter>) => (res :: <ipv4-address>);
define open generic ip-layer (object :: <object>) => (res :: <ip-layer>);
define open generic ip-layer-setter (value :: <ip-layer>, object :: <object>) => (res :: <ip-layer>);
-define open generic ip-send-socket (object) => (res :: <ethernet-socket>);
-define open generic ip-send-socket-setter (value :: <ethernet-socket>, object) => (res :: <ethernet-socket>);
+define open generic ip-send-socket (object) => (res :: <socket>);
+define open generic ip-send-socket-setter (value :: <socket>, object) => (res :: <socket>);
define open generic netmask (object :: <ip-over-ethernet-adapter>) => (res :: <integer>);
define class <ip-over-ethernet-adapter> (<adapter>)
@@ -220,8 +220,8 @@
define open generic send-socket (object :: <object>) => (res);
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 generic default-ip-address (object :: <layer>) => (res :: <ipv4-address>);
+define generic default-ip-address-setter (value :: <ipv4-address>, object :: <layer>) => (res :: <ipv4-address>);
define open generic adapters (object :: <ip-layer>) => (res);
define open generic routes (object :: <ip-layer>) => (res);
@@ -374,7 +374,7 @@
end;
define generic arp-table (object :: <arp-handler>) => (res :: <vector-table>);
-define generic lock (object :: <arp-handler>) => (res :: <lock>);
+define open generic lock (object) => (res :: <lock>);
define class <arp-handler> (<filter>)
constant slot arp-table :: <vector-table> = make(<vector-table>);
@@ -423,7 +423,7 @@
define method try-again (request :: <outstanding-arp-request>, handler :: <arp-handler>)
with-lock(handler.lock)
if (request.counter > 3)
- remove-key!(arp-handler.arp-table, request.ip-address);
+ remove-key!(handler.arp-table, request.ip-address);
else
send(handler.send-socket, request.destination, request.original-request);
request.timer := make(<timer>, in: 5, event: curry(try-again, request, handler));
@@ -494,7 +494,7 @@
-begin
+define function init-ethernet ()
let int = make(<ethernet-interface>, name: "Intel");
let ethernet-layer = make(<ethernet-layer>, ethernet-interface: int);
let arp-handler = make(<arp-handler>);
@@ -534,7 +534,7 @@
code: 0,
payload: parse-frame(<raw-frame>, as(<byte-vector>, #(#x23, #x42, #x0, #x0)))));
- format-out("Mac 192.168.0.1: %=\n", element(arp-handler.arp-table, ipv4-address("192.168.0.1"), default: #f));
- sleep(1200);
+ format-out("Mac 192.168.2.1: %=\n", element(arp-handler.arp-table, ipv4-address("192.168.2.1"), default: #f));
+ ip-layer;
end;
Modified: trunk/libraries/layer/layer.hdp
==============================================================================
--- trunk/libraries/layer/layer.hdp (original)
+++ trunk/libraries/layer/layer.hdp Fri Oct 6 22:48:53 2006
@@ -3,3 +3,4 @@
module
cidr
layer
+ tcp
Modified: trunk/libraries/layer/library.dylan
==============================================================================
--- trunk/libraries/layer/library.dylan (original)
+++ trunk/libraries/layer/library.dylan Fri Oct 6 22:48:53 2006
@@ -12,6 +12,7 @@
use interfaces;
use vector-table;
use system, import: { date };
+ use tcp;
// Add any more module exports here.
export layer;
Modified: trunk/libraries/layer/module.dylan
==============================================================================
--- trunk/libraries/layer/module.dylan (original)
+++ trunk/libraries/layer/module.dylan Fri Oct 6 22:48:53 2006
@@ -14,7 +14,10 @@
use flow;
use interfaces;
use vector-table;
+ use byte-vector;
use date, import: {<date>, current-date };
+ use tcp;
+ use simple-random;
// Add binding exports here.
Added: trunk/libraries/layer/tcp.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/layer/tcp.dylan Fri Oct 6 22:48:53 2006
@@ -0,0 +1,321 @@
+module: layer
+
+define open generic connection-tracking (l :: <tcp-layer>) => (res :: <vector-table>);
+
+define class <tcp-layer> (<layer>)
+ constant slot ip-layer :: <ip-layer>, required-init-keyword: ip-layer:;
+ constant slot connection-tracking :: <vector-table> = make(<vector-table>);
+ slot default-ip-address :: <ipv4-address>, init-keyword: default-ip-address:;
+ slot ip-send-socket :: <ip-socket>;
+end;
+
+define inline method generate-id (tcp-frame :: <tcp-frame>) => (res :: <vector>)
+ generate-id-aux (tcp-frame.parent.source-address,
+ tcp-frame.source-port,
+ tcp-frame.parent.destination-address,
+ tcp-frame.destination-port);
+end;
+
+define inline function generate-id-aux (source :: <ipv4-address>, source-port :: <integer>,
+ destination :: <ipv4-address>, destination-port :: <integer>)
+ => (res :: <vector>)
+ concatenate(source.data,
+ assemble-frame-as(<2byte-big-endian-unsigned-integer>, source-port),
+ destination.data,
+ assemble-frame-as(<2byte-big-endian-unsigned-integer>, destination-port));
+end;
+define method initialize (layer :: <tcp-layer>,
+ #rest rest, #key, #all-keys)
+ let socket = create-socket(layer.ip-layer, 6);
+ let cls-node = make(<closure-node>,
+ closure: method(x)
+ let id = generate-id(x);
+ let connection = element(layer.connection-tracking, id, default: #f);
+ if (connection)
+ process-data(connection, x);
+ elseif (x.syn = 1)
+ 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);
+ layer.connection-tracking[id] := connection;
+ passive-open(connection);
+ with-lock (socket.lock)
+ add!(socket.connections, connection);
+ 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);
+ end;
+ else
+ format-out("Packet for unknown connection received\n");
+ end;
+ end);
+
+ connect(socket.decapsulator, cls-node);
+ layer.ip-send-socket := socket;
+end;
+
+define generic send-buffer (c :: <tcp-connection>) => (res);
+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-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>);
+ constant slot send-buffer = make(<deque>);
+ constant slot receive-buffer = make(<deque>);
+ slot send-socket :: <socket>, required-init-keyword: socket:;
+ 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-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:;
+end;
+
+define method generate-id (tcp :: <tcp-connection>) => (res :: <vector>)
+ generate-id-aux(tcp.tcp-destination-address, tcp.tcp-destination-port,
+ tcp.tcp-source-address, tcp.tcp-source-port);
+end;
+
+define constant $transform-from-bv = compose(byte-vector-to-float-be, data);
+define constant $transform-to-bv = compose(big-endian-unsigned-integer-4byte, float-to-byte-vector-be);
+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>))
+ for (i from 0 below min(conn.tcp-window-size, conn.send-buffer.size))
+ payload[i] := pop(conn.send-buffer);
+ end;
+ end;
+ let tcp-frame = make(<tcp-frame>,
+ 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),
+ 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>)));
+ 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);
+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)
+ end;
+end;
+
+define method read (tcp-connection :: <tcp-connection>) => (res :: <collection>)
+ let res = make(<stretchy-vector>);
+ block(ret)
+ while(#t)
+ let ele = read-element(tcp-connection);
+ if (ele)
+ res := add!(res, ele);
+ else
+ ret();
+ end;
+ end;
+ end;
+ res;
+end;
+
+define method write-element (tcp-connection :: <tcp-connection>, data :: <byte>)
+ push-last(tcp-connection.send-buffer, data);
+end;
+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 :: <sequence>)
+ do(curry(write-element, tcp-connection), data);
+ send-via-tcp(tcp-connection, data: #t, ack: #t);
+end;
+
+define method process-data (connection :: <tcp-connection>, packet :: <tcp-frame>)
+ 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);
+ else
+ fin-received(connection);
+ end;
+ elseif (packet.ack = 1)
+ connection.tcp-window-size := packet.window;
+ connection.tcp-acknowledgement-number := connection.tcp-acknowledgement-number + byte-offset(frame-size(packet.payload));
+ 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)
+ 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;
+ end;
+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;
+ end;
+ tcp-connection.state
+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;
+ 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
+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;
+ end;
+ tcp-connection.state
+end;
+
+define method rst-received (tcp-connection :: <tcp-connection>) => (res :: <tcp-state>)
+ //NYI
+end;
+
+define method passive-open (tcp-connection :: <tcp-connection>) => (res :: <tcp-state>)
+ tcp-connection.state := passive-open(tcp-connection.state);
+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);
+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);
+end;
+
+define open generic listen-port (t :: <tcp-listener-socket>) => (res :: <integer>);
+define open generic connections (t :: <tcp-listener-socket>) => (res :: <stretchy-vector>);
+
+define class <tcp-listener-socket> (<socket>)
+ 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>);
+end;
+
+define method create-server-socket (layer :: <tcp-layer>,
+ listen-port :: <integer>,
+ #key listen-address :: <ipv4-address>);
+ let socket = make(<tcp-listener-socket>,
+ listen-port: listen-port,
+ listen-address: listen-address | layer.default-ip-address);
+ add!(layer.sockets, 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;
+ end;
+ end;
+end;
+define method create-client-socket (layer :: <tcp-layer>,
+ destination-address :: <ipv4-address>,
+ destination-port :: <integer>,
+ #key source-port :: false-or(<integer>),
+ source-address :: false-or(<ipv4-address>));
+ 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,
+ source-port: listen-port,
+ destination-port: destination-port,
+ destination-address: destination-address,
+ source-address: listen-address);
+ let id = generate-id(connection);
+ layer.connection-tracking[id] := connection;
+ active-open(connection);
+ sleep(2);
+ connection;
+end;
+
+define method find-listener-socket (sockets, destination-port)
+ block(ret)
+ for (ele in sockets)
+ if (ele.listen-port = destination-port)
+ ret(ele)
+ end;
+ end;
+ end;
+end;
+
+
+begin
+ 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 %=\n", res)
+ end;
+ end;
+end;
Modified: trunk/libraries/network-flow/network-flow.dylan
==============================================================================
--- trunk/libraries/network-flow/network-flow.dylan (original)
+++ trunk/libraries/network-flow/network-flow.dylan Fri Oct 6 22:48:53 2006
@@ -38,10 +38,6 @@
push-data(node.the-output, frame.payload)
end;
-define class <demultiplexer> (<single-push-input-node>)
- slot outputs :: <stretchy-vector> = make(<stretchy-vector>);
-end;
-
define open class <fan-in> (<single-push-output-node>)
slot inputs :: <stretchy-vector> = make(<stretchy-vector>);
end;
@@ -101,6 +97,10 @@
required-init-keyword: frame-filter:;
end;
+define class <demultiplexer> (<single-push-input-node>)
+ slot outputs :: <stretchy-vector> = make(<stretchy-vector>);
+end;
+
define method create-output-for-filter
(demux :: <demultiplexer>, filter-string :: <string>)
=> (output :: <filtered-push-output>)
Modified: trunk/libraries/packetizer/ipv4.dylan
==============================================================================
--- trunk/libraries/packetizer/ipv4.dylan (original)
+++ trunk/libraries/packetizer/ipv4.dylan Fri Oct 6 22:48:53 2006
@@ -82,8 +82,9 @@
write(stream, as(<string>, object));
end;
-define function calculate-checksum (frame :: type-union(<byte-vector-subsequence>, <byte-vector>), count :: <integer>)
- let checksum = 0;
+define function calculate-checksum (frame :: type-union(<byte-vector-subsequence>, <byte-vector>),
+ count :: <integer>) => (res :: <integer>)
+ let checksum :: <integer> = 0;
for (i from 0 below count - 1 by 2)
checksum := checksum + ash(frame[i], 8) + frame[i + 1];
end;
@@ -185,21 +186,44 @@
field destination-port :: <2byte-big-endian-unsigned-integer>;
field sequence-number :: <big-endian-unsigned-integer-4byte>;
field acknowledgement-number :: <big-endian-unsigned-integer-4byte>;
- field data-offset :: <4bit-unsigned-integer>;
- field reserved :: <6bit-unsigned-integer>;
- field urg :: <1bit-unsigned-integer>;
- field ack :: <1bit-unsigned-integer>;
- field psh :: <1bit-unsigned-integer>;
- field rst :: <1bit-unsigned-integer>;
- field syn :: <1bit-unsigned-integer>;
- field fin :: <1bit-unsigned-integer>;
- field window :: <2byte-big-endian-unsigned-integer>;
- field checksum :: <2byte-big-endian-unsigned-integer>;
- field urgent-pointer :: <2byte-big-endian-unsigned-integer>;
+ field data-offset :: <4bit-unsigned-integer>,
+ fixup: ceiling/(20 + byte-offset(frame-size(frame.options-and-padding)), 4);
+ field reserved :: <6bit-unsigned-integer> = 0;
+ field urg :: <1bit-unsigned-integer> = 0;
+ field ack :: <1bit-unsigned-integer> = 0;
+ field psh :: <1bit-unsigned-integer> = 0;
+ field rst :: <1bit-unsigned-integer> = 0;
+ field syn :: <1bit-unsigned-integer> = 0;
+ field fin :: <1bit-unsigned-integer> = 0;
+ 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;
end;
+define protocol pseudo-header (container-frame)
+ field source-address :: <ipv4-address>;
+ field destination-address :: <ipv4-address>;
+ field reserved :: <unsigned-byte> = 0;
+ field protocol :: <unsigned-byte> = 6;
+ field segment-length :: <2byte-big-endian-unsigned-integer>;
+ field data :: <raw-frame>,
+ length: frame.segment-length;
+end;
+
+define method fixup!(tcp-frame :: <unparsed-tcp-frame>,
+ #next next-method)
+ let pseudo-header = make(<pseudo-header>,
+ source-address: tcp-frame.parent.source-address,
+ destination-address: tcp-frame.parent.destination-address,
+ segment-length: tcp-frame.packet.size,
+ data: make(<raw-frame>, data: tcp-frame.packet));
+ let pack = assemble-frame(pseudo-header).packet;
+ tcp-frame.checksum := calculate-checksum(pack, pack.size);
+ next-method();
+end;
+
define method flags-summary (frame :: <tcp-frame>) => (result :: <string>)
apply(concatenate,
map(method(field, id) if (frame.field = 1) id else "" end end,
Modified: trunk/libraries/packetizer/leaf-frames.dylan
==============================================================================
--- trunk/libraries/packetizer/leaf-frames.dylan (original)
+++ trunk/libraries/packetizer/leaf-frames.dylan Fri Oct 6 22:48:53 2006
@@ -319,9 +319,10 @@
define method assemble-frame-as (frame-type :: subclass(<big-endian-unsigned-integer-byte-frame>),
data :: <integer>)
- => (packet :: <byte-vector>)
- let result = make(<stretchy-byte-vector-subsequence>, end: frame-size(frame-type));
- assemble-frame-into-as(frame-type, data, result, 0);
+ => (packet :: <byte-vector-subsequence>)
+ let result = make(<stretchy-byte-vector-subsequence>, end: byte-offset(frame-size(frame-type)));
+ assemble-frame-into-as(frame-type, data, result);
+ result;
end;
define method assemble-frame-into-as (frame-type :: subclass(<big-endian-unsigned-integer-byte-frame>),
@@ -378,9 +379,10 @@
define method assemble-frame-as (frame-type :: subclass(<little-endian-unsigned-integer-byte-frame>),
data :: <integer>)
- => (packet :: <byte-vector>)
- let result = make(<byte-vector>, size: byte-offset(frame-size(frame-type)), fill: 0);
- assemble-frame-into-as(frame-type, data, result, 0);
+ => (packet :: <stretchy-byte-vector-subsequence>)
+ let result = make(<stretchy-byte-vector-subsequence>, end: byte-offset(frame-size(frame-type)));
+ assemble-frame-into-as(frame-type, data, result);
+ result;
end;
define method assemble-frame-into-as (frame-type :: subclass(<little-endian-unsigned-integer-byte-frame>),
Modified: trunk/libraries/packetizer/module.dylan
==============================================================================
--- trunk/libraries/packetizer/module.dylan (original)
+++ trunk/libraries/packetizer/module.dylan Fri Oct 6 22:48:53 2006
@@ -22,6 +22,9 @@
export <udp-frame>, source-port, destination-port, length, checksum;
+ export <tcp-frame>, sequence-number, acknowledgement-number,
+ urg, ack, psh, rst, syn, fin, window, urgent-pointer, options-and-padding;
+
export <ethernet-frame>, <ipv4-frame>,
<ipv4-address>, <mac-address>, <ieee80211-frame>, <prism2-frame>,
<logical-link-control>, <link-control>,
@@ -42,6 +45,11 @@
export <pcap-file>, <pcap-file-header>, <pcap-packet>, header, packets,
$DLT-EN10MB, $DLT-PRISM-HEADER, make-unix-time, decode-unix-time, timestamp;
+ //XXX: evil hacks
+ export float-to-byte-vector-le, byte-vector-to-float-le,
+ float-to-byte-vector-be, byte-vector-to-float-be,
+ big-endian-unsigned-integer-4byte;
+
export <icmp-frame>, code, type, checksum;
export <raw-frame>;
@@ -89,6 +97,7 @@
<leaf-frame>,
parse-frame,
assemble-frame,
+ assemble-frame-as,
read-frame,
summary;
@@ -111,7 +120,8 @@
packet,
source-address,
destination-address,
- payload-type;
+ payload-type,
+ get-protocol-magic;
export <header-frame>,
<unparsed-header-frame>,
Modified: trunk/libraries/packetizer/packetizer-test/packetizer-test.dylan
==============================================================================
--- trunk/libraries/packetizer/packetizer-test/packetizer-test.dylan (original)
+++ trunk/libraries/packetizer/packetizer-test/packetizer-test.dylan Fri Oct 6 22:48:53 2006
@@ -383,6 +383,21 @@
check-equal("assembling is correct", #(#xe0, #x5a), as.packet);
end;
+define protocol bits (container-frame)
+ field a :: <1bit-unsigned-integer> = 0;
+ field b :: <1bit-unsigned-integer> = 1;
+ field c :: <1bit-unsigned-integer> = 0;
+ field d :: <1bit-unsigned-integer> = 1;
+ field e :: <1bit-unsigned-integer> = 0;
+ field f :: <1bit-unsigned-integer> = 1;
+end;
+
+define test bits-assemble ()
+ let f = make(<bits>);
+ let as = assemble-frame(f);
+ check-equal("assembling is correct", 84, as.packet[0]);
+end;
+
define suite packetizer-suite ()
test packetizer-parser;
test packetizer-dynamic-parser;
@@ -413,6 +428,7 @@
test half-byte-assembling;
test half-byte-modify;
test half-bytes-assembling;
+ test bits-assemble;
end;
begin
Modified: trunk/libraries/packetizer/packetizer-test/stretchy-byte-vector-test.dylan
==============================================================================
--- trunk/libraries/packetizer/packetizer-test/stretchy-byte-vector-test.dylan (original)
+++ trunk/libraries/packetizer/packetizer-test/stretchy-byte-vector-test.dylan Fri Oct 6 22:48:53 2006
@@ -226,6 +226,12 @@
check-equal("encode integer in bit vector", #x23, sbv[0]);
end;
+define test encode-integer-test2 ()
+ let sbv = make(<stretchy-byte-vector-subsequence>);
+ let sub1 = subsequence(sbv, start: 6, length: 1);
+ encode-integer(1, sub1, 1);
+ check-equal("encode integer in bit vector", 2, sbv[0]);
+end;
define suite stretchy-byte-vector-suite ()
test byte-vector-subsequence-read;
test byte-vector-subsequence-modify;
@@ -239,6 +245,7 @@
test byte-vector-subsequence-with-offset-iteration;
test byte-vector-subsequence-with-offset-modify;
test encode-integer-test;
+ test encode-integer-test2;
end;
begin
Modified: trunk/libraries/packetizer/packetizer.dylan
==============================================================================
--- trunk/libraries/packetizer/packetizer.dylan (original)
+++ trunk/libraries/packetizer/packetizer.dylan Fri Oct 6 22:48:53 2006
@@ -387,9 +387,9 @@
frame.concrete-frame-fields[field.index].%start-offset := offset;
if (instance?(field.getter(frame), <container-frame>))
let unparsed = make(unparsed-class(field.getter(frame).object-class),
- cache: field.getter(frame), packet: subsequence(packet,
- start: offset,
- length: length));
+ cache: field.getter(frame),
+ packet: subsequence(packet, start: offset, length: length),
+ parent: frame);
field.setter(unparsed, frame);
end;
if (field.dynamic-end)
Modified: trunk/libraries/packetizer/pcap.dylan
==============================================================================
--- trunk/libraries/packetizer/pcap.dylan (original)
+++ trunk/libraries/packetizer/pcap.dylan Fri Oct 6 22:48:53 2006
@@ -32,7 +32,18 @@
res;
end;
-define function float-to-byte-vector (float :: <float>) => (res :: <byte-vector>)
+define function float-to-byte-vector-be (float :: <float>) => (res :: <byte-vector>)
+ let res = make(<byte-vector>, size: 4, fill: 0);
+ let r = float;
+ for (i from 3 to 0 by -1)
+ let (this, remainder) = floor/(r, 256);
+ r := this;
+ res[i] := floor(remainder);
+ end;
+ res;
+end;
+
+define function float-to-byte-vector-le (float :: <float>) => (res :: <byte-vector>)
let res = make(<byte-vector>, size: 4, fill: 0);
let r = float;
for (i from 0 below 4)
@@ -48,7 +59,7 @@
field microseconds :: <little-endian-unsigned-integer-4byte>;
end;
-define function byte-vector-to-float (bv :: <stretchy-byte-vector-subsequence>) => (res :: <float>)
+define function byte-vector-to-float-le (bv :: <stretchy-byte-vector-subsequence>) => (res :: <float>)
let res = 0.0d0;
for (ele in reverse(bv))
res := ele + 256 * res;
@@ -56,6 +67,14 @@
res;
end;
+define function byte-vector-to-float-be (bv :: <stretchy-byte-vector-subsequence>) => (res :: <float>)
+ let res = 0.0d0;
+ for (ele in bv)
+ res := ele + 256 * res;
+ end;
+ res;
+end;
+
define function byte-vector-to-int (bv :: <stretchy-byte-vector-subsequence>) => (res :: <integer>)
let res = 0;
let first? = #t;
@@ -71,7 +90,7 @@
define method decode-unix-time (unix-time :: <unix-time-value>)
=> (res :: <date>)
- let secs = byte-vector-to-float(unix-time.seconds.data);
+ let secs = byte-vector-to-float-le(unix-time.seconds.data);
let (days, rem0) = floor/(secs, 86400);
let (hours, rem1) = floor/(rem0, 3600);
let (minutes, seconds) = floor/(rem1, 60);
@@ -85,7 +104,7 @@
let (days, hours, minutes, seconds, microseconds) = decode-duration(dur);
let secs = ((as(<double-float>, days) * 24 + hours) * 60 + minutes) * 60 + seconds;
make(<unix-time-value>,
- seconds: little-endian-unsigned-integer-4byte(float-to-byte-vector(secs)),
+ seconds: little-endian-unsigned-integer-4byte(float-to-byte-vector-le(secs)),
microseconds: little-endian-unsigned-integer-4byte(int-to-byte-vector(microseconds)));
end;
Modified: trunk/libraries/packetizer/stretchy-byte-vector.dylan
==============================================================================
--- trunk/libraries/packetizer/stretchy-byte-vector.dylan (original)
+++ trunk/libraries/packetizer/stretchy-byte-vector.dylan Fri Oct 6 22:48:53 2006
@@ -394,9 +394,9 @@
let (fullbytes, bits) = truncate/(count - 8 + seq.bit-start-index, 8);
let first-byte = seq.start-index;
if ((fullbytes = 0) & (bits < 0))
- let mask = ash(ash(#xff, - (count - seq.bit-start-index)), seq.bit-start-index);
- seq.real-data[first-byte] := logior(logand(seq.real-data[first-byte], mask),
- ash(value, 8 - (count - seq.bit-start-index)));
+ let mask = ash(ash(#xff, - (8 - count)), 8 - seq.bit-start-index - count);
+ seq.real-data[first-byte] := logior(logand(seq.real-data[first-byte], lognot(mask)),
+ logand(mask, ash(value, 8 - seq.bit-end-index)));
else
if (seq.bit-start-index = 0)
seq.real-data[first-byte] := logand(#xff, ash(value, - (count - 8)));
Added: trunk/libraries/registry/generic/tcp
==============================================================================
--- (empty file)
+++ trunk/libraries/registry/generic/tcp Fri Oct 6 22:48:53 2006
@@ -0,0 +1 @@
+abstract://dylan/tcp/tcp.hdp
Modified: trunk/libraries/tcp/library.dylan
==============================================================================
--- trunk/libraries/tcp/library.dylan (original)
+++ trunk/libraries/tcp/library.dylan Fri Oct 6 22:48:53 2006
@@ -6,4 +6,5 @@
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 Fri Oct 6 22:48:53 2006
@@ -5,9 +5,19 @@
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-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;
end module tcp;
Modified: trunk/libraries/tcp/tcp.dylan
==============================================================================
--- trunk/libraries/tcp/tcp.dylan (original)
+++ trunk/libraries/tcp/tcp.dylan Fri Oct 6 22:48:53 2006
@@ -3,7 +3,7 @@
Author: Andreas Bogk, Hannes Mehnert
Copyright: (C) 2006, All rights reserved.
-define class <tcp-dingens> (<object>)
+define open class <tcp-dingens> (<object>)
slot state :: <tcp-state> = make(<closed>);
end;
@@ -16,6 +16,9 @@
define class <listen> (<tcp-state>)
end;
+
+
+
define class <syn-sent> (<tcp-state>)
end;
@@ -43,23 +46,23 @@
define class <last-ack> (<tcp-state>)
end;
-define generic passive-open (dingens :: type-union(<tcp-dingens>, <tcp-state>)) => (new-state :: <tcp-state>);
+define open generic passive-open (dingens :: type-union(<tcp-dingens>, <tcp-state>)) => (new-state :: <tcp-state>);
-define generic active-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 generic close (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 generic syn-received (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 generic syn-ack-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 generic rst-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 generic fin-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 generic ack-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 generic fin-ack-received (dingens :: type-union(<tcp-dingens>, <tcp-state>)) => (new-type :: <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)
@@ -231,6 +234,7 @@
make(<time-wait>)
end;
+/*
begin
let tcp = make(<tcp-dingens>);
while(#t)
@@ -249,15 +253,15 @@
end;
event(tcp)
end
-end;
-
+end; */
+/*
closed; application: open; syn-sent; frame: syn
listen; frame: syn; syn-received; frame: syn & ack
syn-received; frame: ack; established;
established; frame: fin; close-wait; frame: ack
syn-sent; timeout: 300; closed;
syn-sent; application: close; closed;
-
+*/
Modified: trunk/libraries/vector-table/vector-table.dylan
==============================================================================
--- trunk/libraries/vector-table/vector-table.dylan (original)
+++ trunk/libraries/vector-table/vector-table.dylan Fri Oct 6 22:48:53 2006
@@ -7,14 +7,18 @@
define method table-protocol (table :: <vector-table>)
=> (test-function :: <function>, hash-function :: <function>)
- values(method (x :: <fixed-size-byte-vector-frame>, y :: <fixed-size-byte-vector-frame>)
- x = y end, vector-hash);
+ values(method (x, y) x = y end, vector-hash);
end method table-protocol;
define method vector-hash (vector :: <fixed-size-byte-vector-frame>, state :: <hash-state>)
=> (id :: <integer>, state :: <hash-state>)
+ vector-hash(vector.data, state);
+end method;
+
+define method vector-hash (vector :: <collection>, state :: <hash-state>)
+ => (id :: <integer>, state :: <hash-state>)
let hash = 0;
- for (number in vector.data)
+ for (number in vector)
hash := hash + number;
end for;
values(hash, state);
More information about the chatter
mailing list