--- kgsueme/doc/doc2messages.xsl 2003/06/05 10:09:10 1.2 +++ kgsueme/doc/doc2messages.xsl 2003/07/22 03:35:34 1.15 @@ -14,11 +14,16 @@ package KGS::Messages; +use KGS::Constants; # REPLACE by parsed file, too + use strict; our %type; -our %send; -our %recv; + +our %dec_client; # decode messages send to server +our %enc_client; # encode messages send to server +our %dec_server; # decode messages received from server +our %enc_server; # encode messages received from server { @@ -74,12 +79,12 @@ $_[0]; } -sub dec_HEX { # for debugging - "HEX: " . unpack "H*", $data;#d# +sub dec_password { + dec_U64; } -sub enc_HEX { - die "enc_HEX not defined for good"; +sub dec_HEX { # for debugging + "HEX: " . unpack "H*", $data;#d# } ############################################################################# @@ -101,6 +106,14 @@ enc_U32 +($_[0] >> 32) & 0xffffffff; } +sub enc_I8 { + $data .= pack "c", $_[0]; +} + +sub enc_I16 { + enc_U16 unpack "S", pack "s", $_[0]; +} + sub enc_I32 { enc_U32 unpack "I", pack "i", $_[0]; } @@ -114,6 +127,23 @@ # should use encode for speed and clarity ;) $data .= pack "v*", map ord, split //, $_[0]; } + +sub enc_CONSTANT { + # nop +} + +sub enc_password { + require Math::BigInt; # I insist on 32-bit-perl.. should use C + # $hash must be 64 bit + my $hash = new Math::BigInt; + $hash = $hash * 1055 + ord for split //, $_[0]; + enc_U64 $hash; +} + +sub enc_HEX { + die "enc_HEX not defined for good"; +} + ]]> ############################################################################# @@ -145,49 +175,97 @@ my @r; while (length $data) { my $type = dec_U8; + my $add = $type < 128; - if ($type == 255) { - push @r, [add_child => dec_U32]; + $type &= 127; - } elsif ($type == 254) { - push @r, ["done"]; + if ($type == 127) { + dec_U8; # unused?? *sigh* + push @r, [add_node => dec_I32]; - } elsif ($type == 253) { - push @r, ["type253"]; - # ???? + } elsif ($type == 126) { + push @r, [set_node => dec_I32]; - } elsif ($type == 252) { # even less clear - push @r, ["more"]; + } elsif ($type == 125) { + push @r, [set_current => dec_I32]; - } elsif ($type == 10) { - # as usual, wms finds yet another way to duplicate code... oh well, what a mess. - # (no wonder he is so keen on keeping it secret...) + } elsif ($type == 34) { + push @r, [score => dec_U8, dec_score1000]; - push @r, [rules => dec_rules]; + } elsif ($type == 29) { + push @r, [type_29 => dec_STRING]; + warn "TYPE 29 $r[-1][1]\007 PLEASE REPORT";#d# + die; + + } elsif ($type == 28) { + # move number, only in variations it seems. oh my. + push @r, [movenum => dec_STRING]; + + } elsif ($type == 25) { + push @r, [result => dec_result]; + + } elsif ($type == 23) { + push @r, [mark => $add, MARK_GRAYED, dec_U8, dec_U8]; + + } elsif ($type == 22) { + push @r, [mark => $add, (&dec_U8 ? MARK_SMALL_W : MARK_SMALL_B), dec_U8, dec_U8]; + + } elsif ($type == 21) { + push @r, [mark => $add, MARK_CIRCLE, dec_U8, dec_U8]; + + } elsif ($type == 20) { + push @r, [mark => $add, MARK_SQUARE, dec_U8, dec_U8]; + + } elsif ($type == 19) { + push @r, [mark => $add, MARK_TRIANGLE, dec_U8, dec_U8]; + + } elsif ($type == 18) { + push @r, [mark => $add, MARK_LABEL, dec_U8, dec_U8, dec_STRING]; + + } elsif ($type == 17) { + push @r, [set_timer => (dec_U8, dec_U32, dec_time)[0,2,1]]; + + } elsif ($type == 16) { + push @r, [set_stone => $add, dec_U8, dec_U8, dec_U8]; + + } elsif ($type == 14) { + push @r, [move => $add, dec_U8, dec_U8, dec_U8]; + + } elsif (($type >= 4 && $type <= 9) + || ($type >= 11 && $type <= 13) + || $type == 24) { - } elsif ($type == 9 || $type == 22 || $type == 25 || $type == 31 || $type == 32) { push @r, [({ - 9 => "comment", - 22 => "unknown_comment22", - 25 => "copyright", #? - 31 => "date", - 32 => "unknown_comment32", + 4 => "date", + 5 => "unknown_comment5", + 6 => "unknown_comment6", + 7 => "unknown_comment7", + 8 => "unknown_comment8", + 9 => "copyright", #? + 11 => "unknown_comment11", + 12 => "unknown_comment12", + 13 => "unknown_comment13", + 24 => "comment", })->{$type} => dec_STRING]; - } elsif ($type == 11 || $type == 12) { - push @r, [player => $type - 11, dec_STRING]; + } elsif ($type == 3) { + push @r, [rank => dec_U8, dec_U32]; - } elsif ($type == 13 || $type == 14) { - push @r, [rank => $type - 13, dec_U32]; + } elsif ($type == 2) { + push @r, [player => dec_U8, dec_STRING]; - } elsif ($type == 15 || $type == 16) { - push @r, [set_timer => $type - 15, dec_time, dec_U16]; + } elsif ($type == 0) { + # as usual, wms finds yet another way to duplicate code... oh well, what a mess. + # (no wonder he is so keen on keeping it a secret...) - } elsif ($type == 17 || $type == 18) { - push @r, [score => $type - 17, dec_score]; + push @r, [rules => dec_rules]; - } elsif ($type == 19) { - push @r, [result => dec_result]; + # OLD + + } elsif (1) { + print STDERR KGS::Listener::Debug::dumpval(\@r); + open XTYPE, "|xtype"; print XTYPE $data; close XTYPE; + die "unknown tree type $type, PLEASE REPORT and include the game you wanted to watch. thx."; } elsif ($type == 30) { push @r, [active_player => dec_U8]; @@ -224,12 +302,13 @@ } sub enc_TREE { + die "tree encoding not yet supported again"; for (@{$_[0]}) { my ($type, @arg) = @$_; if ($type eq "add_child") { enc_U8 255; - enc_U32 $arg[0]; + enc_I32 $arg[0]; } elsif ($type eq "done") { enc_U8 254; @@ -273,9 +352,16 @@ sub dec_ { + my $res = ""; my @r = unpack "v a*", $data; $data = pop @r; - join ":", map chr, @r; + for (@r) { + last unless $_; + $res .= chr $_; + } + # dump extra data to file for later analysis + #my $x = pack "v*", @r; $x =~ s/^(..)*?\x00\x00//s; open DUMP, ">>/tmp/dump"; print DUMP $x; close DUMP;#d# + $res; } sub enc_ { @@ -326,10 +412,6 @@ $_[0]{} =~ /^[A-Za-z][A-Za-z0-9]{0,11}$/ or Carp::confess "FATAL: tried to send illegal username '$_[0]{}'"; - - $_[0]{} > 0 - or Carp::confess "FATAL: tried to send a zero channel id"; - enc_ defined $_[0]{} ? $_[0]{ } : ( @@ -353,23 +435,19 @@ # - -$recv{0x} = sub { +$dec_{0x} = sub { $data = $_[0]; my $r; $r->{type} = ""; $r; }; - - -$send{} = sub { +$enc_{} = sub { $data = ""; enc_U16 0x; $data; }; -