[Gd-chatter] r11440 - in trunk/libraries: gui-sniffer layer network-flow packetizer protocols
andreas at gwydiondylan.org
andreas at gwydiondylan.org
Thu Sep 6 00:54:21 CEST 2007
Author: andreas
Date: Thu Sep 6 00:54:20 2007
New Revision: 11440
Modified:
trunk/libraries/gui-sniffer/gui-sniffer.dylan
trunk/libraries/gui-sniffer/library.dylan
trunk/libraries/gui-sniffer/module.dylan
trunk/libraries/layer/layer.dylan
trunk/libraries/layer/module.dylan
trunk/libraries/network-flow/module.dylan
trunk/libraries/packetizer/leaf-frames.dylan
trunk/libraries/protocols/cidr.dylan
Log:
Bug: 7299
packetizer: fix read-frame for <raw-frame>
network-flow: export create-input and create-output for fan-in and fan-out
protocols: work around <cidr> class initialization bug
layer: provide API for build-ethernet-layer, build-ip-layer
introduce raw-sockets
gui-sniffer: "ping source" host, use layer library
Modified: trunk/libraries/gui-sniffer/gui-sniffer.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/gui-sniffer.dylan (original)
+++ trunk/libraries/gui-sniffer/gui-sniffer.dylan Thu Sep 6 00:54:20 2007
@@ -435,7 +435,9 @@
define frame <gui-sniffer-frame> (<simple-frame>, deuce/<basic-editor-frame>, <filter>)
slot network-frames :: <stretchy-vector> = make(<stretchy-vector>);
slot filter-expression = #f;
- slot ethernet-interface = #f;
+ slot ethernet-layer = #f;
+ slot ip-layer = #f;
+ slot listening-socket = #f;
slot first-packet-arrived :: false-or(<date>) = #f;
slot filter-history :: <list> = make(<list>);
@@ -615,12 +617,20 @@
acknowledgement-number: $transform-to-bv(0.0s0))));
end;
+define method ping-source (node :: <gui-sniffer-frame>)
+ let data = current-packet(node);
+ let icmp = make(<icmp-frame>, code: 0, icmp-type: 8,
+ payload: read-frame(<raw-frame>, "123412341234123412341234123412341234123412341234"));
+ send(node.ip-layer, data.payload.source-address, icmp);
+end;
+
define command-table *popup-menu-command-table* (*global-command-table*)
menu-item "Filter Packet-Source" = filter-source;
menu-item "Filter Packet-Destination" = filter-destination;
menu-item "Follow Connection" = follow-connection;
menu-item "Re-inject Packet" = reinject-packet;
menu-item "Kill TCP Connection" = tcpkill;
+ menu-item "Ping Source" = ping-source;
end;
define method display-popup-menu (sheet, target, #key x, y)
@@ -800,14 +810,15 @@
let (interface-name, promiscuous?) = prompt-for-interface(owner: frame);
if (interface-name)
format-out("Listening on interface %=\n", interface-name);
- let interface = make(<ethernet-interface>,
- name: interface-name,
- promiscuous?: promiscuous?);
- connect(interface, frame);
- connect(frame, interface);
+ let ethernet-layer
+ = build-ethernet-layer(interface-name, promiscuous?: promiscuous?);
+ let ethernet-socket = create-raw-socket(ethernet-layer);
+ connect(ethernet-socket, frame);
+ connect(frame, ethernet-socket);
+ frame.ip-layer := build-ip-layer(ethernet-layer);
reinit-gui(frame);
- make(<thread>, function: curry(toplevel, interface));
- frame.ethernet-interface := interface;
+ frame.ethernet-layer := ethernet-layer;
+ frame.listening-socket := ethernet-socket;
gadget-label(frame.sniffer-status-bar) := concatenate("Capturing ", interface-name);
command-enabled?(open-pcap-file, frame) := #f;
gadget-enabled?(frame.open-button) := #f;
@@ -820,10 +831,11 @@
end;
define method close-interface (frame :: <gui-sniffer-frame>)
- frame.ethernet-interface.running? := #f;
+ frame.ethernet-layer.ethernet-interface.running? := #f;
gadget-label(frame.sniffer-status-bar) := "Stopped capturing";
- disconnect(frame.ethernet-interface, frame);
- disconnect(frame, frame.ethernet-interface);
+ disconnect(frame.listening-socket, frame);
+ disconnect(frame, frame.listening-socket);
+ frame.listening-socket := #f;
command-enabled?(open-pcap-file, frame) := #t;
gadget-enabled?(frame.open-button) := #t;
command-enabled?(open-interface, frame) := #t;
Modified: trunk/libraries/gui-sniffer/library.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/library.dylan (original)
+++ trunk/libraries/gui-sniffer/library.dylan Thu Sep 6 00:54:20 2007
@@ -16,4 +16,5 @@
use network-flow;
use protocols;
use interfaces;
+ use layer;
end library gui-sniffer;
Modified: trunk/libraries/gui-sniffer/module.dylan
==============================================================================
--- trunk/libraries/gui-sniffer/module.dylan (original)
+++ trunk/libraries/gui-sniffer/module.dylan Thu Sep 6 00:54:20 2007
@@ -36,9 +36,11 @@
use pcap, import: { make-unix-time, <pcap-packet>, decode-unix-time, timestamp };
use prism2, import: { <prism2-frame> };
use ipv4, import: { <ipv4-frame>, <udp-frame>, source-port, destination-port, acknowledgement-number, sequence-number };
+ use icmp, import: { <icmp-frame> };
use tcp;
use ipv6;
// Add binding exports here.
use deuce-internals, prefix: "deuce/";
use interfaces;
+ use layer;
end module gui-sniffer;
Modified: trunk/libraries/layer/layer.dylan
==============================================================================
--- trunk/libraries/layer/layer.dylan (original)
+++ trunk/libraries/layer/layer.dylan Thu Sep 6 00:54:20 2007
@@ -46,6 +46,7 @@
define abstract class <layer> (<object>)
constant slot fan-in :: <fan-in> = make(<fan-in>);
+ constant slot fan-out :: <fan-out> = make(<fan-out>);
constant slot demultiplexer :: <demultiplexer> = make(<demultiplexer>);
constant slot sockets :: <collection> = make(<stretchy-vector>);
end;
@@ -56,6 +57,41 @@
define open generic completer (object :: <socket>) => (res :: <completer>);
define open generic completer-setter (value :: <completer>, object :: <socket>) => (res :: <completer>);
+define class <raw-socket> (<object>)
+ constant slot socket-layer :: <layer>, required-init-keyword: layer:;
+end;
+
+define method connect (socket :: <raw-socket>, input :: <push-input>)
+ connect(socket.socket-layer.fan-out, input);
+end;
+
+define method connect (socket :: <raw-socket>, input :: <single-push-input-node>)
+ connect(socket.socket-layer.fan-out, input.the-input);
+end;
+
+define method disconnect (socket :: <raw-socket>, input :: <push-input>)
+ disconnect(socket.socket-layer.fan-out, input);
+end;
+
+define method disconnect (socket :: <raw-socket>, input :: <single-push-input-node>)
+ disconnect(socket.socket-layer.fan-out, input.the-input);
+end;
+
+define method connect (node :: <single-push-output-node>, socket :: <raw-socket>)
+ connect(node.the-output, socket.socket-layer.fan-in);
+end;
+
+define method connect (node :: <push-output>, socket :: <raw-socket>)
+ connect(node, socket.socket-layer.fan-in);
+end;
+
+define method disconnect (node :: <push-output>, socket :: <raw-socket>)
+ disconnect(node, socket.socket-layer.fan-in);
+end;
+
+define method disconnect (node :: <single-push-output-node>, socket :: <raw-socket>)
+ disconnect(node.the-output, socket.socket-layer.fan-in);
+end;
define abstract class <socket> (<object>)
constant slot decapsulator :: <decapsulator> = make(<decapsulator>);
slot demultiplexer-output;
@@ -80,7 +116,8 @@
define method initialize (layer :: <ethernet-layer>,
#rest rest, #key, #all-keys);
connect(layer.fan-in, layer.ethernet-interface);
- connect(layer.ethernet-interface, layer.demultiplexer);
+ connect(layer.ethernet-interface, layer.fan-out);
+ connect(layer.fan-out, layer.demultiplexer);
end;
define open generic ethernet-type-code (object :: <ethernet-socket>) => (res :: <integer>);
@@ -113,6 +150,10 @@
socket;
end;
+define method create-raw-socket (layer :: <ethernet-layer>)
+ => (socket :: <raw-socket>)
+ make(<raw-socket>, layer: layer);
+end;
define method send (socket :: <ethernet-socket>, destination :: <mac-address>, payload :: <container-frame>);
let ethernet-frame = make(<ethernet-frame>,
destination-address: destination,
@@ -314,6 +355,7 @@
slot default-ip-address :: <ipv4-address>;
constant slot routes = make(<stretchy-vector>);
constant slot reassembler = make(<ip-reassembler>);
+ slot raw-input;
end;
define class <route> (<object>)
@@ -343,7 +385,7 @@
closure: method(x)
let (adapter, next-hop)
= find-adapter-for-forwarding(ip-layer, x.destination-address);
- let mtu = find-mtu-for-destination(adapter, x.destination-address) * 8;
+ /* let mtu = find-mtu-for-destination(adapter, x.destination-address) * 8;
let full-payload = assemble-frame(x.payload).packet;
let data-size = frame-size(x.payload);
if (mtu < data-size)
@@ -363,11 +405,12 @@
length: modulo(data-size, mtu)));
x.total-length := #f;
let ip-frame = assemble-frame(x);
- fixup!(ip-frame);
- send(adapter, next-hop, ip-frame);
+ fixup!(ip-frame); */
+ send(adapter, next-hop, x);
end);
connect(ip-layer.fan-in, cls);
connect(ip-layer.reassembler, ip-layer.demultiplexer);
+ ip-layer.raw-input := create-input(ip-layer.fan-in);
end;
define method find-mtu-for-destination (adapter :: <ip-over-ethernet-adapter>, destination :: <ipv4-address>)
@@ -417,6 +460,13 @@
end;
end;
+define method send (ip-layer :: <ip-layer>, destination :: <ipv4-address>, payload :: <container-frame>)
+ let frame = make(<ipv4-frame>,
+ destination-address: destination,
+ source-address: ip-layer.default-ip-address,
+ payload: payload);
+ push-data-aux(ip-layer.raw-input, ip-layer.fan-in, frame);
+end;
define open generic ip-protocol (object :: <ip-socket>) => (res :: <integer>);
define class <ip-socket> (<socket>)
constant slot ip-protocol :: <integer>, init-keyword: protocol:;
@@ -616,8 +666,9 @@
end;
end;
+/* dead code?
define function init-arp-handler (#key mac-address :: <mac-address> = mac-address("00:de:ad:be:ef:00"),
- ip-address :: <ipv4-address> = ipv4-address("23.23.23.23"),
+ ip-address :: <ipv4-address> = ipv4-address("192.168.0.69"),
netmask :: <integer> = 24,
interface-name :: <string> = "eth0");
let interface = make(<ethernet-interface>, name: interface-name);
@@ -641,13 +692,22 @@
send-gratitious-arp(arp-handler, ip-address);
ethernet-layer;
end;
+*/
-define function init-ip-layer (#key mac-address :: <mac-address> = mac-address("00:de:ad:be:ef:00"),
- ip-address :: <ipv4-address> = ipv4-address("23.23.23.23"),
- netmask :: <integer> = 24,
- interface-name :: <string> = "eth0")
- let int = make(<ethernet-interface>, name: interface-name);
+define function build-ethernet-layer (interface-name :: <string>,
+ #key promiscuous? :: <boolean>,
+ mac-address :: <mac-address> = mac-address("00:de:ad:be:ef:00"));
+ let int = make(<ethernet-interface>, name: interface-name, promiscuous?: promiscuous?);
let ethernet-layer = make(<ethernet-layer>, ethernet-interface: int, default-mac-address: mac-address);
+ make(<thread>, function: curry(toplevel, int));
+ ethernet-layer;
+end;
+
+
+define function build-ip-layer (ethernet-layer,
+ #key ip-address :: <ipv4-address> = ipv4-address("192.168.0.69"),
+ default-gateway :: <ipv4-address> = ipv4-address("192.168.0.1"),
+ netmask :: <integer> = 24)
let arp-handler = make(<arp-handler>);
let ip-layer = make(<ip-layer>);
let ip-over-ethernet = make(<ip-over-ethernet-adapter>,
@@ -656,12 +716,18 @@
ip-layer: ip-layer,
ipv4-address: ip-address,
netmask: netmask);
+ register-route(ip-layer, make(<next-hop-route>,
+ next-hop: default-gateway,
+ cidr: make(<cidr>, network-address: ipv4-address("0.0.0.0"), netmask: 0)));
send-gratitious-arp(arp-handler, ip-address);
- let icmp-handler = make(<icmp-handler>);
- let icmp-over-ip = make(<icmp-over-ip-adapter>,
- ip-layer: ip-layer,
- icmp-handler: icmp-handler);
- make(<thread>, function: curry(toplevel, int));
+ //let icmp-handler = make(<icmp-handler>);
+ //let icmp-over-ip = make(<icmp-over-ip-adapter>,
+ // ip-layer: ip-layer,
+ // icmp-handler: icmp-handler);
values(ip-layer, ip-over-ethernet);
end;
+
+
+
+
Modified: trunk/libraries/layer/module.dylan
==============================================================================
--- trunk/libraries/layer/module.dylan (original)
+++ trunk/libraries/layer/module.dylan Thu Sep 6 00:54:20 2007
@@ -36,9 +36,14 @@
<arp-handler>,
register-route,
init-arp-handler,
- init-ip-layer,
decapsulator,
create-socket,
+ create-raw-socket,
+ build-ethernet-layer,
+ build-ip-layer,
send-socket,
send;
+
+ export <udp-layer>,
+ <tcp-layer>;
end module layer;
Modified: trunk/libraries/network-flow/module.dylan
==============================================================================
--- trunk/libraries/network-flow/module.dylan (original)
+++ trunk/libraries/network-flow/module.dylan Thu Sep 6 00:54:20 2007
@@ -23,5 +23,6 @@
<pcap-file-reader>,
<pcap-file-writer>,
<malformed-packet-writer>,
- <fan-out>, <fan-in>;
+ <fan-out>, <fan-in>,
+ create-input, create-output;
end module network-flow;
Modified: trunk/libraries/packetizer/leaf-frames.dylan
==============================================================================
--- trunk/libraries/packetizer/leaf-frames.dylan (original)
+++ trunk/libraries/packetizer/leaf-frames.dylan Thu Sep 6 00:54:20 2007
@@ -465,8 +465,10 @@
define method read-frame (type == <raw-frame>,
string :: <string>)
=> (res)
- make(<raw-frame>,
- data: copy-sequence(string));
+ let res = make(<raw-frame>,
+ data: make(<byte-sequence>, capacity: string.size));
+ copy-bytes(res.data, 0, string, 0, string.size);
+ res;
end;
Modified: trunk/libraries/protocols/cidr.dylan
==============================================================================
--- trunk/libraries/protocols/cidr.dylan (original)
+++ trunk/libraries/protocols/cidr.dylan Thu Sep 6 00:54:20 2007
@@ -3,7 +3,8 @@
Copyright: (C) 2005, 2006, All rights reserved. Free for non-commercial use.
define class <cidr> (<object>)
- constant slot cidr-network-address :: <ipv4-address>,
+ constant slot cidr-network-address,
+ //<ipv4-address>, but somehow this confuses the compiler (runtime)
required-init-keyword: network-address:;
constant slot cidr-netmask :: <integer>,
required-init-keyword: netmask:;
More information about the chatter
mailing list