ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/kgsueme/doc/doc2messages.xsl
(Generate patch)

Comparing kgsueme/doc/doc2messages.xsl (file contents):
Revision 1.2 by pcg, Thu Jun 5 10:09:10 2003 UTC vs.
Revision 1.15 by pcg, Tue Jul 22 03:35:34 2003 UTC

12 12
13# See doc/protocol.xml and doc/doc2messages.xsl 13# See doc/protocol.xml and doc/doc2messages.xsl
14 14
15package KGS::Messages; 15package KGS::Messages;
16 16
17use KGS::Constants; # REPLACE by parsed file, too
18
17use strict; 19use strict;
18 20
19our %type; 21our %type;
20our %send; 22
21our %recv; 23our %dec_client; # decode messages send to server
24our %enc_client; # encode messages send to server
25our %dec_server; # decode messages received from server
26our %enc_server; # encode messages received from server
22 27
23{ 28{
24 29
25my $data; # stores currently processed decoding/encoding packet 30my $data; # stores currently processed decoding/encoding packet
26 31
72 77
73sub dec_CONSTANT { 78sub dec_CONSTANT {
74 $_[0]; 79 $_[0];
75} 80}
76 81
82sub dec_password {
83 dec_U64;
84}
85
77sub dec_HEX { # for debugging 86sub dec_HEX { # for debugging
78 "HEX: " . unpack "H*", $data;#d# 87 "HEX: " . unpack "H*", $data;#d#
79}
80
81sub enc_HEX {
82 die "enc_HEX not defined for good";
83} 88}
84 89
85############################################################################# 90#############################################################################
86 91
87sub enc_U8 { 92sub enc_U8 {
99sub enc_U64 { 104sub enc_U64 {
100 enc_U32 $_[0] & 0xffffffff; 105 enc_U32 $_[0] & 0xffffffff;
101 enc_U32 +($_[0] >> 32) & 0xffffffff; 106 enc_U32 +($_[0] >> 32) & 0xffffffff;
102} 107}
103 108
109sub enc_I8 {
110 $data .= pack "c", $_[0];
111}
112
113sub enc_I16 {
114 enc_U16 unpack "S", pack "s", $_[0];
115}
116
104sub enc_I32 { 117sub enc_I32 {
105 enc_U32 unpack "I", pack "i", $_[0]; 118 enc_U32 unpack "I", pack "i", $_[0];
106} 119}
107 120
108sub enc_DATA { 121sub enc_DATA {
112 125
113sub enc_STRING { 126sub enc_STRING {
114 # should use encode for speed and clarity ;) 127 # should use encode for speed and clarity ;)
115 $data .= pack "v*", map ord, split //, $_[0]; 128 $data .= pack "v*", map ord, split //, $_[0];
116} 129}
130
131sub enc_CONSTANT {
132 # nop
133}
134
135sub enc_password {
136 require Math::BigInt; # I insist on 32-bit-perl.. should use C
137 # $hash must be 64 bit
138 my $hash = new Math::BigInt;
139 $hash = $hash * 1055 + ord for split //, $_[0];
140 enc_U64 $hash;
141}
142
143sub enc_HEX {
144 die "enc_HEX not defined for good";
145}
146
117]]> 147]]>
118 148
119############################################################################# 149#############################################################################
120# types 150# types
121<xsl:apply-templates select="descendant::type"/> 151<xsl:apply-templates select="descendant::type"/>
143# this was the most horrible thing to decode. still not everything is decoded correctly(?) 173# this was the most horrible thing to decode. still not everything is decoded correctly(?)
144sub dec_TREE { 174sub dec_TREE {
145 my @r; 175 my @r;
146 while (length $data) { 176 while (length $data) {
147 my $type = dec_U8; 177 my $type = dec_U8;
178 my $add = $type < 128;
148 179
180 $type &= 127;
181
149 if ($type == 255) { 182 if ($type == 127) {
183 dec_U8; # unused?? *sigh*
150 push @r, [add_child => dec_U32]; 184 push @r, [add_node => dec_I32];
151 185
186 } elsif ($type == 126) {
187 push @r, [set_node => dec_I32];
188
189 } elsif ($type == 125) {
190 push @r, [set_current => dec_I32];
191
192 } elsif ($type == 34) {
193 push @r, [score => dec_U8, dec_score1000];
194
195 } elsif ($type == 29) {
196 push @r, [type_29 => dec_STRING];
197 warn "TYPE 29 $r[-1][1]\007 PLEASE REPORT";#d#
198 die;
199
200 } elsif ($type == 28) {
201 # move number, only in variations it seems. oh my.
202 push @r, [movenum => dec_STRING];
203
152 } elsif ($type == 254) { 204 } elsif ($type == 25) {
153 push @r, ["done"]; 205 push @r, [result => dec_result];
154 206
155 } elsif ($type == 253) { 207 } elsif ($type == 23) {
156 push @r, ["type253"]; 208 push @r, [mark => $add, MARK_GRAYED, dec_U8, dec_U8];
157 # ????
158 209
159 } elsif ($type == 252) { # even less clear 210 } elsif ($type == 22) {
211 push @r, [mark => $add, (&dec_U8 ? MARK_SMALL_W : MARK_SMALL_B), dec_U8, dec_U8];
212
213 } elsif ($type == 21) {
214 push @r, [mark => $add, MARK_CIRCLE, dec_U8, dec_U8];
215
216 } elsif ($type == 20) {
217 push @r, [mark => $add, MARK_SQUARE, dec_U8, dec_U8];
218
219 } elsif ($type == 19) {
220 push @r, [mark => $add, MARK_TRIANGLE, dec_U8, dec_U8];
221
222 } elsif ($type == 18) {
223 push @r, [mark => $add, MARK_LABEL, dec_U8, dec_U8, dec_STRING];
224
225 } elsif ($type == 17) {
226 push @r, [set_timer => (dec_U8, dec_U32, dec_time)[0,2,1]];
227
228 } elsif ($type == 16) {
229 push @r, [set_stone => $add, dec_U8, dec_U8, dec_U8];
230
231 } elsif ($type == 14) {
232 push @r, [move => $add, dec_U8, dec_U8, dec_U8];
233
234 } elsif (($type >= 4 && $type <= 9)
235 || ($type >= 11 && $type <= 13)
236 || $type == 24) {
237
160 push @r, ["more"]; 238 push @r, [({
239 4 => "date",
240 5 => "unknown_comment5",
241 6 => "unknown_comment6",
242 7 => "unknown_comment7",
243 8 => "unknown_comment8",
244 9 => "copyright", #?
245 11 => "unknown_comment11",
246 12 => "unknown_comment12",
247 13 => "unknown_comment13",
248 24 => "comment",
249 })->{$type} => dec_STRING];
161 250
251 } elsif ($type == 3) {
252 push @r, [rank => dec_U8, dec_U32];
253
254 } elsif ($type == 2) {
255 push @r, [player => dec_U8, dec_STRING];
256
162 } elsif ($type == 10) { 257 } elsif ($type == 0) {
163 # as usual, wms finds yet another way to duplicate code... oh well, what a mess. 258 # as usual, wms finds yet another way to duplicate code... oh well, what a mess.
164 # (no wonder he is so keen on keeping it secret...) 259 # (no wonder he is so keen on keeping it a secret...)
165 260
166 push @r, [rules => dec_rules]; 261 push @r, [rules => dec_rules];
167 262
168 } elsif ($type == 9 || $type == 22 || $type == 25 || $type == 31 || $type == 32) { 263 # OLD
169 push @r, [({
170 9 => "comment",
171 22 => "unknown_comment22",
172 25 => "copyright", #?
173 31 => "date",
174 32 => "unknown_comment32",
175 })->{$type} => dec_STRING];
176 264
177 } elsif ($type == 11 || $type == 12) {
178 push @r, [player => $type - 11, dec_STRING];
179
180 } elsif ($type == 13 || $type == 14) {
181 push @r, [rank => $type - 13, dec_U32];
182
183 } elsif ($type == 15 || $type == 16) {
184 push @r, [set_timer => $type - 15, dec_time, dec_U16];
185
186 } elsif ($type == 17 || $type == 18) {
187 push @r, [score => $type - 17, dec_score];
188
189 } elsif ($type == 19) { 265 } elsif (1) {
190 push @r, [result => dec_result]; 266 print STDERR KGS::Listener::Debug::dumpval(\@r);
267 open XTYPE, "|xtype"; print XTYPE $data; close XTYPE;
268 die "unknown tree type $type, PLEASE REPORT and include the game you wanted to watch. thx.";
191 269
192 } elsif ($type == 30) { 270 } elsif ($type == 30) {
193 push @r, [active_player => dec_U8]; 271 push @r, [active_player => dec_U8];
194 272
195 } elsif ($type == 0) { # label(?) 273 } elsif ($type == 0) { # label(?)
222 } 300 }
223 \@r; 301 \@r;
224} 302}
225 303
226sub enc_TREE { 304sub enc_TREE {
305 die "tree encoding not yet supported again";
227 for (@{$_[0]}) { 306 for (@{$_[0]}) {
228 my ($type, @arg) = @$_; 307 my ($type, @arg) = @$_;
229 308
230 if ($type eq "add_child") { 309 if ($type eq "add_child") {
231 enc_U8 255; 310 enc_U8 255;
232 enc_U32 $arg[0]; 311 enc_I32 $arg[0];
233 312
234 } elsif ($type eq "done") { 313 } elsif ($type eq "done") {
235 enc_U8 254; 314 enc_U8 254;
236 315
237 } elsif ($type eq "more") { 316 } elsif ($type eq "more") {
2711; 3501;
272</xsl:template> 351</xsl:template>
273 352
274<xsl:template match="type[@type = 'S']"> 353<xsl:template match="type[@type = 'S']">
275sub dec_<xsl:value-of select="@name"/> { 354sub dec_<xsl:value-of select="@name"/> {
355 my $res = "";
276 my @r = unpack "v<xsl:value-of select="@length"/> a*", $data; 356 my @r = unpack "v<xsl:value-of select="@length"/> a*", $data;
277 $data = pop @r; 357 $data = pop @r;
278 join ":", map chr, @r; 358 for (@r) {
359 last unless $_;
360 $res .= chr $_;
361 }
362 # dump extra data to file for later analysis
363 #my $x = pack "v*", @r; $x =~ s/^(..)*?\x00\x00//s; open DUMP, ">>/tmp/dump"; print DUMP $x; close DUMP;#d#
364 $res;
279} 365}
280 366
281sub enc_<xsl:value-of select="@name"/> { 367sub enc_<xsl:value-of select="@name"/> {
282 $data .= pack "v<xsl:value-of select="@length"/>", map ord, split //, $_[0]; 368 $data .= pack "v<xsl:value-of select="@length"/>", map ord, split //, $_[0];
283} 369}
323 409
324<xsl:template match="member" mode="enc"> 410<xsl:template match="member" mode="enc">
325 <!-- #d#, remove when kgs is repaired --><xsl:if test="@type = 'username'"> 411 <!-- #d#, remove when kgs is repaired --><xsl:if test="@type = 'username'">
326 $_[0]{<xsl:value-of select="@name"/>} =~ /^[A-Za-z][A-Za-z0-9]{0,11}$/ 412 $_[0]{<xsl:value-of select="@name"/>} =~ /^[A-Za-z][A-Za-z0-9]{0,11}$/
327 or Carp::confess "FATAL: tried to send illegal username '$_[0]{<xsl:value-of select="@name"/>}'"; 413 or Carp::confess "FATAL: tried to send illegal username '$_[0]{<xsl:value-of select="@name"/>}'";
328 </xsl:if><!--#d#-->
329 <!-- #d#, remove when kgs is repaired --><xsl:if test="@name = 'channel'">
330 $_[0]{<xsl:value-of select="@name"/>} > 0
331 or Carp::confess "FATAL: tried to send a zero channel id";
332 </xsl:if><!--#d#--> 414 </xsl:if><!--#d#-->
333 enc_<xsl:value-of select="@type"/> defined $_[0]{<xsl:value-of select="@name"/>} ? $_[0]{<xsl:value-of select="@name"/> 415 enc_<xsl:value-of select="@type"/> defined $_[0]{<xsl:value-of select="@name"/>} ? $_[0]{<xsl:value-of select="@name"/>
334 <xsl:text>} : (</xsl:text> 416 <xsl:text>} : (</xsl:text>
335 <xsl:value-of select="@default"/> 417 <xsl:value-of select="@default"/>
336 <xsl:text>);</xsl:text> 418 <xsl:text>);</xsl:text>
351} 433}
352</xsl:template> 434</xsl:template>
353 435
354<xsl:template match="message"> 436<xsl:template match="message">
355# <xsl:value-of select="@name"/> 437# <xsl:value-of select="@name"/>
356<xsl:if test="@recv='yes'"> 438$dec_<xsl:value-of select="@src"/>{0x<xsl:value-of select="@type"/>} = sub {
357$recv{0x<xsl:value-of select="@type"/>} = sub {
358 $data = $_[0]; 439 $data = $_[0];
359 my $r; 440 my $r;
360 $r->{type} = "<xsl:value-of select="@name"/>"; 441 $r->{type} = "<xsl:value-of select="@name"/>";
361 <xsl:apply-templates select="member" mode="dec"/> 442 <xsl:apply-templates select="member" mode="dec"/>
362 $r; 443 $r;
363}; 444};
364</xsl:if> 445$enc_<xsl:value-of select="@src"/>{<xsl:value-of select="@name"/>} = sub {
365<xsl:if test="@send='yes'">
366$send{<xsl:value-of select="@name"/>} = sub {
367 $data = ""; 446 $data = "";
368 enc_U16 0x<xsl:value-of select="@type"/>; 447 enc_U16 0x<xsl:value-of select="@type"/>;
369 <xsl:apply-templates select="member" mode="enc"/> 448 <xsl:apply-templates select="member" mode="enc"/>
370 $data; 449 $data;
371}; 450};
372</xsl:if>
373</xsl:template> 451</xsl:template>
374 452
375<xsl:template match="member"> 453<xsl:template match="member">
376 [<xsl:value-of select="@name"/> 454 [<xsl:value-of select="@name"/>
377 <xsl:text>=> "</xsl:text> 455 <xsl:text>=> "</xsl:text>

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines