1 | <!DOCTYPE xsl:stylesheet> |
1 | <!DOCTYPE xsl:stylesheet> |
2 | <xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform"> |
2 | <xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform"> |
3 | |
3 | |
4 | <xsl:output method="text" media-type="text/plain" encoding="utf-8"/> |
4 | <xsl:output method="text" media-type="text/plain" encoding="utf-8"/> |
5 | |
5 | |
6 | <xsl:template match="/"> |
6 | <xsl:template match="/"><![CDATA[ |
|
|
7 | # This is an automatically generated file. |
|
|
8 | # This is an automatically generated file. |
|
|
9 | # This is an automatically generated file. |
|
|
10 | # This is an automatically generated file. |
|
|
11 | # This is an automatically generated file. |
|
|
12 | |
|
|
13 | # See doc/protocol.xml and doc/doc2messages.xsl |
|
|
14 | |
7 | package KGS::Messages; |
15 | package KGS::Messages; |
8 | |
16 | |
|
|
17 | use KGS::Constants; # REPLACE by parsed file, too |
|
|
18 | |
|
|
19 | use strict; |
|
|
20 | |
|
|
21 | our %type; |
|
|
22 | |
|
|
23 | our %dec_client; # decode messages send to server |
|
|
24 | our %enc_client; # encode messages send to server |
|
|
25 | our %dec_server; # decode messages received from server |
|
|
26 | our %enc_server; # encode messages received from server |
|
|
27 | |
9 | { |
28 | { |
10 | <xsl:apply-templates/> |
29 | |
|
|
30 | my $data; # stores currently processed decoding/encoding packet |
|
|
31 | |
|
|
32 | # primitive enc/decoders |
|
|
33 | |
|
|
34 | ############################################################################# |
|
|
35 | |
|
|
36 | sub dec_U8 { |
|
|
37 | (my ($r), $data) = unpack "C a*", $data; $r; |
|
|
38 | } |
|
|
39 | |
|
|
40 | sub dec_U16 { |
|
|
41 | (my ($r), $data) = unpack "v a*", $data; $r; |
|
|
42 | } |
|
|
43 | |
|
|
44 | sub dec_U32 { |
|
|
45 | (my ($r), $data) = unpack "V a*", $data; $r; |
|
|
46 | } |
|
|
47 | |
|
|
48 | sub dec_U64 { |
|
|
49 | my ($lo, $hi) = (dec_U32, dec_U32); |
|
|
50 | $lo + $hi * 2**32; |
|
|
51 | } |
|
|
52 | |
|
|
53 | sub dec_I8 { |
|
|
54 | (my ($r), $data) = unpack "c a*", $data; |
|
|
55 | $r; |
|
|
56 | } |
|
|
57 | |
|
|
58 | sub dec_I16 { |
|
|
59 | (my ($r), $data) = unpack "v a*", $data; |
|
|
60 | unpack "s", pack "S", $r; |
|
|
61 | } |
|
|
62 | |
|
|
63 | sub dec_I32 { |
|
|
64 | (my ($r), $data) = unpack "V a*", $data; |
|
|
65 | unpack "i", pack "I", $r; |
|
|
66 | } |
|
|
67 | |
|
|
68 | sub dec_DATA { |
|
|
69 | (my ($r), $data) = ($data, ""); $r; |
|
|
70 | } |
|
|
71 | |
|
|
72 | sub dec_STRING { |
|
|
73 | $data =~ s/^((?:..)*?)(?:\x00\x00|\Z)//s; |
|
|
74 | # use Encode... |
|
|
75 | join "", map chr, unpack "v*", $1; |
|
|
76 | } |
|
|
77 | |
|
|
78 | sub dec_CONSTANT { |
|
|
79 | $_[0]; |
|
|
80 | } |
|
|
81 | |
|
|
82 | sub dec_password { |
|
|
83 | dec_U64; |
|
|
84 | } |
|
|
85 | |
|
|
86 | sub dec_HEX { # for debugging |
|
|
87 | "HEX: " . unpack "H*", $data;#d# |
|
|
88 | } |
|
|
89 | |
|
|
90 | ############################################################################# |
|
|
91 | |
|
|
92 | sub enc_U8 { |
|
|
93 | $data .= pack "C", $_[0]; |
|
|
94 | } |
|
|
95 | |
|
|
96 | sub enc_U16 { |
|
|
97 | $data .= pack "v", $_[0]; |
|
|
98 | } |
|
|
99 | |
|
|
100 | sub enc_U32 { |
|
|
101 | $data .= pack "V", $_[0]; |
|
|
102 | } |
|
|
103 | |
|
|
104 | sub enc_U64 { |
|
|
105 | enc_U32 $_[0] & 0xffffffff; |
|
|
106 | enc_U32 +($_[0] >> 32) & 0xffffffff; |
|
|
107 | } |
|
|
108 | |
|
|
109 | sub enc_I8 { |
|
|
110 | $data .= pack "c", $_[0]; |
|
|
111 | } |
|
|
112 | |
|
|
113 | sub enc_I16 { |
|
|
114 | enc_U16 unpack "S", pack "s", $_[0]; |
|
|
115 | } |
|
|
116 | |
|
|
117 | sub enc_I32 { |
|
|
118 | enc_U32 unpack "I", pack "i", $_[0]; |
|
|
119 | } |
|
|
120 | |
|
|
121 | sub enc_DATA { |
|
|
122 | # a dream! |
|
|
123 | $data .= $_[0]; |
|
|
124 | } |
|
|
125 | |
|
|
126 | sub enc_STRING { |
|
|
127 | # should use encode for speed and clarity ;) |
|
|
128 | $data .= pack "v*", map ord, split //, $_[0]; |
|
|
129 | } |
|
|
130 | |
|
|
131 | sub enc_CONSTANT { |
|
|
132 | # nop |
|
|
133 | } |
|
|
134 | |
|
|
135 | sub 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 | |
|
|
143 | sub enc_HEX { |
|
|
144 | die "enc_HEX not defined for good"; |
|
|
145 | } |
|
|
146 | |
|
|
147 | ]]> |
|
|
148 | |
|
|
149 | ############################################################################# |
|
|
150 | # types |
|
|
151 | <xsl:apply-templates select="descendant::type"/> |
|
|
152 | |
|
|
153 | ############################################################################# |
|
|
154 | # structures |
|
|
155 | <xsl:apply-templates select="descendant::struct"/> |
|
|
156 | |
|
|
157 | ############################################################################# |
|
|
158 | # "less" primitive types<![CDATA[ |
|
|
159 | |
|
|
160 | my %marker_code = ( |
|
|
161 | triangle => 1, |
|
|
162 | square => 2, |
|
|
163 | circle => 3, |
|
|
164 | small_b => 4, |
|
|
165 | small_w => 5, |
|
|
166 | gray => 6, |
|
|
167 | move => 7, |
|
|
168 | addstone => 8, |
|
|
169 | ); |
|
|
170 | |
|
|
171 | my %code_marker = reverse %marker_code; |
|
|
172 | |
|
|
173 | # this was the most horrible thing to decode. still not everything is decoded correctly(?) |
|
|
174 | sub dec_TREE { |
|
|
175 | my @r; |
|
|
176 | while (length $data) { |
|
|
177 | my $type = dec_U8; |
|
|
178 | my $add = $type < 128; |
|
|
179 | |
|
|
180 | $type &= 127; |
|
|
181 | |
|
|
182 | if ($type == 127) { |
|
|
183 | dec_U8; # unused?? *sigh* |
|
|
184 | push @r, [add_node => dec_I32]; |
|
|
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 == 25) { |
|
|
196 | push @r, [result => dec_result]; |
|
|
197 | |
|
|
198 | } elsif ($type == 23) { |
|
|
199 | push @r, [mark => $add, MARK_GRAYED, dec_U8, dec_U8]; |
|
|
200 | |
|
|
201 | } elsif ($type == 22) { |
|
|
202 | push @r, [mark => $add, (&dec_U8 ? MARK_SMALL_W : MARK_SMALL_B), dec_U8, dec_U8]; |
|
|
203 | |
|
|
204 | } elsif ($type == 21) { |
|
|
205 | push @r, [mark => $add, MARK_CIRCLE, dec_U8, dec_U8]; |
|
|
206 | |
|
|
207 | } elsif ($type == 20) { |
|
|
208 | push @r, [mark => $add, MARK_SQUARE, dec_U8, dec_U8]; |
|
|
209 | |
|
|
210 | } elsif ($type == 19) { |
|
|
211 | push @r, [mark => $add, MARK_TRIANGLE, dec_U8, dec_U8]; |
|
|
212 | |
|
|
213 | } elsif ($type == 18) { |
|
|
214 | push @r, [mark => $add, MARK_LABEL, dec_U8, dec_U8, dec_STRING]; |
|
|
215 | |
|
|
216 | } elsif ($type == 17) { |
|
|
217 | push @r, [set_timer => (dec_U8, dec_U32, dec_time)[0,2,1]]; |
|
|
218 | |
|
|
219 | } elsif ($type == 16) { |
|
|
220 | push @r, [set_stone => $add, dec_U8, dec_U8, dec_U8]; |
|
|
221 | |
|
|
222 | } elsif ($type == 14) { |
|
|
223 | push @r, [move => $add, dec_U8, dec_U8, dec_U8]; |
|
|
224 | |
|
|
225 | } elsif (($type >= 4 && $type <= 9) |
|
|
226 | || ($type >= 11 && $type <= 13) |
|
|
227 | || $type == 24) { |
|
|
228 | |
|
|
229 | push @r, [({ |
|
|
230 | 4 => "date", |
|
|
231 | 5 => "unknown_comment5", |
|
|
232 | 6 => "unknown_comment6", |
|
|
233 | 7 => "unknown_comment7", |
|
|
234 | 8 => "unknown_comment8", |
|
|
235 | 9 => "copyright", #? |
|
|
236 | 11 => "unknown_comment11", |
|
|
237 | 12 => "unknown_comment12", |
|
|
238 | 13 => "unknown_comment13", |
|
|
239 | 24 => "comment", |
|
|
240 | })->{$type} => dec_STRING]; |
|
|
241 | |
|
|
242 | } elsif ($type == 3) { |
|
|
243 | push @r, [rank => dec_U8, dec_U32]; |
|
|
244 | |
|
|
245 | } elsif ($type == 2) { |
|
|
246 | push @r, [player => dec_U8, dec_STRING]; |
|
|
247 | |
|
|
248 | } elsif ($type == 0) { |
|
|
249 | # as usual, wms finds yet another way to duplicate code... oh well, what a mess. |
|
|
250 | # (no wonder he is so keen on keeping it a secret...) |
|
|
251 | |
|
|
252 | push @r, [rules => dec_rules]; |
|
|
253 | |
|
|
254 | # OLD |
|
|
255 | |
|
|
256 | } elsif (1) { |
|
|
257 | print STDERR KGS::Listener::Debug::dumpval(\@r); |
|
|
258 | open XTYPE, "|xtype"; print XTYPE $data; close XTYPE; |
|
|
259 | die "unknown type $type"; |
|
|
260 | |
|
|
261 | } elsif ($type == 30) { |
|
|
262 | push @r, [active_player => dec_U8]; |
|
|
263 | |
|
|
264 | } elsif ($type == 0) { # label(?) |
|
|
265 | my $label; |
|
|
266 | my $c = dec_U16; $label .= chr $c if $c; |
|
|
267 | my $c = dec_U16; $label .= chr $c if $c; |
|
|
268 | my $c = dec_U16; $label .= chr $c if $c; |
|
|
269 | |
|
|
270 | # empty label == remove label |
|
|
271 | push @r, [label => $label, dec_U8, dec_U8]; |
|
|
272 | |
|
|
273 | } elsif ($type > 0 && $type < 9) { |
|
|
274 | # 1 marker type triangle |
|
|
275 | # 2 marker type square |
|
|
276 | # 3 marker type circle |
|
|
277 | # 4 small stone b |
|
|
278 | # 5 small stone w |
|
|
279 | # 6 grayed out |
|
|
280 | # 7 move |
|
|
281 | # 8 also move(?) or preset? |
|
|
282 | # |
|
|
283 | # $a1 is probably player again (2 == remove) |
|
|
284 | # x is from left 0 to right boardsize-1 |
|
|
285 | # y is from top 0 to bottom boardsize-1 |
|
|
286 | push @r, [$code_marker{$type} => dec_U8, dec_U8, dec_U8]; |
|
|
287 | |
|
|
288 | } else { |
|
|
289 | push @r, [unknown => $type]; |
|
|
290 | } |
|
|
291 | } |
|
|
292 | \@r; |
|
|
293 | } |
|
|
294 | |
|
|
295 | sub enc_TREE { |
|
|
296 | die "tree encoding not yet supported again"; |
|
|
297 | for (@{$_[0]}) { |
|
|
298 | my ($type, @arg) = @$_; |
|
|
299 | |
|
|
300 | if ($type eq "add_child") { |
|
|
301 | enc_U8 255; |
|
|
302 | enc_I32 $arg[0]; |
|
|
303 | |
|
|
304 | } elsif ($type eq "done") { |
|
|
305 | enc_U8 254; |
|
|
306 | |
|
|
307 | } elsif ($type eq "more") { |
|
|
308 | enc_U8 253; |
|
|
309 | |
|
|
310 | } elsif ($type eq "comment") { |
|
|
311 | # handle other string params, too |
|
|
312 | enc_U8 9; |
|
|
313 | enc_STRING $arg[0]; |
|
|
314 | |
|
|
315 | } elsif ($type eq "label") { |
|
|
316 | enc_U8 0; |
|
|
317 | enc_U16 ord substr "$arg[0]\x00\x00", 0, 1; |
|
|
318 | enc_U16 ord substr "$arg[0]\x00\x00", 1, 1; |
|
|
319 | enc_U16 ord substr "$arg[0]\x00\x00", 2, 1; |
|
|
320 | enc_U8 $arg[1]; |
|
|
321 | enc_U8 $arg[2]; |
|
|
322 | |
|
|
323 | } elsif ($marker_code{$type}) { |
|
|
324 | enc_U8 $marker_code{$type}; |
|
|
325 | enc_U8 $arg[0]; |
|
|
326 | enc_U8 $arg[1]; |
|
|
327 | enc_U8 $arg[2]; |
|
|
328 | |
|
|
329 | } else { |
|
|
330 | warn "unable to encode tree node type $type\n"; |
|
|
331 | } |
|
|
332 | } |
|
|
333 | } |
|
|
334 | ]]> |
|
|
335 | |
|
|
336 | ############################################################################# |
|
|
337 | # messages |
|
|
338 | <xsl:apply-templates select="descendant::message"/> |
11 | } |
339 | } |
12 | |
340 | |
13 | 1; |
341 | 1; |
14 | </xsl:template> |
342 | </xsl:template> |
15 | |
343 | |
|
|
344 | <xsl:template match="type[@type = 'S']"> |
|
|
345 | sub dec_<xsl:value-of select="@name"/> { |
|
|
346 | my @r = unpack "v<xsl:value-of select="@length"/> a*", $data; |
|
|
347 | $data = pop @r; |
|
|
348 | join ":", map chr, @r; |
|
|
349 | } |
|
|
350 | |
|
|
351 | sub enc_<xsl:value-of select="@name"/> { |
|
|
352 | $data .= pack "v<xsl:value-of select="@length"/>", map ord, split //, $_[0]; |
|
|
353 | } |
|
|
354 | </xsl:template> |
|
|
355 | |
|
|
356 | <xsl:template match="type[@type = 'A']"> |
|
|
357 | sub dec_<xsl:value-of select="@name"/> { |
|
|
358 | (my ($r), $data) = unpack "Z<xsl:value-of select="@length"/> a*", $data; $r; |
|
|
359 | } |
|
|
360 | |
|
|
361 | sub enc_<xsl:value-of select="@name"/> { |
|
|
362 | $data .= pack "Z<xsl:value-of select="@length"/>", $_[0]; |
|
|
363 | } |
|
|
364 | </xsl:template> |
|
|
365 | |
|
|
366 | <xsl:template match="type[@multiplier]"> |
|
|
367 | sub dec_<xsl:value-of select="@name"/> { |
|
|
368 | (1 / <xsl:value-of select="@multiplier"/>) * dec_<xsl:value-of select="@type"/>; |
|
|
369 | } |
|
|
370 | |
|
|
371 | sub enc_<xsl:value-of select="@name"/> { |
|
|
372 | enc_<xsl:value-of select="@type"/> $_[0] * <xsl:value-of select="@multiplier"/>; |
|
|
373 | } |
|
|
374 | </xsl:template> |
|
|
375 | |
|
|
376 | <xsl:template match="member[@array = 'yes']" mode="dec"> |
|
|
377 | $r->{<xsl:value-of select="@name"/>} = (my $array = []); |
|
|
378 | while (length $data) { |
|
|
379 | push @$array, dec_<xsl:value-of select="@type"/> |
|
|
380 | <xsl:text> </xsl:text> |
|
|
381 | <xsl:value-of select="@default"/>; |
|
|
382 | } |
|
|
383 | </xsl:template> |
|
|
384 | |
|
|
385 | <xsl:template match="member" mode="dec"> |
|
|
386 | $r->{<xsl:value-of select="@name"/>} = dec_<xsl:value-of select="@type"/> |
|
|
387 | <xsl:text> </xsl:text> |
|
|
388 | <xsl:value-of select="@default"/> |
|
|
389 | <xsl:if test="@guard-cond"> |
|
|
390 | if ($r->{<xsl:value-of select="@guard-member"/>} <xsl:value-of select="@guard-cond"/>)</xsl:if> |
|
|
391 | <xsl:text>;</xsl:text> |
|
|
392 | </xsl:template> |
|
|
393 | |
|
|
394 | <xsl:template match="member" mode="enc"> |
|
|
395 | <!-- #d#, remove when kgs is repaired --><xsl:if test="@type = 'username'"> |
|
|
396 | $_[0]{<xsl:value-of select="@name"/>} =~ /^[A-Za-z][A-Za-z0-9]{0,11}$/ |
|
|
397 | or Carp::confess "FATAL: tried to send illegal username '$_[0]{<xsl:value-of select="@name"/>}'"; |
|
|
398 | </xsl:if><!--#d#--> |
|
|
399 | enc_<xsl:value-of select="@type"/> defined $_[0]{<xsl:value-of select="@name"/>} ? $_[0]{<xsl:value-of select="@name"/> |
|
|
400 | <xsl:text>} : (</xsl:text> |
|
|
401 | <xsl:value-of select="@default"/> |
|
|
402 | <xsl:text>);</xsl:text> |
|
|
403 | </xsl:template> |
|
|
404 | |
16 | <xsl:template match="macro"> |
405 | <xsl:template match="struct"> |
17 | $macro{<xsl:value-of select="@name"/>} = [<xsl:apply-templates/> |
406 | sub dec_<xsl:value-of select="@name"/> { |
18 | ]; |
407 | my $r = {}; |
|
|
408 | <xsl:apply-templates select="member" mode="dec"/> |
|
|
409 | <xsl:if test="@class"> |
|
|
410 | bless $r, <xsl:value-of select="@class"/>::; |
|
|
411 | </xsl:if> |
|
|
412 | $r; |
|
|
413 | } |
|
|
414 | |
|
|
415 | sub enc_<xsl:value-of select="@name"/> { |
|
|
416 | <xsl:apply-templates select="member" mode="enc"/> |
|
|
417 | } |
19 | </xsl:template> |
418 | </xsl:template> |
20 | |
419 | |
21 | <xsl:template match="message"> |
420 | <xsl:template match="message"> |
22 | # <xsl:value-of select="@name"/> |
421 | # <xsl:value-of select="@name"/> |
23 | my $msg = [<xsl:apply-templates/> |
|
|
24 | ];<xsl:if test="@send='yes'"> |
|
|
25 | $send{<xsl:value-of select="@name"/>} = [ 0x<xsl:value-of select="@type"/>, $msg ]; |
422 | $dec_<xsl:value-of select="@src"/>{0x<xsl:value-of select="@type"/>} = sub { |
26 | </xsl:if> |
423 | $data = $_[0]; |
27 | <xsl:if test="@recv='yes'"> |
424 | my $r; |
|
|
425 | $r->{type} = "<xsl:value-of select="@name"/>"; |
|
|
426 | <xsl:apply-templates select="member" mode="dec"/> |
|
|
427 | $r; |
|
|
428 | }; |
28 | $recv{0x<xsl:value-of select="@type"/>} = [ <xsl:value-of select="@name"/> => $msg ]; |
429 | $enc_<xsl:value-of select="@src"/>{<xsl:value-of select="@name"/>} = sub { |
29 | </xsl:if> |
430 | $data = ""; |
|
|
431 | enc_U16 0x<xsl:value-of select="@type"/>; |
|
|
432 | <xsl:apply-templates select="member" mode="enc"/> |
|
|
433 | $data; |
|
|
434 | }; |
30 | </xsl:template> |
435 | </xsl:template> |
31 | |
436 | |
32 | <xsl:template match="member"> |
437 | <xsl:template match="member"> |
33 | [<xsl:value-of select="@name"/> => "<xsl:value-of select="@type"/>", "<xsl:value-of select="@default"/>", "<xsl:value-of select="@guard"/>"],<!-- |
438 | [<xsl:value-of select="@name"/> |
|
|
439 | <xsl:text>=> "</xsl:text> |
|
|
440 | <xsl:value-of select="@type"/> |
|
|
441 | <xsl:text>", "</xsl:text> |
|
|
442 | <xsl:value-of select="@default"/> |
|
|
443 | <xsl:text>", "</xsl:text> |
|
|
444 | <xsl:value-of select="@guard"/> |
|
|
445 | <xsl:text>;"],</xsl:text> |
34 | --></xsl:template> |
446 | </xsl:template> |
35 | |
447 | |
36 | <xsl:template match="text()"> |
448 | <xsl:template match="text()"> |
37 | </xsl:template> |
449 | </xsl:template> |
38 | |
450 | |
39 | </xsl:stylesheet> |
451 | </xsl:stylesheet> |