[Gd-chatter] r10956 - in trunk/libraries: gui-sniffer layer network-flow packetizer pcap protocols registry/generic
hannes at gwydiondylan.org
hannes at gwydiondylan.org
Tue Nov 14 23:28:27 CET 2006
Author: hannes
Date: Tue Nov 14 23:28:21 2006
New Revision: 10956
Added:
trunk/libraries/protocols/
trunk/libraries/protocols/dns.dylan (contents, props changed)
- copied, changed from r10947, trunk/libraries/packetizer/dns.dylan
trunk/libraries/protocols/ethernet.dylan (contents, props changed)
- copied, changed from r10947, trunk/libraries/packetizer/ethernet.dylan
trunk/libraries/protocols/ieee80211.dylan
- copied, changed from r10947, trunk/libraries/packetizer/ieee80211.dylan
trunk/libraries/protocols/ipv4.dylan (contents, props changed)
- copied, changed from r10947, trunk/libraries/packetizer/ipv4.dylan
trunk/libraries/protocols/logical-link.dylan
- copied, changed from r10947, trunk/libraries/packetizer/logical-link.dylan
trunk/libraries/protocols/pcap.dylan (contents, props changed)
- copied, changed from r10947, trunk/libraries/packetizer/pcap.dylan
trunk/libraries/protocols/prism2.dylan
- copied, changed from r10947, trunk/libraries/packetizer/prism2.dylan
trunk/libraries/protocols/protocols-library.dylan (contents, props changed)
trunk/libraries/protocols/protocols.hdp (contents, props changed)
trunk/libraries/registry/generic/protocols (contents, props changed)
Removed:
trunk/libraries/packetizer/dns.dylan
trunk/libraries/packetizer/ethernet.dylan
trunk/libraries/packetizer/ieee80211.dylan
trunk/libraries/packetizer/ipv4.dylan
trunk/libraries/packetizer/logical-link.dylan
trunk/libraries/packetizer/pcap.dylan
trunk/libraries/packetizer/prism2.dylan
Modified:
trunk/libraries/gui-sniffer/library.dylan
trunk/libraries/gui-sniffer/module.dylan
trunk/libraries/layer/layer.dylan
trunk/libraries/layer/library.dylan
trunk/libraries/layer/module.dylan
trunk/libraries/layer/tcp.dylan
trunk/libraries/layer/udp.dylan
trunk/libraries/network-flow/library.dylan
trunk/libraries/network-flow/module.dylan
trunk/libraries/packetizer/fields.dylan
trunk/libraries/packetizer/leaf-frames.dylan
trunk/libraries/packetizer/module.dylan
trunk/libraries/packetizer/packetizer.dylan
trunk/libraries/packetizer/packetizer.hdp
trunk/libraries/packetizer/protocol-definer-macro.dylan
trunk/libraries/pcap/library.dylan
Log:
Bug: 7299
-> move protocols out of packetizer, in their own library, protocols
-> redesign protocol-definer-macro to support layering-fields and protocol stacking (with over <header-frame> magic)
-> fix imports and exports of packetizer and its users
-> prism2-frame is broken, because <ieee80211-frame> is not imported into that module
-> module ieee80211 does not yet export anything
Modified: trunk/libraries/gui-sniffer/library.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/library.dylan (original)
+++ trunk/libraries/gui-sniffer/library.dylan Tue Nov 14 23:28:21 2006
@@ -14,4 +14,5 @@
use flow;
use network-flow;
use interfaces;
+ use protocols;
end library gui-sniffer;
Modified: trunk/libraries/gui-sniffer/module.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/module.dylan (original)
+++ trunk/libraries/gui-sniffer/module.dylan Tue Nov 14 23:28:21 2006
@@ -19,6 +19,9 @@
use network-flow;
use flow;
use interfaces;
+ use ethernet, import: { <ethernet-frame> };
+ use pcap, import: { make-unix-time, <pcap-packet>, decode-unix-time, timestamp };
+ use prism2, import: { <prism2-frame> };
// Add binding exports here.
use deuce-internals, prefix: "deuce/";
end module gui-sniffer;
Modified: trunk/libraries/layer/layer.dylan
==============================================================================
--- trunk/libraries/layer/layer.dylan (original)
+++ trunk/libraries/layer/layer.dylan Tue Nov 14 23:28:21 2006
@@ -351,9 +351,9 @@
node :: <icmp-handler>,
frame :: <container-frame>)
//format-out("ICMP Handler received %=\n", frame);
- if (frame.type = 8 & frame.code = 0)
+ if (frame.icmp-type = 8 & frame.code = 0)
let response = make(<icmp-frame>,
- type: 0,
+ icmp-type: 0,
code: 0,
payload: frame.payload);
send(node.ip-socket, frame.parent.source-address, response)
@@ -493,7 +493,7 @@
define function init-ethernet ()
- let int = make(<ethernet-interface>, name: "Xtreme");
+ let int = make(<ethernet-interface>, name: "Intel");
let ethernet-layer = make(<ethernet-layer>, ethernet-interface: int);
let arp-handler = make(<arp-handler>);
/*
Modified: trunk/libraries/layer/library.dylan
==============================================================================
--- trunk/libraries/layer/library.dylan (original)
+++ trunk/libraries/layer/library.dylan Tue Nov 14 23:28:21 2006
@@ -13,6 +13,7 @@
use vector-table;
use system, import: { date };
use tcp;
+ use protocols;
// 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 Tue Nov 14 23:28:21 2006
@@ -19,7 +19,9 @@
use tcp;
use simple-random;
use streams;
-
+ use ipv4;
+ use ethernet;
+ use dns, exclude: { ipv4-address };
// Add binding exports here.
end module layer;
Modified: trunk/libraries/layer/tcp.dylan
==============================================================================
--- trunk/libraries/layer/tcp.dylan (original)
+++ trunk/libraries/layer/tcp.dylan Tue Nov 14 23:28:21 2006
@@ -99,7 +99,7 @@
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>);
+define class <tcp-connection> (<tcp-dingens>, <stream>)
constant slot send-buffer = make(<deque>);
constant slot receive-buffer = make(<deque>);
constant slot tcp-layer :: <tcp-layer>, required-init-keyword: tcp-layer:;
Modified: trunk/libraries/layer/udp.dylan
==============================================================================
--- trunk/libraries/layer/udp.dylan (original)
+++ trunk/libraries/layer/udp.dylan Tue Nov 14 23:28:21 2006
@@ -34,7 +34,7 @@
define method send (socket :: <udp-socket>, destination :: <ipv4-address>, payload :: <container-frame>);
end;
-begin
+define function udp-begin()
let ip-layer = init-ethernet();
let udp = make(<udp-layer>, ip-layer: ip-layer);
let socket = create-socket(udp, 53);
@@ -72,3 +72,5 @@
sleep(1000);
*/
end;
+
+udp-begin();
Modified: trunk/libraries/network-flow/library.dylan
==============================================================================
--- trunk/libraries/network-flow/library.dylan (original)
+++ trunk/libraries/network-flow/library.dylan Tue Nov 14 23:28:21 2006
@@ -9,6 +9,7 @@
use packetizer;
use io;
use system;
+ use protocols, import: { pcap };
// Add any more module exports here.
export network-flow;
Modified: trunk/libraries/network-flow/module.dylan
==============================================================================
--- trunk/libraries/network-flow/module.dylan (original)
+++ trunk/libraries/network-flow/module.dylan Tue Nov 14 23:28:21 2006
@@ -13,6 +13,7 @@
use packetizer;
use packet-filter;
use file-system;
+ use pcap, import: { packets, <pcap-file-header>, <pcap-packet>, <pcap-file> };
export <summary-printer>, <verbose-printer>,
<decapsulator>, <demultiplexer>,
Modified: trunk/libraries/packetizer/fields.dylan
==============================================================================
--- trunk/libraries/packetizer/fields.dylan (original)
+++ trunk/libraries/packetizer/fields.dylan Tue Nov 14 23:28:21 2006
@@ -25,6 +25,11 @@
//sets static-start, static-end, static-length for all fields
let start = 0;
for (field in list)
+ if (instance?(field, <layering-field>))
+ unless (field.fixup-function)
+ field.fixup-function := payload-type;
+ end;
+ end;
if (start ~= $unknown-at-compile-time)
unless (field.dynamic-start)
if (field.static-start = $unknown-at-compile-time)
@@ -73,7 +78,7 @@
slot static-length :: <integer-or-unknown> = $unknown-at-compile-time, init-keyword: static-length:;
slot static-end :: <integer-or-unknown> = $unknown-at-compile-time, init-keyword: static-end:;
slot init-value = #f, init-keyword: init-value:;
- constant slot fixup-function :: false-or(<function>) = #f, init-keyword: fixup:;
+ slot fixup-function :: false-or(<function>) = #f, init-keyword: fixup:;
constant slot getter, required-init-keyword: getter:;
constant slot setter, required-init-keyword: setter:;
constant slot dynamic-start :: false-or(<function>) = #f, init-keyword: dynamic-start:;
@@ -95,6 +100,9 @@
define class <single-field> (<statically-typed-field>)
end;
+define class <layering-field> (<single-field>)
+end;
+
define method static-field-size (field :: <single-field>) => (res :: <integer-or-unknown>)
field.type.field-size
end;
Modified: trunk/libraries/packetizer/leaf-frames.dylan
==============================================================================
--- trunk/libraries/packetizer/leaf-frames.dylan (original)
+++ trunk/libraries/packetizer/leaf-frames.dylan Tue Nov 14 23:28:21 2006
@@ -25,7 +25,7 @@
(<leaf-frame>, <variable-size-frame>, <translated-frame>)
end;
-define generic read-frame
+define open generic read-frame
(frame-type :: subclass(<leaf-frame>), string :: <string>) => (frame);
define method read-frame (frame-type :: subclass(<leaf-frame>), string :: <string>)
@@ -78,7 +78,7 @@
end;
-define abstract class <unsigned-integer-bit-frame> (<fixed-size-translated-leaf-frame>)
+define open abstract class <unsigned-integer-bit-frame> (<fixed-size-translated-leaf-frame>)
end;
define macro n-bit-unsigned-integer-definer
@@ -161,7 +161,7 @@
res;
end;
-define abstract class <fixed-size-byte-vector-frame> (<fixed-size-untranslated-leaf-frame>)
+define open abstract class <fixed-size-byte-vector-frame> (<fixed-size-untranslated-leaf-frame>)
slot data :: <byte-sequence>, required-init-keyword: data:;
end;
@@ -423,6 +423,25 @@
frame-size(frame)
end;
+define class <externally-delimited-string> (<variable-size-byte-vector>)
+end;
+
+define method as (class == <string>, frame :: <externally-delimited-string>)
+ => (res :: <string>)
+ let res = make(<string>, size: byte-offset(frame-size(frame)));
+ copy-bytes(frame.data, 0, res, 0, byte-offset(frame-size(frame)));
+ res;
+end;
+
+define method as (class == <externally-delimited-string>, string :: <string>)
+ => (res :: <externally-delimited-string>)
+ let res = make(<externally-delimited-string>,
+ data: make(<byte-sequence>, capacity: string.size));
+ copy-bytes(string, 0, res.data, 0, string.size);
+ res;
+end;
+
+
define class <raw-frame> (<variable-size-byte-vector>)
end;
@@ -444,3 +463,68 @@
end;
+define macro leaf-frame-constructor-definer
+ { define leaf-frame-constructor(?:name) end }
+ =>
+ {
+ define method ?name (data :: <byte-vector>)
+ => (res :: "<" ## ?name ## ">");
+ parse-frame("<" ## ?name ## ">", data)
+ end;
+
+ define method ?name (data :: <collection>)
+ => (res :: "<" ## ?name ## ">");
+ ?name(as(<byte-vector>, data))
+ end;
+
+ define method ?name (data :: <string>)
+ => (res :: "<" ## ?name ## ">");
+ read-frame("<" ## ?name ## ">", data)
+ end;
+
+ }
+end;
+
+//FIXME
+define n-byte-vector(little-endian-unsigned-integer-4byte, 4) end;
+define n-byte-vector(big-endian-unsigned-integer-4byte, 4) end;
+
+
+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)
+ let (this, remainder) = floor/(r, 256);
+ r := this;
+ res[i] := floor(remainder);
+ end;
+ res;
+end;
+
+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;
+ end;
+ 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;
+
Modified: trunk/libraries/packetizer/module.dylan
==============================================================================
--- trunk/libraries/packetizer/module.dylan (original)
+++ trunk/libraries/packetizer/module.dylan Tue Nov 14 23:28:21 2006
@@ -20,57 +20,41 @@
<out-of-bound-error>,
encode-integer, decode-integer;
- export <dns-frame>, <dns-question>, <domain-name>;
-
- 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>,
- <ieee80211-information-field>,
- <ieee80211-data-frame>,
- <ieee80211-management-frame>,
- <ieee80211-control-frame>,
- operation, type-code, <arp-frame>, target-mac-address,
- target-ip-address, source-ip-address, source-mac-address,
- mac-address, ipv4-address,
- <decoded-arp-frame>, <decoded-ethernet-frame>,
- <fixed-size-byte-vector-frame>, data,
- total-length, concrete-frame-fields,
+ export data,
+ concrete-frame-fields,
<repeated-field>, <malformed-packet-error>;
export byte-aligned, high-level-type;
- 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>;
+ export n-byte-vector-definer, n-bit-unsigned-integer-definer;
export hexdump;
export <unsigned-byte>,
<3byte-big-endian-unsigned-integer>,
- <2byte-big-endian-unsigned-integer>,
+ <2byte-big-endian-unsigned-integer>, <2byte-little-endian-unsigned-integer>,
<3byte-little-endian-unsigned-integer>,
- <externally-delimited-string>, <1bit-unsigned-integer>,
- <4bit-unsigned-integer>, <7bit-unsigned-integer>,
+ <1bit-unsigned-integer>, <6bit-unsigned-integer>, <3bit-unsigned-integer>,
+ <4bit-unsigned-integer>, <5bit-unsigned-integer>,
+ <7bit-unsigned-integer>, <13bit-unsigned-integer>,
<2bit-unsigned-integer>, <14bit-unsigned-integer>;
- export <fixed-size-translated-leaf-frame>, <byte-sequence>;
+ export <variable-size-byte-vector>, <externally-delimited-string>,
+ <raw-frame>;
+
+ //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>, big-endian-unsigned-integer-4byte,
+ <little-endian-unsigned-integer-4byte>, little-endian-unsigned-integer-4byte,;
+
+
+ export <fixed-size-translated-leaf-frame>, <byte-sequence>,
+ <fixed-size-byte-vector-frame>;
export <integer-or-unknown>, $unknown-at-compile-time;
- export <malformed-packet-error>;
+ export <malformed-packet-error>, <parse-error>;
export <frame-field>,
<repeated-frame-field>,
@@ -121,15 +105,17 @@
fixup!,
parent,
packet,
- source-address,
- destination-address,
+ cache,
+ source-address, source-address-setter,
+ destination-address, destination-address-setter,
payload-type,
- get-protocol-magic;
+ get-protocol-magic,
+ layer, reverse-layer, layer-magic;
export <header-frame>,
<unparsed-header-frame>,
<decoded-header-frame>,
- payload;
+ payload, payload-setter;
export frame-size,
byte-offset,
@@ -138,7 +124,9 @@
export protocol-definer;
//XXX: we shouldn't need to export those
export real-class-definer, decoded-class-definer, gen-classes,
- frame-field-generator, summary-generator, unparsed-frame-field-generator;
+ frame-field-generator, summary-generator, unparsed-frame-field-generator;
+
+ export protocol-module-definer;
end module packetizer;
define module packet-filter
Modified: trunk/libraries/packetizer/packetizer.dylan
==============================================================================
--- trunk/libraries/packetizer/packetizer.dylan (original)
+++ trunk/libraries/packetizer/packetizer.dylan Tue Nov 14 23:28:21 2006
@@ -201,10 +201,6 @@
"anonymous"
end;
-define open generic source-address (frame :: type-union(<raw-frame>, <container-frame>)) => (res);
-
-define open generic destination-address (frame :: type-union(<raw-frame>, <container-frame>)) => (res);
-
define open generic payload-type (frame :: type-union(<raw-frame>, <container-frame>)) => (res);
define open generic field-count (frame :: subclass(<container-frame>))
@@ -237,11 +233,42 @@
define open generic decoded-class (type :: subclass(<container-frame>))
=> (class :: <class>);
+define open generic layer (type :: subclass(<container-frame>))
+ => (res :: false-or(<table>));
+
+define open generic reverse-layer (type :: subclass(<container-frame>))
+ => (res :: false-or(<table>));
+
+define open generic layer-magic (frame :: <container-frame>) => (res);
+
+define method layer-magic (frame :: <container-frame>) => (res)
+ error("no magic field defined for protocol layering in protocol %s", frame.frame-name);
+end;
+
define open abstract class <decoded-container-frame> (<container-frame>)
slot concrete-frame-fields :: <vector>;
slot parent :: false-or(<container-frame>) = #f, init-keyword: parent:;
end;
+define method stack-protocol (bottom-layer :: <type>, upper-layer :: <type>, magic)
+ layer(bottom-layer)[magic] := upper-layer;
+ reverse-layer(bottom-layer)[decoded-class(upper-layer)] := magic;
+end;
+
+define inline method payload-type (frame :: <header-frame>) => (res :: <type>)
+ let table = layer(frame.object-class);
+ element(table, frame.layer-magic, default: <raw-frame>);
+end;
+
+define inline method get-protocol-magic (frame :: <header-frame>, payload :: <frame>) => (magic)
+ let reverse-layering = reverse-layer(frame.object-class);
+ let res = element(reverse-layering, decoded-class(payload.object-class), default: #f);
+ unless (res)
+ error("don't know how to layer %= over %=", payload.frame-name, frame.frame-name);
+ end;
+ res;
+end;
+
define method initialize (frame :: <decoded-container-frame>,
#rest rest, #key, #all-keys)
next-method();
@@ -306,12 +333,22 @@
(<header-frame>, <unparsed-container-frame>)
end;
-define open generic payload (frame :: <header-frame>);
+define open generic source-address (frame :: type-union(<raw-frame>, <container-frame>)) => (res);
+define open generic source-address-setter (value, frame :: type-union(<raw-frame>, <container-frame>)) => (res);
+
+define open generic destination-address (frame :: type-union(<raw-frame>, <container-frame>)) => (res);
+define open generic destination-address-setter (value, frame :: type-union(<raw-frame>, <container-frame>)) => (res);
+
+//can't specify type because unparsed-getter can't return false-or(<frame>)!
+define open generic payload (frame :: <header-frame>) => (payload);
-define method payload (frame :: <header-frame>) => (payload :: <frame>)
+define open generic get-protocol-magic (frame :: <container-frame>, payload :: <frame>);
+define method payload (frame :: <header-frame>) => (payload)
error("No payload specified");
end;
+define open generic payload-setter (value /* :: false-or(<frame>) */, object :: <header-frame>)
+ => (res /* :: false-or(<frame>) */);
define method frame-size (frame :: <container-frame>) => (res :: <integer>)
reduce1(\+, map(curry(get-field-size-aux, frame), frame.fields));
end;
Modified: trunk/libraries/packetizer/packetizer.hdp
==============================================================================
--- trunk/libraries/packetizer/packetizer.hdp (original)
+++ trunk/libraries/packetizer/packetizer.hdp Tue Nov 14 23:28:21 2006
@@ -11,13 +11,6 @@
protocol-definer-macro
filter
filter-parser
- logical-link
- ethernet
- ipv4
- pcap
- dns
- ieee80211
- prism2
base-address: 0x63FE0000
debug-arguments: c:\foo.pcap
linker-options: $(guilflags)
Modified: trunk/libraries/packetizer/protocol-definer-macro.dylan
==============================================================================
--- trunk/libraries/packetizer/protocol-definer-macro.dylan (original)
+++ trunk/libraries/packetizer/protocol-definer-macro.dylan Tue Nov 14 23:28:21 2006
@@ -3,20 +3,34 @@
Copyright: (C) 2005, 2006, All rights reserved. Free for non-commercial use.
+
define macro protocol-module-definer
- { protocol-module-definer (?:name; ?fields:*) }
+ { protocol-module-definer (?:name; ?super:name; ?fields:*) }
=> { define module ?name
use dylan;
use packetizer;
- export "<" ## ?name ## ">";
- export ?fields;
+ //?super;
+ create "<" ## ?name ## ">";
+ ?fields
end; }
fields:
{ } => { }
- { field ?:name ?rest:* ; ... } => { ?name, ... }
- { repeated field ?:name ?rest:* ; ... } => { ?name, ... }
- { variably-typed field ?:name ?rest:* ... } => { ?name, ... }
+ { field ?filter:name ?rest:* ; ... } => { ?filter ... }
+ { repeated field ?filter:name ?rest:* ; ... } => { ?filter ... }
+ { variably-typed-field ?filter:name ?rest:* ; ... } => { ?filter ... }
+
+
+ super:
+ { container-frame } => { }
+ { header-frame } => { }
+ { ?:name } => { use ?name; }
+
+ filter:
+ { source-address } => { }
+ { destination-address } => { }
+ { payload } => { }
+ { ?:name } => { create ?name, ?name ## "-setter"; }
end;
@@ -31,10 +45,9 @@
"$" ## ?name ## "-fields"
end;
define method fields-initializer
- (frame :: subclass(?name), #next next-method) => (frame-fields :: <simple-vector>)
+ (frame :: subclass(?name), #next next-method) => (frame-fields :: <simple-vector>)
let res = concatenate(next-method(), vector(?fields-aux));
- for (ele in res,
- i from 0)
+ for (ele in res, i from 0)
ele.index := i;
end;
res;
@@ -48,6 +61,32 @@
$protocols[?#"name"] := "$" ## ?name ## "-fields";
end;
end;
+ define constant "$" ## ?name ## "-layering"
+ = if (subtype?(?name, <header-frame>))
+ make(<table>);
+ end;
+ define inline method layer (frame :: subclass(?name)) => (res :: false-or(<table>))
+ "$" ## ?name ## "-layering";
+ end;
+ define constant "$" ## ?name ## "-reverse-layering"
+ = if (subtype?(?name, <header-frame>))
+ make(<table>);
+ end;
+ define inline method reverse-layer (frame :: subclass(?name)) => (res :: false-or(<table>))
+ "$" ## ?name ## "-reverse-layering";
+ end;
+ define constant "$" ## ?name ## "-layer-bonding"
+ = begin
+ let res = choose(rcurry(instance?, <layering-field>), "$" ## ?name ## "-fields");
+ if (res.size = 1)
+ res[0].getter;
+ end;
+ end;
+ define inline method layer-magic (frame :: ?name) => (res)
+ if ("$" ## ?name ## "-layer-bonding")
+ "$" ## ?name ## "-layer-bonding"(frame);
+ end;
+ end;
define inline method field-size (frame :: subclass(?name)) => (res :: <number>)
static-end(last("$" ## ?name ## "-fields"));
end;
@@ -64,22 +103,16 @@
fields-aux:
{ } => { }
- { field ?:name \:: ?field-type:name; ... }
- => { make(<single-field>,
- name: ?#"name",
- type: ?field-type,
- getter: ?name,
- setter: ?name ## "-setter"), ... }
- { field ?:name \:: ?field-type:name, ?args:*; ... }
- => { make(<single-field>,
+ { variably-typed-field ?:name, ?args:*; ... }
+ => { make(<variably-typed-field>,
name: ?#"name",
- type: ?field-type,
getter: ?name,
setter: ?name ## "-setter",
?args), ... }
- { variably-typed-field ?:name, ?args:*; ... }
+ { variably-typed-field ?:name = ?init:expression , ?args:*; ... }
=> { make(<variably-typed-field>,
name: ?#"name",
+ init-value: ?init,
getter: ?name,
setter: ?name ## "-setter",
?args), ... }
@@ -90,30 +123,36 @@
getter: ?name,
setter: ?name ## "-setter",
?args), ... }
- { field ?:name \:: ?field-type:name = ?init:expression ; ... }
- => { make(<single-field>,
+ { repeated field ?:name \:: ?field-type:name = ?init:expression, ?args:*; ... }
+ => { make(<repeated-field>,
name: ?#"name",
init-value: ?init,
type: ?field-type,
getter: ?name,
+ setter: ?name ## "-setter",
+ ?args), ... }
+ { ?attributes:* field ?:name \:: ?field-type:name; ... }
+ => { make(?attributes,
+ name: ?#"name",
+ type: ?field-type,
+ getter: ?name,
setter: ?name ## "-setter"), ... }
- { field ?:name \:: ?field-type:name = ?init:expression , ?args:*; ... }
- => { make(<single-field>,
+ { ?attributes:* field ?:name \:: ?field-type:name, ?args:*; ... }
+ => { make(?attributes,
name: ?#"name",
- init-value: ?init,
type: ?field-type,
getter: ?name,
setter: ?name ## "-setter",
?args), ... }
- { variably-typed-field ?:name = ?init:expression , ?args:*; ... }
- => { make(<variably-typed-field>,
+ { ?attributes:* field ?:name \:: ?field-type:name = ?init:expression ; ... }
+ => { make(?attributes,
name: ?#"name",
init-value: ?init,
+ type: ?field-type,
getter: ?name,
- setter: ?name ## "-setter",
- ?args), ... }
- { repeated field ?:name \:: ?field-type:name = ?init:expression, ?args:*; ... }
- => { make(<repeated-field>,
+ setter: ?name ## "-setter"), ... }
+ { ?attributes:* field ?:name \:: ?field-type:name = ?init:expression , ?args:*; ... }
+ => { make(?attributes,
name: ?#"name",
init-value: ?init,
type: ?field-type,
@@ -121,6 +160,10 @@
setter: ?name ## "-setter",
?args), ... }
+ attributes:
+ { } => { <single-field> }
+ { layering } => { <layering-field> }
+
args: //FIXME: better types, not <frame>!
{ } => { }
{ start: ?start:expression, ... }
@@ -155,15 +198,15 @@
{ ?field:*; ... } => { ?field ; ... }
field:
- { field ?:name \:: ?field-type:name ?rest:* }
- => { slot ?name :: false-or(high-level-type(?field-type)) = #f,
- init-keyword: ?#"name" }
{ variably-typed-field ?:name, ?rest:* }
=> { slot ?name :: false-or(<frame>) = #f,
init-keyword: ?#"name" }
{ repeated field ?:name ?rest:* }
=> { slot ?name :: false-or(<collection>) = #f,
init-keyword: ?#"name" }
+ { ?attrs:* field ?:name \:: ?field-type:name ?rest:* }
+ => { slot ?name :: false-or(high-level-type(?field-type)) = #f,
+ init-keyword: ?#"name" }
end;
define macro gen-classes
@@ -376,15 +419,12 @@
end;
define macro frame-field-generator
- { frame-field-generator(?type:name; ?count:expression; field ?field-name:name ?foo:* ; ?rest:*) }
+ { frame-field-generator(?type:name; ?count:expression; ?args:* field ?field-name:name ?foo:* ; ?rest:*) }
=> { unparsed-frame-field-generator(?field-name, ?type, ?count);
frame-field-generator(?type; ?count + 1; ?rest) }
{ frame-field-generator(?type:name; ?count:expression; variably-typed-field ?field-name:name ?foo:* ; ?rest:*) }
=> { unparsed-frame-field-generator(?field-name, ?type, ?count);
frame-field-generator(?type; ?count + 1; ?rest) }
- { frame-field-generator(?type:name; ?count:expression; repeated field ?field-name:name ?foo:* ; ?rest:*) }
- => { unparsed-frame-field-generator(?field-name, ?type, ?count);
- frame-field-generator(?type; ?count + 1; ?rest) }
{ frame-field-generator(?:name; ?count:expression) }
=> { define inline method field-count (type :: subclass(?name)) => (res :: <integer>) ?count end; }
end;
@@ -409,79 +449,34 @@
{ define protocol ?:name (container-frame) end } =>
- { define abstract class "<" ## ?name ## ">" (<container-frame>) end;
+ { //protocol-module-definer(?name; container-frame; );
+ define abstract class "<" ## ?name ## ">" (<container-frame>) end;
define abstract class "<decoded-" ## ?name ## ">"
("<" ## ?name ## ">", <decoded-container-frame>)
end;
gen-classes(?name; container-frame); }
{ define protocol ?:name (?superprotocol:name)
+ over ?super:name ?magic:expression;
?fields:*
end } =>
- { real-class-definer("<" ## ?name ## ">"; "<" ## ?superprotocol ## ">"; ?fields);
+ {
+ define protocol ?name (?superprotocol) ?fields end;
+ stack-protocol(?super, "<" ## ?name ## ">", ?magic);
+ }
+
+ { define protocol ?:name (?superprotocol:name)
+ ?fields:*
+ end } =>
+ { //protocol-module-definer(?name; ?superprotocol; ?fields);
+ real-class-definer("<" ## ?name ## ">"; "<" ## ?superprotocol ## ">"; ?fields);
decoded-class-definer("<decoded-" ## ?name ## ">";
"<" ## ?name ## ">", "<decoded-" ## ?superprotocol ## ">";
?fields);
gen-classes(?name; ?superprotocol);
frame-field-generator("<unparsed-" ## ?name ## ">";
field-count("<unparsed-" ## ?superprotocol ## ">");
- ?fields); }
-end;
-
-define macro forward-bonding
- { forward-bonding(?:name; ?field:expression; ?bondings:*) }
- => { define inline method payload-type (frame :: ?name) => (res :: <type>)
- select (frame.?field)
- ?bondings;
- otherwise => <raw-frame>;
- end;
- end; }
-end;
-
-define macro reverse-bonding
- { reverse-bonding(?:name; ?field:expression; ?bondings:*) }
- => { define inline method get-protocol-magic (frame :: ?name, payload :: <frame>)
- let value =
- select (payload.object-class)
- ?bondings;
- otherwise =>
- error("Unknown layer bonding tried %= over %=", payload.frame-name, frame.frame-name)
- end;
- values(frame.?field, value)
- end; }
-
- bondings:
- { } => { }
- { ?key:expression => ?value:expression; ... } =>
- { ?value => ?key; ... }
-end;
-define macro layer-bonding-definer
- { define layer-bonding ?:name (?field:expression)
- ?bondings:*
- end } =>
- { forward-bonding(?name; ?field; ?bondings);
- reverse-bonding(?name; ?field; ?bondings); }
-end;
-
-define macro leaf-frame-constructor-definer
- { define leaf-frame-constructor(?:name) end }
- =>
- {
- define method ?name (data :: <byte-vector>)
- => (res :: "<" ## ?name ## ">");
- parse-frame("<" ## ?name ## ">", data)
- end;
-
- define method ?name (data :: <collection>)
- => (res :: "<" ## ?name ## ">");
- ?name(as(<byte-vector>, data))
- end;
-
- define method ?name (data :: <string>)
- => (res :: "<" ## ?name ## ">");
- read-frame("<" ## ?name ## ">", data)
- end;
-
- }
+ ?fields);
+ }
end;
Modified: trunk/libraries/pcap/library.dylan
==============================================================================
--- trunk/libraries/pcap/library.dylan (original)
+++ trunk/libraries/pcap/library.dylan Tue Nov 14 23:28:21 2006
@@ -11,6 +11,8 @@
use flow;
use packetizer;
+ use protocols, import: { ethernet };
+
export interfaces;
end;
@@ -24,6 +26,7 @@
use machine-words;
use byte-vector;
use flow;
+ use ethernet, import: { <ethernet-frame> };
use packetizer,
import: { parse-frame,
<ethernet-frame>,
Copied: trunk/libraries/protocols/dns.dylan (from r10947, trunk/libraries/packetizer/dns.dylan)
==============================================================================
--- trunk/libraries/packetizer/dns.dylan (original)
+++ trunk/libraries/protocols/dns.dylan Tue Nov 14 23:28:21 2006
@@ -1,4 +1,4 @@
-module: packetizer
+module: dns
Author: Andreas Bogk, Hannes Mehnert
Copyright: (C) 2005, 2006, All rights reserved. Free for non-commercial use.
@@ -36,7 +36,7 @@
define protocol domain-name (container-frame)
repeated field fragment :: <domain-name-fragment>,
- reached-end?: frame.type-code = 3 | frame.length = 0;
+ reached-end?: frame.type-code = 3 | frame.data-length = 0;
end;
define method as (class == <string>, domain-name :: <domain-name>)
@@ -91,29 +91,11 @@
end;
end;
-define class <externally-delimited-string> (<variable-size-byte-vector>)
-end;
-
-define method as (class == <string>, frame :: <externally-delimited-string>)
- => (res :: <string>)
- let res = make(<string>, size: byte-offset(frame-size(frame)));
- copy-bytes(frame.data, 0, res, 0, byte-offset(frame-size(frame)));
- res;
-end;
-
-define method as (class == <externally-delimited-string>, string :: <string>)
- => (res :: <externally-delimited-string>)
- let res = make(<externally-delimited-string>,
- data: make(<byte-sequence>, capacity: string.size));
- copy-bytes(string, 0, res.data, 0, string.size);
- res;
-end;
-
define protocol label (domain-name-fragment)
- field length :: <6bit-unsigned-integer>,
+ field data-length :: <6bit-unsigned-integer>,
fixup: frame.raw-data.frame-size.byte-offset;
field raw-data :: <externally-delimited-string>,
- length: frame.length * 8;
+ length: frame.data-length * 8;
end;
define method as (class == <string>, label :: <label>)
@@ -197,9 +179,9 @@
end;
define protocol character-string (container-frame)
- field length :: <unsigned-byte>;
- field data :: <externally-delimited-string>,
- length: frame.length * 8;
+ field data-length :: <unsigned-byte>;
+ field string-data :: <externally-delimited-string>,
+ length: frame.data-length * 8;
end;
define protocol host-information (container-frame)
@@ -218,6 +200,6 @@
end;
define protocol text-strings (container-frame)
- field data :: <character-string>;
+ field text-data :: <character-string>;
end;
Copied: trunk/libraries/protocols/ethernet.dylan (from r10947, trunk/libraries/packetizer/ethernet.dylan)
==============================================================================
--- trunk/libraries/packetizer/ethernet.dylan (original)
+++ trunk/libraries/protocols/ethernet.dylan Tue Nov 14 23:28:21 2006
@@ -1,4 +1,4 @@
-module: packetizer
+module: ethernet
Author: Andreas Bogk, Hannes Mehnert
Copyright: (C) 2005, 2006, All rights reserved. Free for non-commercial use.
@@ -41,13 +41,8 @@
source-address, destination-address, compose(summary, payload);
field destination-address :: <mac-address>;
field source-address :: <mac-address>;
- field type-code :: <2byte-big-endian-unsigned-integer>;
+ layering field type-code :: <2byte-big-endian-unsigned-integer>;
variably-typed-field payload,
type-function: payload-type(frame);
end;
-define layer-bonding <ethernet-frame> (type-code)
- #x800 => <ipv4-frame>;
- #x806 => <arp-frame>
-end;
-
Copied: trunk/libraries/protocols/ieee80211.dylan (from r10947, trunk/libraries/packetizer/ieee80211.dylan)
==============================================================================
--- trunk/libraries/packetizer/ieee80211.dylan (original)
+++ trunk/libraries/protocols/ieee80211.dylan Tue Nov 14 23:28:21 2006
@@ -1,4 +1,4 @@
-module: packetizer
+module: ieee80211
Author: Andreas Bogk, Hannes Mehnert, mb
Copyright: (C) 2005, 2006, All rights reserved. Free for non-commercial use.
@@ -48,7 +48,6 @@
define constant $information-element-ibss = 6;
define constant $information-element-challenge-text = 16;
-define n-byte-vector(wlan-device-name, 16) end;
define n-byte-vector(timestamp, 8) end;
define n-bit-unsigned-integer(<11bit-unsigned-integer>; 11) end;
define n-bit-unsigned-integer(<12bit-unsigned-integer>; 12) end;
@@ -69,18 +68,18 @@
// ieee80211 information fields
define protocol ieee80211-information-field (container-frame)
- field length :: <unsigned-byte>,
- fixup: byte-offset(frame-size(frame.data));
+ field data-length :: <unsigned-byte>,
+ fixup: byte-offset(frame-size(frame.raw-data));
end;
define protocol ieee80211-raw-information-field (ieee80211-information-field)
- field data :: <raw-frame>,
+ field raw-data :: <raw-frame>,
length: frame.length * 8;
end;
define protocol ieee80211-ssid (ieee80211-information-field)
- summary "SSID: %=", data;
- field data :: <externally-delimited-string>,
+ summary "SSID: %=", raw-data;
+ field raw-data :: <externally-delimited-string>,
length: frame.length * 8;
end;
@@ -105,7 +104,7 @@
define protocol ieee80211-supported-rates (ieee80211-information-field)
repeated field supported-rate :: <rate>,
reached-end?: #f,
- length: frame.length * 8;
+ length: frame.data-length * 8;
end;
define method summary (frame :: <rate>) => (res :: <string>)
@@ -327,7 +326,7 @@
define protocol ieee80211-frame-control (container-frame)
summary "WEP: %=", wep;
field subtype :: <4bit-unsigned-integer>;
- field type :: <2bit-unsigned-integer>;
+ field ftype :: <2bit-unsigned-integer>;
field protcol-version :: <2bit-unsigned-integer>;
field order :: <1bit-unsigned-integer>;
field wep :: <1bit-unsigned-integer>;
Copied: trunk/libraries/protocols/ipv4.dylan (from r10947, trunk/libraries/packetizer/ipv4.dylan)
==============================================================================
--- trunk/libraries/packetizer/ipv4.dylan (original)
+++ trunk/libraries/protocols/ipv4.dylan Tue Nov 14 23:28:21 2006
@@ -1,4 +1,4 @@
-module: packetizer
+module: ipv4
Author: Andreas Bogk, Hannes Mehnert
Copyright: (C) 2005, 2006, All rights reserved. Free for non-commercial use.
@@ -45,8 +45,8 @@
end;
define protocol router-alert-ip-option (ip-option-frame)
- field length :: <unsigned-byte> = 4;
- field value :: <2byte-big-endian-unsigned-integer>;
+ field router-alert-length :: <unsigned-byte> = 4;
+ field router-alert-data :: <2byte-big-endian-unsigned-integer>;
end;
define protocol end-of-option-ip-option (ip-option-frame)
@@ -56,7 +56,7 @@
end;
define protocol security-ip-option-frame (ip-option-frame)
- field length :: <unsigned-byte>;
+ field security-length :: <unsigned-byte>;
field security :: <2byte-big-endian-unsigned-integer>;
field compartments :: <2byte-big-endian-unsigned-integer>;
field handling-restrictions :: <2byte-big-endian-unsigned-integer>;
@@ -112,6 +112,8 @@
define protocol ipv4-frame (header-frame)
summary "IP SRC %= DST %=/%s",
source-address, destination-address, compose(summary, payload);
+ over <ethernet-frame> #x800;
+ over <link-control> #x800;
field version :: <4bit-unsigned-integer> = 4;
field header-length :: <4bit-unsigned-integer>,
fixup: ceiling/(reduce(\+, 20, map(method(x) byte-offset(frame-size(x)) end, frame.options)), 4);
@@ -124,7 +126,7 @@
field more-fragments :: <1bit-unsigned-integer> = 0;
field fragment-offset :: <13bit-unsigned-integer> = 0;
field time-to-live :: <unsigned-byte> = 64;
- field protocol :: <unsigned-byte>;
+ layering field protocol :: <unsigned-byte>;
field header-checksum :: <2byte-big-endian-unsigned-integer> = 0;
field source-address :: <ipv4-address>;
field destination-address :: <ipv4-address>;
@@ -136,16 +138,11 @@
type-function: payload-type(frame);
end;
-define layer-bonding <ipv4-frame> (protocol)
- 1 => <icmp-frame>;
- 6 => <tcp-frame>;
- 17 => <udp-frame>
-end;
-
define protocol icmp-frame (header-frame)
- summary "ICMP type %= code %=", type, code;
- field type :: <unsigned-byte>;
+ summary "ICMP type %= code %=", icmp-type, code;
+ over <ipv4-frame> 1;
+ field icmp-type :: <unsigned-byte>;
field code :: <unsigned-byte>;
field checksum :: <2byte-big-endian-unsigned-integer> = 0;
field payload :: <raw-frame>;
@@ -153,17 +150,18 @@
define protocol udp-frame (header-frame)
summary "UDP port %= -> %=/%s", source-port, destination-port, compose(summary, payload);
+ over <ipv4-frame> 17;
field source-port :: <2byte-big-endian-unsigned-integer>;
field destination-port :: <2byte-big-endian-unsigned-integer>;
- field length :: <2byte-big-endian-unsigned-integer>,
+ field payload-size :: <2byte-big-endian-unsigned-integer>,
fixup: byte-offset(frame-size(frame.payload)) + 8;
field checksum :: <2byte-big-endian-unsigned-integer> = 0;
variably-typed-field payload,
- end: frame.length * 8,
+ end: frame.payload-size * 8,
type-function: payload-type(frame);
end;
-define inline method payload-type (frame :: <udp-frame>) => (res :: <type>)
+/*define inline method payload-type (frame :: <udp-frame>) => (res :: <type>)
select (frame.source-port)
53 => <dns-frame>;
5353 => <dns-frame>;
@@ -174,12 +172,10 @@
end;
end;
end;
-
-// FIXME: must do for now
-define n-byte-vector(big-endian-unsigned-integer-4byte, 4) end;
-
+*/
define protocol tcp-frame (header-frame)
summary "TCP %s port %= -> %=", flags-summary, source-port, destination-port;
+ over <ipv4-frame> 6;
field source-port :: <2byte-big-endian-unsigned-integer>;
field destination-port :: <2byte-big-endian-unsigned-integer>;
field sequence-number :: <big-endian-unsigned-integer-4byte>;
@@ -207,7 +203,7 @@
field reserved :: <unsigned-byte> = 0;
field protocol :: <unsigned-byte> = 6;
field segment-length :: <2byte-big-endian-unsigned-integer>;
- field data :: <raw-frame>,
+ field pseudo-header-data :: <raw-frame>,
length: frame.segment-length;
end;
@@ -217,7 +213,7 @@
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));
+ pseudo-header-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();
@@ -231,6 +227,8 @@
end;
define protocol arp-frame (container-frame)
+ over <ethernet-frame> #x806;
+ over <link-control> #x806;
field mac-address-type :: <2byte-big-endian-unsigned-integer> = 1;
field protocol-address-type :: <2byte-big-endian-unsigned-integer> = #x800;
field mac-address-size :: <unsigned-byte> = byte-offset(field-size(<mac-address>));
Copied: trunk/libraries/protocols/logical-link.dylan (from r10947, trunk/libraries/packetizer/logical-link.dylan)
==============================================================================
--- trunk/libraries/packetizer/logical-link.dylan (original)
+++ trunk/libraries/protocols/logical-link.dylan Tue Nov 14 23:28:21 2006
@@ -1,4 +1,4 @@
-module: packetizer
+module: logical-link
Author: Andreas Bogk, Hannes Mehnert
Copyright: (C) 2005, 2006, All rights reserved. Free for non-commercial use.
@@ -13,8 +13,3 @@
type-function: payload-type(frame);
end;
-define layer-bonding <link-control> (type-code)
- #x800 => <ipv4-frame>;
- #x806 => <arp-frame>
-end;
-
Copied: trunk/libraries/protocols/pcap.dylan (from r10947, trunk/libraries/packetizer/pcap.dylan)
==============================================================================
--- trunk/libraries/packetizer/pcap.dylan (original)
+++ trunk/libraries/protocols/pcap.dylan Tue Nov 14 23:28:21 2006
@@ -1,4 +1,4 @@
-module: packetizer
+module: pcap
Author: Andreas Bogk, Hannes Mehnert
Copyright: (C) 2005, 2006, All rights reserved. Free for non-commercial use.
@@ -6,8 +6,6 @@
define constant $DLT-EN10MB = 1;
define constant $DLT-PRISM-HEADER = 119;
-//FIXME
-define n-byte-vector(little-endian-unsigned-integer-4byte, 4) end;
define protocol pcap-file-header (container-frame)
field magic :: <little-endian-unsigned-integer-4byte>
@@ -24,69 +22,12 @@
field last-linktype :: <unsigned-byte> = 0;
end;
-define function int-to-byte-vector (int :: <integer>) => (res :: <byte-vector>)
- let res = make(<byte-vector>, size: 4);
- for (i from 0 below 4)
- res[i] := logand(#xff, ash(int, - i * 8));
- end;
- res;
-end;
-
-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)
- let (this, remainder) = floor/(r, 256);
- r := this;
- res[i] := floor(remainder);
- end;
- res;
-end;
define protocol unix-time-value (container-frame)
field seconds :: <little-endian-unsigned-integer-4byte>;
field microseconds :: <little-endian-unsigned-integer-4byte>;
end;
-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;
- end;
- 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;
- for (ele in reverse(bv))
- if (first?)
- first? := #f
- else
- res := ele + 256 * res;
- end;
- end;
- res;
-end;
define method decode-unix-time (unix-time :: <unix-time-value>)
=> (res :: <date>)
@@ -95,7 +36,7 @@
let (hours, rem1) = floor/(rem0, 3600);
let (minutes, seconds) = floor/(rem1, 60);
encode-day/time-duration(days, hours, minutes, round(seconds),
- byte-vector-to-int(unix-time.microseconds.data))
+ floor/(byte-vector-to-float-le(unix-time.microseconds.data), 1))
+ make(<date>, year: 1970, month: 1, day: 1)
end;
@@ -105,17 +46,17 @@
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-le(secs)),
- microseconds: little-endian-unsigned-integer-4byte(int-to-byte-vector(microseconds)));
+ microseconds: little-endian-unsigned-integer-4byte(float-to-byte-vector-le(as(<double-float>, microseconds))));
end;
define protocol pcap-packet (header-frame)
field timestamp :: <unix-time-value>
= make-unix-time(current-date() - make(<date>, year: 1970, month: 1, day: 1));
field capture-length :: <3byte-little-endian-unsigned-integer>,
- fixup: byte-offset(frame-size(frame.payload));
+ fixup: size(frame.payload.packet);
field last-capture-length :: <unsigned-byte> = 0;
field packet-length :: <3byte-little-endian-unsigned-integer>,
- fixup: byte-offset(frame-size(frame.payload));
+ fixup: size(frame.payload.packet);
field last-packet-length :: <unsigned-byte> = 0;
variably-typed-field payload,
type-function: select (frame.parent.header.linktype)
Copied: trunk/libraries/protocols/prism2.dylan (from r10947, trunk/libraries/packetizer/prism2.dylan)
==============================================================================
--- trunk/libraries/packetizer/prism2.dylan (original)
+++ trunk/libraries/protocols/prism2.dylan Tue Nov 14 23:28:21 2006
@@ -1,4 +1,4 @@
-module: packetizer
+module: prism2
Author: Andreas Bogk, Hannes Mehnert, mb
Copyright: (C) 2005, 2006, All rights reserved. Free for non-commercial use.
@@ -9,10 +9,12 @@
field item-data :: <little-endian-unsigned-integer-4byte>;
end;
+define n-byte-vector(wlan-device-name, 16) end;
+
define protocol prism2-frame (header-frame)
summary "PRISM2/%s", compose(summary, payload);
field message-code :: <little-endian-unsigned-integer-4byte>;
- field messsage-len :: <little-endian-unsigned-integer-4byte>;
+ field message-len :: <little-endian-unsigned-integer-4byte>;
field device-name :: <wlan-device-name>;
field host-time :: <prism2-header-item>;
field mac-time :: <prism2-header-item>;
@@ -24,5 +26,5 @@
field rate :: <prism2-header-item>;
field istx :: <prism2-header-item>;
field frame-length :: <prism2-header-item>;
- field payload :: <ieee80211-frame>;
+ field payload :: <raw-frame>; //<ieee80211-frame>;
end;
Added: trunk/libraries/protocols/protocols-library.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/protocols/protocols-library.dylan Tue Nov 14 23:28:21 2006
@@ -0,0 +1,351 @@
+module: dylan-user
+
+define library protocols
+ use common-dylan;
+ use system;
+ use packetizer;
+ use io;
+ export logical-link,
+ ethernet,
+ pcap,
+ ipv4,
+ prism2,
+ dns;
+end;
+
+define module logical-link
+ use dylan;
+ use packetizer;
+
+ export <link-control>,
+ dsap, dsap-setter,
+ ssap, ssap-setter,
+ control, control-setter,
+ organisation-code, organisation-code-setter,
+ type-code, type-code-setter;
+end;
+
+define module ethernet
+ use common-dylan;
+ use packetizer;
+
+ use common-extensions;
+
+ export <ethernet-frame>,
+ type-code, type-code-setter;
+
+ export <mac-address>, mac-address;
+end;
+
+define module prism2
+ use dylan;
+ use packetizer;
+
+ export <prism2-header-item>,
+ item-did, item-did-setter,
+ item-status, item-status-setter,
+ item-length, item-length-setter,
+ item-data, item-data-setter;
+
+ export wlan-device-name, <wlan-device-name>;
+
+ export <prism2-frame>,
+ message-code, message-code-setter,
+ message-len, message-len-setter,
+ device-name, device-name-setter,
+ host-time, host-time-setter,
+ mac-time, mac-time-setter,
+ channel, channel-setter,
+ rssi, rssi-setter,
+ sq, sq-setter,
+ signal-level, signal-level-setter,
+ noise-level, noise-level-setter,
+ rate, rate-setter,
+ istx, istx-setter,
+ frame-length, frame-length-setter;
+end;
+
+define module pcap
+ use dylan;
+ use packetizer;
+ use date;
+
+ use ethernet, import: { <ethernet-frame> };
+ use prism2, import: { <prism2-frame> };
+
+ export <pcap-file-header>,
+ magic, magic-setter,
+ major-version, major-version-setter,
+ minor-version, minor-version-setter,
+ timezone-offset, timezone-offset-setter,
+ sigfigs, sigfigs-setter,
+ snap-length, snap-length-setter,
+ linktype, linktype-setter;
+
+ export <pcap-packet>,
+ timestamp, timestamp-setter,
+ capture-length, capture-length-setter,
+ packet-length, packet-length-setter;
+
+ export <pcap-file>,
+ header, header-setter,
+ packets, packets-setter;
+
+ export make-unix-time, decode-unix-time;
+
+ export <unix-time-value>,
+ seconds, seconds-setter,
+ microseconds, microseconds-setter;
+
+end;
+
+define module ipv4
+ use common-dylan, exclude: { format-to-string };
+ use packetizer;
+ use streams-protocol;
+ use format;
+
+ use ethernet, import: { <ethernet-frame>, <mac-address> };
+ use logical-link, import: { <link-control> };
+
+ export <ip-option-type-frame>,
+ flag, flag-setter,
+ class, class-setter,
+ number, number-setter;
+
+ export <ip-option-frame>,
+ option-type, option-type-setter;
+
+ export <router-alert-ip-option>,
+ router-alert-length, router-alert-length-setter,
+ router-alert-value, router-alert-value-setter;
+
+ export <end-of-option-ip-option>;
+
+ export <no-operation-ip-option>;
+
+ export <security-ip-option-frame>,
+ security-length, security-length-setter,
+ security, security-setter,
+ compartments, compartments-setter,
+ handling-restrictions, handling-restrictions-setter,
+ transmission-control-code, transmission-control-code-setter;
+
+ export <ipv4-address>, ipv4-address;
+
+ export <ipv4-frame>,
+ version, version-setter,
+ header-length, header-length-setter,
+ type-of-service, type-of-service-setter,
+ total-length, total-length-setter,
+ identification, identification-setter,
+ evil, evil-setter,
+ dont-fragment, dont-fragment-setter,
+ more-fragments, more-fragments-setter,
+ fragment-offset, fragment-offset-setter,
+ time-to-live, time-to-live-setter,
+ protocol, protocol-setter,
+ header-checksum, header-checksum-setter,
+ options, options-setter;
+
+ export <icmp-frame>,
+ icmp-type, icmp-type-setter,
+ code, code-setter,
+ checksum, checksum-setter;
+
+ export <udp-frame>,
+ source-port, source-port-setter,
+ destination-port, destination-port-setter,
+ payload-size, payload-size-setter,
+ checksum, checksum-setter;
+
+ export <tcp-frame>,
+ source-port, source-port-setter,
+ destination-port, destination-port-setter,
+ sequence-number, sequence-number-setter,
+ acknowledgement-number, acknowledgement-number-setter,
+ data-offset, data-offset-setter,
+ reserved, reserved-setter,
+ urg, urg-setter,
+ ack, ack-setter,
+ psh, psh-setter,
+ rst, rst-setter,
+ syn, syn-setter,
+ fin, fin-setter,
+ window, window-setter,
+ checksum, checksum-setter,
+ urgent-pointer, urgent-pointer-setter,
+ options-and-padding, options-and-padding-setter;
+
+ export <pseudo-header>,
+ reserved, reserved-setter,
+ protocol, protocol-setter,
+ segment-length, segment-length-setter,
+ pseudo-header-data, pseudo-header-data-setter;
+
+ export <arp-frame>,
+ mac-address-type, mac-address-type-setter,
+ protocol-address-type, protocol-address-type-setter,
+ mac-address-size, mac-address-size-setter,
+ protocol-address-size, protocol-address-size-setter,
+ operation, operation-setter,
+ source-mac-address, source-mac-address-setter,
+ source-ip-address, source-ip-address-setter,
+ target-mac-address, target-mac-address-setter,
+ target-ip-address, target-ip-address-setter;
+end;
+
+define module dns
+ use common-dylan;
+ use packetizer;
+ use byte-vector, import: { copy-bytes };
+ use simple-io;
+ use ipv4, import: { <ipv4-address> };
+
+ export <dns-frame>,
+ identifier, identifier-setter,
+ query-or-response, query-or-response-setter,
+ opcode, opcode-setter,
+ authoritative-answer, authoritative-answer-setter,
+ truncation, truncation-setter,
+ recursion-desired, recursion-desired-setter,
+ recursion-available, recursion-available-setter,
+ reserved, reserved-setter,
+ response-code, response-code-setter,
+ question-count, question-count-setter,
+ answer-count, answer-count-setter,
+ additional-count, additional-count-setter,
+ questions, questions-setter,
+ answers, answers-setter,
+ name-servers, name-servers-setter,
+ additional-records, additional-records-setter;
+
+ export <domain-name>,
+ fragment, fragment-setter;
+
+ export <domain-name-fragment>,
+ type-code, type-code-setter,
+ <label-offset>, offset, offset-setter,
+ <label>, data-length, data-length-setter, raw-data, raw-data-setter;
+
+ export <dns-question>,
+ domainname, domainname-setter,
+ question-type, question-type-setter,
+ question-class, question-class-setter;
+
+ export <dns-resource-record>,
+ domainname, domainname-setter,
+ rr-type, rr-type-setter,
+ rr-class, rr-class-setter,
+ ttl, ttl-setter,
+ rdlength, rdlength-setter,
+ rdata, rdata-setter;
+
+ export <a-host-address>,
+ ipv4-address, ipv4-address-setter;
+
+ export <name-server>,
+ ns-name, ns-name-setter;
+
+ export <canonical-name>,
+ cname, cname-setter;
+
+ export <start-of-authority>,
+ nameserver, nameserver-setter,
+ hostmaster, hostmaster-setter,
+ serial, serial-setter,
+ refresh, refresh-setter,
+ retry, retry-setter,
+ expire, expire-setter,
+ minimum, minimum-setter;
+
+ export <domain-name-pointer>,
+ ptr-name, ptr-name-setter;
+
+ export <character-string>,
+ data-length, data-length-setter,
+ string-data, string-data-setter;
+
+ export <host-information>,
+ cpu, cpu-setter,
+ operating-system, operating-system-setter;
+
+ export <mail-exchange>,
+ preference, preference-setter,
+ exchange, exchange-setter;
+
+ export <text-strings>,
+ text-data, text-data-setter;
+end;
+
+
+define module ieee80211
+ use dylan;
+ use packetizer;
+
+ use prism2, import: { <wlan-device-name> };
+ use ethernet, import: { <mac-address> };
+ use logical-link, import: { <link-control> };
+/*
+ export <ieee80211-sequence-control>,
+ sequence-number, sequence-number-setter,
+ fragment-number, fragment-number-setter;
+
+ export <ieee80211-capability-information>,
+ reserved, reserved-setter,
+ privacy, privacy-setter,
+ cf-poll-request, cf-poll-request-setter,
+ cl-pollable, cf-pollable-setter,
+ ibss, ibss-setter,
+ ess, ess-setter;
+
+ export <ieee80211-information-field>,
+ length, length-setter;
+
+ export <ieee80211-raw-information-field>,
+ data, data-setter;
+
+ export <ieee80211-ssid>,
+ data, data-setter;
+
+ export <ieee80211-fh-set>,
+ <ieee80211-ds-set>,
+ <ieee80211-cf-set>,
+ <ieee80211-tim>,
+ <ieee80211-ibss>,
+ <ieee80211-challenge-text>,
+ <ieee80211-supported-rates>,
+ supported-rate, supported-rate-setter;
+
+ export <rate>,
+ bss-basic-set?, bss-basic-set?-setter,
+ real-rate, real-rate-setter;
+
+ export <basic-set-rate>,
+ <extended-rate>;
+
+ export <ieee80211-reserved-field>,
+ <ieee80211-information-field>,
+ element-id, element-id-setter,
+ information-field, information-field-setter;
+
+ export <ieee80211-management-frame>,
+ duration, duration-setter,
+ bssid, bssid-setter,
+ sequence-control, sequence-control-setter;
+
+ export <ieee80211-disassociation>,
+ reason-code, reason-code-setter;
+
+ export <ieee80211-association-request>,
+ capability-information, capability-information-setter,
+ listen-interval, listen-interval-setter,
+ ssid, ssid-setter,
+ supported-rates, supported-rates-setter;
+
+ export <ieee80211-association-response>,
+ ca
+*/
+end;
+
+
Added: trunk/libraries/protocols/protocols.hdp
==============================================================================
--- (empty file)
+++ trunk/libraries/protocols/protocols.hdp Tue Nov 14 23:28:21 2006
@@ -0,0 +1,9 @@
+library: protocols
+files: protocols-library
+ logical-link
+ ethernet
+ ipv4
+ dns
+ prism2
+ pcap
+ ieee80211
\ No newline at end of file
Added: trunk/libraries/registry/generic/protocols
==============================================================================
--- (empty file)
+++ trunk/libraries/registry/generic/protocols Tue Nov 14 23:28:21 2006
@@ -0,0 +1 @@
+abstract://dylan/protocols/protocols.hdp
More information about the chatter
mailing list