ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/kgsueme/bin/kgstrace
Revision: 1.3
Committed: Sun May 16 17:47:45 2004 UTC (20 years ago) by pcg
Branch: MAIN
Changes since 1.2: +4 -4 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 pcg 1.1 #!/usr/bin/perl
2    
3     use IO::Socket::INET;
4    
5     use KGS::Protocol;
6     use KGS::Messages;
7    
8     use KGS::Listener::Debug;
9    
10     use Fcntl;
11     use FileHandle;
12    
13     my $l = new IO::Socket::INET LocalPort => 2379, Listen => 1, ReuseAddr => 1;
14    
15     my $prot = new KGS::Protocol;
16     my $sgen = new KGS::Protocol::Generator;
17    
18 pcg 1.2 (my $listener = mylistener->new)->listen ($prot, "any");
19 pcg 1.1
20     print "connect with cgoban2 to localhost:2379 to see a protocol dump.\n";
21     print "ready.\n";
22    
23     sysopen TRACE, "cgoban2.trace", O_CREAT|O_APPEND|O_WRONLY
24     or die "cgoban2.trace: $!";
25     TRACE->autoflush(1);
26    
27     while (my $l = $l->accept) {
28     if (fork == 0) {
29     printf TRACE "$$ + %d\n", int time;
30    
31     my $r = new IO::Socket::INET PeerHost => "kgs.kiseido.com:2379";
32     $prot->handshake ($r);
33     {
34     sysread $l, my $buf, 1;
35     $buf = chr 3;
36     syswrite $l, $buf, 1;
37     }
38    
39     my $rlen = 0;
40     my $sbuf = "";
41    
42     my $Rb = "";
43     print "connection established\n";
44     (vec $Rb, fileno $l, 1) = 1;
45     (vec $Rb, fileno $r, 1) = 1;
46     while (select my $rb = $Rb, undef, undef, undef) {
47     if (vec $rb, fileno $l, 1) {
48     last unless sysread $l, my $buf, 8192;
49     syswrite $r, $buf, 8192;
50    
51     printf TRACE "$$ C %d %4d %s\n", int time, length $buf, unpack "H*", $buf;
52    
53     $sbuf .= $buf;
54    
55     for (;;) {
56     if (!$rlen and 2 <= length $sbuf) {
57     $rlen = ($sgen->{client_state} >> 24) ^ unpack "v", $sbuf;
58     }
59    
60     if ($rlen and $rlen <= length $sbuf) {
61     my $pkt = substr $sbuf, 0, $rlen, "";
62     $sgen->dec_client ($pkt);
63    
64     my $type = unpack "xx v", $pkt;
65     my $msg = eval { $KGS::Messages::dec_client{$type} };
66     warn "ERROR: $@" if $@;
67     if ($msg) {
68     $msg = $msg->(substr $pkt, 4);
69    
70     $prot->{generator}->set_server_seed ($msg->{name}) if $msg->{type} eq "login";
71    
72 pcg 1.3 print "\npacket type $msg->{type} received from CLIENT:\n";
73     #open XTYPE, "|xtype"; printf XTYPE "%16d%s", (length $pkt), $pkt; close XTYPE;
74 pcg 1.1 print KGS::Listener::Debug::dumpval $msg;
75     } else {
76 pcg 1.3 print "\007\n\nUNKNOWN PACKET TYPE RECEIVED FROM CLIENT:\n";
77 pcg 1.1 open XTYPE, "|xtype"; printf XTYPE "%16d%s", (length $pkt), $pkt; close XTYPE;
78     }
79    
80     $rlen = 0;
81     } else {
82     last;
83     }
84     }
85     }
86     if (vec $rb, fileno $r, 1) {
87     last unless sysread $r, my $buf, 8192;
88     syswrite $l, $buf, 8192;
89    
90     printf TRACE "$$ S %d %4d %s\n", int time, length $buf, unpack "H*", $buf;
91    
92     eval {
93     $prot->feed_data ($buf);
94     };
95     warn "ERROR: $@" if $@;
96     }
97     }
98     print "closing connection.\n";
99     exit;
100     }
101     }
102    
103     package mylistener;
104    
105     use base KGS::Listener;
106    
107     sub inject {
108     my ($self, $msg) = @_;
109    
110 pcg 1.3 print "received packet type $msg->{type} from SERVER\n";
111 pcg 1.1 print KGS::Listener::Debug::dumpval $msg;
112     }
113    
114