[Gd-chatter] r11669 - in trunk/libraries: gui-sniffer layer network/ip-stack/state-machines/ppp packetizer protocols registry/generic utilities/state-machine
andreas at gwydiondylan.org
andreas at gwydiondylan.org
Thu Feb 7 01:28:41 CET 2008
Author: andreas
Date: Thu Feb 7 01:28:39 2008
New Revision: 11669
Added:
trunk/libraries/layer/ppp.dylan (contents, props changed)
trunk/libraries/network/ip-stack/state-machines/ppp/
trunk/libraries/network/ip-stack/state-machines/ppp/library.dylan (contents, props changed)
trunk/libraries/network/ip-stack/state-machines/ppp/ppp.dylan (contents, props changed)
trunk/libraries/network/ip-stack/state-machines/ppp/ppp.hdp (contents, props changed)
trunk/libraries/registry/generic/ppp-state-machine (contents, props changed)
Modified:
trunk/libraries/gui-sniffer/commands.dylan
trunk/libraries/layer/dhcp.dylan
trunk/libraries/layer/layer.hdp
trunk/libraries/layer/library.dylan
trunk/libraries/layer/module.dylan
trunk/libraries/packetizer/leaf-frames.dylan
trunk/libraries/protocols/ppp.dylan
trunk/libraries/protocols/pppoe.dylan
trunk/libraries/protocols/protocols-library.dylan
trunk/libraries/utilities/state-machine/state-machine.dylan
Log:
job: 7299
* State machine for PPPoE client
* PPPoE client layer implementation
* pppoe-client command for gui-sniffer
Modified: trunk/libraries/gui-sniffer/commands.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/commands.dylan (original)
+++ trunk/libraries/gui-sniffer/commands.dylan Thu Feb 7 01:28:39 2008
@@ -109,6 +109,21 @@
process-event(dhcp, #"send-discover");
end;
+define class <pppoe-client-command> (<basic-command>)
+end;
+
+define command-line pppoe-client => <pppoe-client-command>
+ (summary: "Aquire PPPoE session.",
+ documentation: "Initiates a PPPoE client session, and aborts.")
+end;
+
+define method do-execute-command (context :: <nnv-context>, command :: <pppoe-client-command>)
+ let socket = create-socket(context.nnv-context.ethernet-layer, #x8863);
+ let pppoe = make(<pppoe-client>, send-socket: socket);
+ connect(socket.decapsulator, pppoe);
+ process-event(pppoe, #"padi-sent");
+end;
+
define class <set-ip-address-command> (<basic-command>)
constant slot %address :: <cidr>, required-init-keyword: address:;
end;
@@ -237,6 +252,7 @@
documentation: "The set of commands for managing the network.")
command ping;
command dhcp-client;
+ command pppoe-client;
command resolve;
command set-ip-address;
command add-route;
Modified: trunk/libraries/layer/dhcp.dylan
==============================================================================
--- trunk/libraries/layer/dhcp.dylan (original)
+++ trunk/libraries/layer/dhcp.dylan Thu Feb 7 01:28:39 2008
@@ -75,7 +75,6 @@
new-state :: <requesting>) => ()
// if (matches-requirements?(state.offer))
let server-option = find-option(state.offer, <dhcp-server-identifier-option>);
- //XXX: somehow the #"dhcprequest" doesn't work here :/
let options = list(make(<dhcp-message-type-option>,
message-type: #"dhcprequest"),
make(<dhcp-requested-ip-address-option>,
Modified: trunk/libraries/layer/layer.hdp
==============================================================================
--- trunk/libraries/layer/layer.hdp (original)
+++ trunk/libraries/layer/layer.hdp Thu Feb 7 01:28:39 2008
@@ -4,4 +4,5 @@
layer
tcp
udp
- dhcp
\ No newline at end of file
+ dhcp
+ ppp
\ No newline at end of file
Modified: trunk/libraries/layer/library.dylan
==============================================================================
--- trunk/libraries/layer/library.dylan (original)
+++ trunk/libraries/layer/library.dylan Thu Feb 7 01:28:39 2008
@@ -16,6 +16,7 @@
use state-machine;
use protocols;
use dhcp-state-machine;
+ use ppp-state-machine;
// 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 Thu Feb 7 01:28:39 2008
@@ -25,6 +25,8 @@
use bittorrent;
use dhcp;
use dhcp-state-machine;
+ use ppp-state-machine;
+ use pppoe;
use tcp;
use icmp;
use ethernet;
@@ -62,4 +64,6 @@
<tcp-layer>;
export <dhcp-client>, find-option;
+
+ export <pppoe-client>;
end module layer;
Added: trunk/libraries/layer/ppp.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/layer/ppp.dylan Thu Feb 7 01:28:39 2008
@@ -0,0 +1,61 @@
+module: layer
+
+define class <pppoe-client> (<filter>, <pppoe-client-abstract-state-machine>)
+ slot send-socket, init-keyword: send-socket:;
+ slot host-id :: <raw-frame>;
+ slot offer;
+ slot my-session-id :: <integer>;
+end;
+
+
+define method push-data-aux (input :: <push-input>,
+ node :: <pppoe-client>,
+ frame :: <pppoe-discovery>)
+ if (instance?(node.state, <padi-sent>))
+ if (frame.pppoe-code == #"PADO (PPPoE Active Discovery Offer)")
+ node.offer := frame;
+ process-event(node, #"pado-received");
+ process-event(node, #"padr-sent");
+ end;
+ end;
+ if (instance?(node.state, <padr-sent>))
+ if (frame.pppoe-code == #"PADS (PPPoE Active Discovery Session-confirmation)")
+ node.my-session-id := frame.session-id;
+ process-event(node, #"valid-pads-received");
+ process-event(node, #"abort");
+ end;
+ end;
+ if (instance?(node.state, <established>))
+ if (frame.pppoe-code == #"PADT (PPPoE Active Discovery Termination)")
+ process-event(node, #"padt-received");
+ end;
+ end;
+end;
+
+
+define method state-transition (node :: <pppoe-client>,
+ old-state :: <closed>,
+ new-state :: <padi-sent>) => ()
+ let id = as(<raw-frame>, list(random(2 ^ 8 - 1), random(2 ^ 8 - 1), 23, 42));
+ node.host-id := id;
+ let pppoe-discovery = pppoe-discovery(pppoe-code: #"PADI (PPPoE Active Discovery Initiation)",
+ pppoe-tags: list(pppoe-service-name(),
+ pppoe-host-uniq(custom-data: id)));
+ send(node.send-socket, $broadcast-ethernet-address, pppoe-discovery);
+end;
+define method state-transition (node :: <pppoe-client>,
+ old-state :: <pado-received>,
+ new-state :: <padr-sent>) => ()
+ let pppoe = pppoe-discovery(pppoe-code: #"PADR (PPPoE Active Discovery Request)",
+ pppoe-tags: node.offer.pppoe-tags);
+ send(node.send-socket, node.offer.parent.source-address, pppoe);
+end;
+
+define method state-transition (node :: <pppoe-client>,
+ old-state :: <established>,
+ new-state :: <closed>) => ()
+ let pppoe = pppoe-discovery(pppoe-code: #"PADT (PPPoE Active Discovery Termination)",
+ session-id: node.my-session-id);
+ send(node.send-socket, node.offer.parent.source-address, pppoe);
+end;
+
Added: trunk/libraries/network/ip-stack/state-machines/ppp/library.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/network/ip-stack/state-machines/ppp/library.dylan Thu Feb 7 01:28:39 2008
@@ -0,0 +1,21 @@
+Module: dylan-user
+Copyright: (c) 2008 Dylan Hackers
+
+define library ppp-state-machine
+ use dylan;
+ use common-dylan;
+ use state-machine;
+ export ppp-state-machine;
+end library;
+
+define module ppp-state-machine
+ use dylan;
+ use common-dylan;
+ use state-machine;
+
+ export <pppoe-client-abstract-state-machine>;
+
+ export <closed>, <padi-sent>,
+ <pado-received>, <padr-sent>,
+ <established>, <pppoe-state>;
+end module;
Added: trunk/libraries/network/ip-stack/state-machines/ppp/ppp.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/network/ip-stack/state-machines/ppp/ppp.dylan Thu Feb 7 01:28:39 2008
@@ -0,0 +1,32 @@
+Module: ppp-state-machine
+Copyright: (c) 2008 Dylan Hackers
+
+define open class <pppoe-client-abstract-state-machine> (<protocol-state-encapsulation>)
+ inherited slot state = make(<closed>);
+end;
+
+define abstract class <pppoe-state> (<protocol-state>) end;
+
+states(<closed>, <padi-sent>, <pado-received>, <padr-sent>, <established>; <pppoe-state>);
+
+define constant <pppoe-events>
+ = one-of(#"padi-sent", #"pado-received", #"padr-sent", #"valid-pads-received",
+ #"invalid-pads-received", #"padt-received", #"abort");
+
+define state-transition-rule <closed> #"padi-sent" <padi-sent> end;
+
+define state-transition-rule <padi-sent> #"pado-received" <pado-received> end;
+
+define state-transition-rule <pado-received> #"padr-sent" <padr-sent> end;
+
+define state-transition-rule <padr-sent> #"valid-pads-received" <established> end;
+
+define state-transition-rule <padr-sent> #"invalid-pads-received" <closed> end;
+
+define state-transition-rule <established> #"padt-received" <closed> end;
+
+define state-transition-rule <pppoe-state> #"abort" <closed> end;
+
+
+
+
Added: trunk/libraries/network/ip-stack/state-machines/ppp/ppp.hdp
==============================================================================
--- (empty file)
+++ trunk/libraries/network/ip-stack/state-machines/ppp/ppp.hdp Thu Feb 7 01:28:39 2008
@@ -0,0 +1,11 @@
+Format-Version: 2
+Library: ppp-state-machine
+Copyright: (c) 2008 Dylan Hackers
+Major-Version: 1
+Minor-Version: 0
+Files: library
+ ppp
+Linker-Options: $(guilflags)
+Compilation-Mode: loose
+Target-Type: dll
+
Modified: trunk/libraries/packetizer/leaf-frames.dylan
==============================================================================
--- trunk/libraries/packetizer/leaf-frames.dylan (original)
+++ trunk/libraries/packetizer/leaf-frames.dylan Thu Feb 7 01:28:39 2008
@@ -97,7 +97,7 @@
string :: <string>)
=> (res)
let res = string-to-integer(string);
- if (res < 0 | res > 2 ^ (field-size(type) - 1))
+ if (res < 0 | res > (2 ^ field-size(type) - 1))
signal(make(<out-of-range-error>))
end;
res;
@@ -192,7 +192,7 @@
string :: <string>)
=> (res)
let res = string-to-integer(string);
- if (res < 0 | res > 2 ^ (field-size(type) - 1))
+ if (res < 0 | res > (2 ^ field-size(type) - 1))
signal(make(<out-of-range-error>))
end;
res;
@@ -368,7 +368,7 @@
string :: <string>)
=> (res)
let res = string-to-integer(string);
- if (res < 0 | res > 2 ^ (field-size(type) - 1))
+ if (res < 0 | res > (2 ^ field-size(type) - 1))
signal(make(<out-of-range-error>))
end;
res;
@@ -426,7 +426,7 @@
string :: <string>)
=> (res)
let res = string-to-integer(string);
- if (res < 0 | res > 2 ^ (field-size(type) - 1))
+ if (res < 0 | res > (2 ^ field-size(type) - 1))
signal(make(<out-of-range-error>))
end;
res;
Modified: trunk/libraries/protocols/ppp.dylan
==============================================================================
--- trunk/libraries/protocols/ppp.dylan (original)
+++ trunk/libraries/protocols/ppp.dylan Thu Feb 7 01:28:39 2008
@@ -215,17 +215,17 @@
define protocol pap-authenticate-ack (pap)
over <pap> 2;
field message-length :: <unsigned-byte>,
- fixup: byte-offset(frame.message);
+ fixup: byte-offset(frame-size(frame.message));
field message :: <externally-delimited-string>,
- length: field.message-length * 8;
+ length: frame.message-length * 8;
end;
define protocol pap-authenticate-nak (pap)
over <pap> 3;
field message-length :: <unsigned-byte>,
- fixup: byte-offset(frame.message);
+ fixup: byte-offset(frame-size(frame.message));
field message :: <externally-delimited-string>,
- length: field.message-length * 8;
+ length: frame.message-length * 8;
end;
define abstract protocol chap (variably-typed-container-frame)
@@ -233,7 +233,8 @@
length frame.chap-length * 8;
layering field chap-code :: <unsigned-byte>;
field chap-identifier :: <unsigned-byte>;
- field chap-length :: <2byte-big-endian-unsigned-integer>;
+ field chap-length :: <2byte-big-endian-unsigned-integer>,
+ fixup: byte-offset(frame-size(frame));
end;
define protocol chap-challenge (chap)
Modified: trunk/libraries/protocols/pppoe.dylan
==============================================================================
--- trunk/libraries/protocols/pppoe.dylan (original)
+++ trunk/libraries/protocols/pppoe.dylan Thu Feb 7 01:28:39 2008
@@ -16,6 +16,7 @@
define protocol pppoe-discovery (container-frame)
over <ethernet-frame> #x8863;
+ summary "PPPoE (session %=) %=", session-id, pppoe-code;
field pppoe-version :: <4bit-unsigned-integer> = 1;
field pppoe-type :: <4bit-unsigned-integer> = 1;
enum field pppoe-code :: <unsigned-byte> = 0,
@@ -24,11 +25,11 @@
#x9 <=> #"PADI (PPPoE Active Discovery Initiation)",
#x19 <=> #"PADR (PPPoE Active Discovery Request)",
#x65 <=> #"PADS (PPPoE Active Discovery Session-confirmation)",
- #xa7 <=> #"PADT (PPPoE Active Discovery Termination" };
+ #xa7 <=> #"PADT (PPPoE Active Discovery Termination)" };
field session-id :: <2byte-big-endian-unsigned-integer> = 0;
field pppoe-length :: <2byte-big-endian-unsigned-integer>,
- fixup: reduce1(\+, map(compose(byte-offset, frame-size),
- frame.pppoe-tags));
+ fixup: reduce(\+, 0, map(compose(byte-offset, frame-size),
+ frame.pppoe-tags));
repeated field pppoe-tags :: <pppoe-tag>,
reached-end?: instance?(frame, <pppoe-end-of-list>);
end;
@@ -46,7 +47,7 @@
define protocol pppoe-service-name (pppoe-tag)
over <pppoe-tag> #x0101;
- field service-name :: <externally-delimited-string>;
+ field service-name :: <externally-delimited-string> = $empty-externally-delimited-string;
end;
define protocol pppoe-access-contentrator-name (pppoe-tag)
Modified: trunk/libraries/protocols/protocols-library.dylan
==============================================================================
--- trunk/libraries/protocols/protocols-library.dylan (original)
+++ trunk/libraries/protocols/protocols-library.dylan Thu Feb 7 01:28:39 2008
@@ -65,7 +65,18 @@
use ethernet, import: { <ethernet-frame> };
use ppp, import: { <ppp> };
- export <pppoe>;
+ export
+ <pppoe-discovery>,
+ pppoe-discovery,
+ pppoe-code,
+ session-id,
+ pppoe-tags,
+
+ pppoe-service-name,
+ pppoe-host-uniq,
+
+ <pppoe-session>,
+ pppoe-session;
end;
define module ieee80211
Added: trunk/libraries/registry/generic/ppp-state-machine
==============================================================================
--- (empty file)
+++ trunk/libraries/registry/generic/ppp-state-machine Thu Feb 7 01:28:39 2008
@@ -0,0 +1 @@
+abstract://dylan/network/ip-stack/state-machines/ppp/ppp.hdp
Modified: trunk/libraries/utilities/state-machine/state-machine.dylan
==============================================================================
--- trunk/libraries/utilities/state-machine/state-machine.dylan (original)
+++ trunk/libraries/utilities/state-machine/state-machine.dylan Thu Feb 7 01:28:39 2008
@@ -43,11 +43,13 @@
end;
define method process-event (dingens :: <protocol-state-encapsulation>, event :: <symbol>)
- let old-state = dingens.state;
- let new-state = next-state(old-state, event);
- //format-out("State transition %= => %=\n", old-state, new-state);
- dingens.state := new-state;
- state-transition(dingens, old-state, new-state);
+ with-lock (dingens.lock)
+ let old-state = dingens.state;
+ let new-state = next-state(old-state, event);
+ //format-out("State transition %= => %=\n", old-state, new-state);
+ dingens.state := new-state;
+ state-transition(dingens, old-state, new-state);
+ end;
end;
define open generic state-transition (dingens :: <protocol-state-encapsulation>,
More information about the chatter
mailing list