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.5 by pcg, Tue Jun 10 08:01:17 2003 UTC vs.
Revision 1.11 by pcg, Sun Jul 20 15:01:24 2003 UTC

17use KGS::Constants; # REPLACE by parsed file, too 17use KGS::Constants; # REPLACE by parsed file, too
18 18
19use strict; 19use strict;
20 20
21our %type; 21our %type;
22our %send; 22
23our %recv; 23our %dec_send; # decode messages send to server
24our %enc_send; # encode messages send to server
25our %dec_recv; # decode messages received from server
26our %enc_recv; # encode messages received from server
24 27
25{ 28{
26 29
27my $data; # stores currently processed decoding/encoding packet 30my $data; # stores currently processed decoding/encoding packet
28 31
74 77
75sub dec_CONSTANT { 78sub dec_CONSTANT {
76 $_[0]; 79 $_[0];
77} 80}
78 81
82sub dec_password {
83 dec_U64;
84}
85
79sub dec_HEX { # for debugging 86sub dec_HEX { # for debugging
80 "HEX: " . unpack "H*", $data;#d# 87 "HEX: " . unpack "H*", $data;#d#
81}
82
83sub enc_HEX {
84 die "enc_HEX not defined for good";
85} 88}
86 89
87############################################################################# 90#############################################################################
88 91
89sub enc_U8 { 92sub enc_U8 {
101sub enc_U64 { 104sub 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
109sub enc_I8 {
110 $data .= pack "c", $_[0];
111}
112
113sub enc_I16 {
114 enc_U16 unpack "S", pack "s", $_[0];
115}
116
106sub enc_I32 { 117sub enc_I32 {
107 enc_U32 unpack "I", pack "i", $_[0]; 118 enc_U32 unpack "I", pack "i", $_[0];
108} 119}
109 120
110sub enc_DATA { 121sub enc_DATA {
114 125
115sub enc_STRING { 126sub 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
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
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(?)
146sub dec_TREE { 174sub 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
228sub enc_TREE { 295sub 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>

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines