"") ############################################################################# enc_U8 :: Word8 -> DecS () enc_U8 a = do x <- get put (a:x) return () enc_U16 :: Word16 -> DecS () enc_U16 a = do x <- get let b1 = fromIntegral (a `shiftR` 8) :: Word8 b2 = fromIntegral a :: Word8 put (b1:b2:x) enc_U32 :: Word32 -> DecS () enc_U32 a = let b1 = fromIntegral (a `shiftR` 16) :: Word16 b2 = fromIntegral a :: Word16 enc_U16 b2 enc_U16 b1 enc_U64 :: Word64 -> DecS () enc_U64 a = let b1 = fromIntegral (a `shiftR` 48) :: Word16 b2 = fromIntegral (a `shiftR` 32) :: Word16 b3 = fromIntegral (a `shiftR` 16) :: Word16 b4 = fromIntegral a :: Word16 enc_U16 b4 enc_U16 b3 enc_U16 b2 enc_U16 b1 enc_I8 :: Int8 -> DecS () enc_I8 a = enc_U8 (fromIntegral a :: Word8) enc_I16 :: Int16 -> DecS () enc_I16 a = let b1 = fromIntegral (a `shiftR` 8) :: Word8 b2 = fromIntegral a :: Word8 enc_U8 b2 enc_U8 b1 enc_I32 :: Int32 -> DecS () enc_I32 a = let b1 = fromIntegral (a `shiftR` 16) :: Word16 b2 = fromIntegral a :: Word16 enc_U16 b2 enc_U16 b1 enc_DATA :: [Word8] -> DecS () enc_DATA d = do x <- get put $ (reverse d) ++ x enc_STRING :: [Word16] -> DecS () enc_STRING (s:ss) = do enc_U16 s enc_STRING ss {- do let mstr = reverse s putall (u:ls) = do enc_U8 u putall ls putall [] = return () putall mstr enc_U8 0 -} enc_CONSTANT :: a -> DecS () enc_CONSTANT _ = return () enc_password :: Password -> DecS () enc_password (p:ps) = (1055 * (enc_password ps)) + (fromEnum p) {- marc??? 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; } -} ]]> ############################################################################# # types ############################################################################# # structures ############################################################################# # "less" primitive types ############################################################################# # messages data KGS_server_msg = KGS_server_msg_null | KGS_server_ { } data KGS_client_msg = KGS_server_msg_null | KGS_client_ { } } 1; type = String -- decode UCS-2 string of length -- the first 0 terminates the string, but not the field dec_ :: DecS String dec_ = do getS where -- getS ls 0 = reverse ls getS ls 0 = reverse (map (\c -> toEnum (fromIntegral c :: Int)) ls) getS ls n = dec_U8 >>=\c getS (c:[]) (n-1) -- likewise, encode as UCS-2, fill space with 0 enc_ :: String -> DecS () enc_ str = do let rlen = (length str) - putS str putN rlen where putN 0 = return () putN n = enc_U8 0 n-1 putS [] = return () putS (c:cs) = do enc_U8 c putS cs type = String -- decode ASCII string of length -- the first 0 terminates the string, but not the field dec_ :: DecS String dec_ = do getS where getS ls 0 = reverse (map (\c -> toEnum (fromIntegral c :: Int)) ls) -- getS (0:ls) n = getS (0:ls) (n-1) getS ls n = dec_U8 >>=\c getS (c:[]) (n-1) -- likewise, encode as ASCII, fill space with 0 enc_ :: String -> DecS () enc_ str = do let rlen = (length str) - putS str putN rlen where putN 0 = return () putN n = enc_U8 0 n-1 putS [] = return () putS (c:cs) = do enc_U8 c putS cs type = Float dec_ = do n <- dec_ return $ n * (1 / ) enc_ n = enc_ $ n * $r->{} = (my $array = []); while (length $data) { push @$array, dec_ ; } if then do <- dec_ enc_ $ s : ! data KGS_ = KGS_ { } dec_ = do return KGS_ enc_ s = -- dec__ = do return KGS_ enc__ = enc_U16 0x