… | |
… | |
17 | use KGS::Constants; # REPLACE by parsed file, too |
17 | use KGS::Constants; # REPLACE by parsed file, too |
18 | |
18 | |
19 | use strict; |
19 | use strict; |
20 | |
20 | |
21 | our %type; |
21 | our %type; |
22 | our %send; |
22 | |
23 | our %recv; |
23 | our %dec_send; # decode messages send to server |
|
|
24 | our %enc_send; # encode messages send to server |
|
|
25 | our %dec_recv; # decode messages received from server |
|
|
26 | our %enc_recv; # encode messages received from server |
24 | |
27 | |
25 | { |
28 | { |
26 | |
29 | |
27 | my $data; # stores currently processed decoding/encoding packet |
30 | my $data; # stores currently processed decoding/encoding packet |
28 | |
31 | |
… | |
… | |
74 | |
77 | |
75 | sub dec_CONSTANT { |
78 | sub dec_CONSTANT { |
76 | $_[0]; |
79 | $_[0]; |
77 | } |
80 | } |
78 | |
81 | |
|
|
82 | sub dec_password { |
|
|
83 | dec_U64; |
|
|
84 | } |
|
|
85 | |
79 | sub dec_HEX { # for debugging |
86 | sub dec_HEX { # for debugging |
80 | "HEX: " . unpack "H*", $data;#d# |
87 | "HEX: " . unpack "H*", $data;#d# |
81 | } |
|
|
82 | |
|
|
83 | sub enc_HEX { |
|
|
84 | die "enc_HEX not defined for good"; |
|
|
85 | } |
88 | } |
86 | |
89 | |
87 | ############################################################################# |
90 | ############################################################################# |
88 | |
91 | |
89 | sub enc_U8 { |
92 | sub enc_U8 { |
… | |
… | |
101 | sub enc_U64 { |
104 | sub enc_U64 { |
102 | enc_U32 $_[0] & 0xffffffff; |
105 | enc_U32 $_[0] & 0xffffffff; |
103 | enc_U32 +($_[0] >> 32) & 0xffffffff; |
106 | enc_U32 +($_[0] >> 32) & 0xffffffff; |
104 | } |
107 | } |
105 | |
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 | |
106 | sub enc_I32 { |
117 | sub enc_I32 { |
107 | enc_U32 unpack "I", pack "i", $_[0]; |
118 | enc_U32 unpack "I", pack "i", $_[0]; |
108 | } |
119 | } |
109 | |
120 | |
110 | sub enc_DATA { |
121 | sub enc_DATA { |
… | |
… | |
114 | |
125 | |
115 | sub enc_STRING { |
126 | sub enc_STRING { |
116 | # should use encode for speed and clarity ;) |
127 | # should use encode for speed and clarity ;) |
117 | $data .= pack "v*", map ord, split //, $_[0]; |
128 | $data .= pack "v*", map ord, split //, $_[0]; |
118 | } |
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 | |
119 | ]]> |
147 | ]]> |
120 | |
148 | |
121 | ############################################################################# |
149 | ############################################################################# |
122 | # types |
150 | # types |
123 | <xsl:apply-templates select="descendant::type"/> |
151 | <xsl:apply-templates select="descendant::type"/> |
… | |
… | |
145 | # 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(?) |
146 | sub dec_TREE { |
174 | sub dec_TREE { |
147 | my @r; |
175 | my @r; |
148 | while (length $data) { |
176 | while (length $data) { |
149 | my $type = dec_U8; |
177 | my $type = dec_U8; |
|
|
178 | my $add = $type < 128; |
150 | |
179 | |
|
|
180 | $type &= 127; |
|
|
181 | |
151 | if ($type == 255) { |
182 | if ($type == 127) { |
|
|
183 | dec_U8; # unused?? *sigh* |
152 | push @r, [add_child => dec_I32]; |
184 | push @r, [add_node => dec_I32]; |
153 | |
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 | |
154 | } elsif ($type == 254) { |
195 | } elsif ($type == 25) { |
155 | push @r, ["done"]; |
196 | push @r, [result => dec_result]; |
156 | |
197 | |
157 | } elsif ($type == 253) { |
198 | } elsif ($type == 23) { |
158 | push @r, ["type253"]; |
199 | push @r, [mark => $add, MARK_GRAYED, dec_U8, dec_U8]; |
159 | # ???? |
|
|
160 | |
200 | |
161 | } elsif ($type == 252) { # even less clear |
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 | |
162 | push @r, ["more"]; |
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]; |
163 | |
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 | |
164 | } elsif ($type == 10) { |
248 | } elsif ($type == 0) { |
165 | # as usual, wms finds yet another way to duplicate code... oh well, what a mess. |
249 | # as usual, wms finds yet another way to duplicate code... oh well, what a mess. |
166 | # (no wonder he is so keen on keeping it secret...) |
250 | # (no wonder he is so keen on keeping it a secret...) |
167 | |
251 | |
168 | push @r, [rules => dec_rules]; |
252 | push @r, [rules => dec_rules]; |
169 | |
253 | |
170 | } elsif ($type == 9 || $type == 22 || $type == 25 || $type == 31 || $type == 32) { |
254 | # OLD |
171 | push @r, [({ |
|
|
172 | 9 => "comment", |
|
|
173 | 22 => "unknown_comment22", |
|
|
174 | 25 => "copyright", #? |
|
|
175 | 31 => "date", |
|
|
176 | 32 => "unknown_comment32", |
|
|
177 | })->{$type} => dec_STRING]; |
|
|
178 | |
255 | |
179 | } elsif ($type == 11 || $type == 12) { |
|
|
180 | push @r, [player => $type - 11, dec_STRING]; |
|
|
181 | |
|
|
182 | } elsif ($type == 13 || $type == 14) { |
|
|
183 | push @r, [rank => $type - 13, dec_U32]; |
|
|
184 | |
|
|
185 | } elsif ($type == 15 || $type == 16) { |
|
|
186 | push @r, [set_timer => $type - 15, dec_time, dec_U16]; |
|
|
187 | |
|
|
188 | } elsif ($type == 17 || $type == 18) { |
|
|
189 | push @r, [score => $type - 17, dec_score16]; |
|
|
190 | |
|
|
191 | } elsif ($type == 19) { |
256 | } elsif (1) { |
192 | push @r, [result => dec_result]; |
257 | print STDERR KGS::Listener::Debug::dumpval(\@r); |
|
|
258 | open XTYPE, "|xtype"; print XTYPE $data; close XTYPE; |
|
|
259 | die "unknown type $type"; |
193 | |
260 | |
194 | } elsif ($type == 30) { |
261 | } elsif ($type == 30) { |
195 | push @r, [active_player => dec_U8]; |
262 | push @r, [active_player => dec_U8]; |
196 | |
263 | |
197 | } elsif ($type == 0) { # label(?) |
264 | } elsif ($type == 0) { # label(?) |
… | |
… | |
224 | } |
291 | } |
225 | \@r; |
292 | \@r; |
226 | } |
293 | } |
227 | |
294 | |
228 | sub enc_TREE { |
295 | sub enc_TREE { |
|
|
296 | die "tree encoding not yet supported again"; |
229 | for (@{$_[0]}) { |
297 | for (@{$_[0]}) { |
230 | my ($type, @arg) = @$_; |
298 | my ($type, @arg) = @$_; |
231 | |
299 | |
232 | if ($type eq "add_child") { |
300 | if ($type eq "add_child") { |
233 | enc_U8 255; |
301 | enc_U8 255; |
… | |
… | |
325 | |
393 | |
326 | <xsl:template match="member" mode="enc"> |
394 | <xsl:template match="member" mode="enc"> |
327 | <!-- #d#, remove when kgs is repaired --><xsl:if test="@type = 'username'"> |
395 | <!-- #d#, remove when kgs is repaired --><xsl:if test="@type = 'username'"> |
328 | $_[0]{<xsl:value-of select="@name"/>} =~ /^[A-Za-z][A-Za-z0-9]{0,11}$/ |
396 | $_[0]{<xsl:value-of select="@name"/>} =~ /^[A-Za-z][A-Za-z0-9]{0,11}$/ |
329 | or Carp::confess "FATAL: tried to send illegal username '$_[0]{<xsl:value-of select="@name"/>}'"; |
397 | or Carp::confess "FATAL: tried to send illegal username '$_[0]{<xsl:value-of select="@name"/>}'"; |
330 | </xsl:if><!--#d#--> |
|
|
331 | <!-- #d#, remove when kgs is repaired --><xsl:if test="@name = 'channel'"> |
|
|
332 | $_[0]{<xsl:value-of select="@name"/>} > 0 |
|
|
333 | or Carp::confess "FATAL: tried to send a zero channel id"; |
|
|
334 | </xsl:if><!--#d#--> |
398 | </xsl:if><!--#d#--> |
335 | enc_<xsl:value-of select="@type"/> defined $_[0]{<xsl:value-of select="@name"/>} ? $_[0]{<xsl:value-of select="@name"/> |
399 | enc_<xsl:value-of select="@type"/> defined $_[0]{<xsl:value-of select="@name"/>} ? $_[0]{<xsl:value-of select="@name"/> |
336 | <xsl:text>} : (</xsl:text> |
400 | <xsl:text>} : (</xsl:text> |
337 | <xsl:value-of select="@default"/> |
401 | <xsl:value-of select="@default"/> |
338 | <xsl:text>);</xsl:text> |
402 | <xsl:text>);</xsl:text> |
… | |
… | |
353 | } |
417 | } |
354 | </xsl:template> |
418 | </xsl:template> |
355 | |
419 | |
356 | <xsl:template match="message"> |
420 | <xsl:template match="message"> |
357 | # <xsl:value-of select="@name"/> |
421 | # <xsl:value-of select="@name"/> |
358 | <xsl:if test="@recv='yes'"> |
422 | $dec_<xsl:value-of select="@dir"/>{0x<xsl:value-of select="@type"/>} = sub { |
359 | $recv{0x<xsl:value-of select="@type"/>} = sub { |
|
|
360 | $data = $_[0]; |
423 | $data = $_[0]; |
361 | my $r; |
424 | my $r; |
362 | $r->{type} = "<xsl:value-of select="@name"/>"; |
425 | $r->{type} = "<xsl:value-of select="@name"/>"; |
363 | <xsl:apply-templates select="member" mode="dec"/> |
426 | <xsl:apply-templates select="member" mode="dec"/> |
364 | $r; |
427 | $r; |
365 | }; |
428 | }; |
366 | </xsl:if> |
429 | $enc_<xsl:value-of select="@dir"/>{<xsl:value-of select="@name"/>} = sub { |
367 | <xsl:if test="@send='yes'"> |
|
|
368 | $send{<xsl:value-of select="@name"/>} = sub { |
|
|
369 | $data = ""; |
430 | $data = ""; |
370 | enc_U16 0x<xsl:value-of select="@type"/>; |
431 | enc_U16 0x<xsl:value-of select="@type"/>; |
371 | <xsl:apply-templates select="member" mode="enc"/> |
432 | <xsl:apply-templates select="member" mode="enc"/> |
372 | $data; |
433 | $data; |
373 | }; |
434 | }; |
374 | </xsl:if> |
|
|
375 | </xsl:template> |
435 | </xsl:template> |
376 | |
436 | |
377 | <xsl:template match="member"> |
437 | <xsl:template match="member"> |
378 | [<xsl:value-of select="@name"/> |
438 | [<xsl:value-of select="@name"/> |
379 | <xsl:text>=> "</xsl:text> |
439 | <xsl:text>=> "</xsl:text> |