1 |
pcg |
1.13 |
<!DOCTYPE xsl:stylesheet> |
2 |
pcg |
1.1 |
<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform"> |
3 |
|
|
|
4 |
|
|
<xsl:output method="text" media-type="text/plain" encoding="utf-8"/> |
5 |
|
|
|
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/doc2haskell.xsl |
14 |
|
|
|
15 |
|
|
-- primitive enc/decoders |
16 |
|
|
|
17 |
elmex |
1.9 |
module KGSProtocoll where |
18 |
|
|
import Numeric |
19 |
pcg |
1.2 |
import Data.Word |
20 |
elmex |
1.14 |
import Data.Int |
21 |
pcg |
1.2 |
import Control.Monad.State |
22 |
pcg |
1.1 |
|
23 |
elmex |
1.14 |
type U8 = Word8 |
24 |
|
|
type U16 = Word16 |
25 |
|
|
type U32 = Word32 |
26 |
pcg |
1.13 |
type U64 = Word64 |
27 |
elmex |
1.14 |
type I8 = Int8 |
28 |
|
|
type I16 = Int16 |
29 |
|
|
type I32 = Int32 |
30 |
|
|
type I64 = Int64 |
31 |
pcg |
1.13 |
|
32 |
elmex |
1.9 |
data DecState = DecState { data :: [Word8] } |
33 |
|
|
|
34 |
|
|
-- type DecS a = State DecState a |
35 |
|
|
type DecS a = StateT DecState IO a -- for dec_HEX |
36 |
|
|
|
37 |
|
|
hasData :: DecS Bool |
38 |
pcg |
1.4 |
hasData = do |
39 |
|
|
xs <- get |
40 |
|
|
return $ not $ null xs |
41 |
|
|
|
42 |
pcg |
1.13 |
dec_U8 :: Word8 |
43 |
|
|
dec_U8 = |
44 |
elmex |
1.9 |
do (x:xs) <- get |
45 |
|
|
put xs |
46 |
|
|
return x |
47 |
|
|
|
48 |
pcg |
1.13 |
dec_U16 :: DecS Word16 |
49 |
|
|
dec_U16 = |
50 |
|
|
do a <- dec_U8 |
51 |
|
|
b <- dec_U8 |
52 |
elmex |
1.9 |
return $ (fromIntegral a :: Word16) + (fromIntegral b :: Word16) * 256 |
53 |
|
|
|
54 |
|
|
|
55 |
|
|
dec_U64 :: DecS Word64 |
56 |
|
|
dec_U64 = |
57 |
pcg |
1.13 |
do a1 <- dec_U16 |
58 |
|
|
a2 <- dec_U16 |
59 |
|
|
a3 <- dec_U16 |
60 |
|
|
a4 <- dec_U16 |
61 |
pcg |
1.11 |
return $ (fI a4) `shiftL` 48 |
62 |
|
|
+ (fI a3) `shiftL` 32 |
63 |
|
|
+ (fI a2) `shiftL` 16 |
64 |
|
|
+ (fI a1) |
65 |
elmex |
1.9 |
where fI a = fromIntegral a :: Word64 |
66 |
|
|
|
67 |
|
|
|
68 |
|
|
dec_I8 :: DecS Int8 |
69 |
|
|
dec_I8 = |
70 |
pcg |
1.13 |
do w8 <- dec_U8 |
71 |
elmex |
1.9 |
return $ fromIntegral w8 :: Int8 |
72 |
|
|
|
73 |
|
|
dec_I16 :: DecS Int16 |
74 |
|
|
dec_I16 = |
75 |
pcg |
1.13 |
do w16 <- dec_U16 |
76 |
elmex |
1.9 |
return $ fromIntegral w16 :: Int16 |
77 |
|
|
|
78 |
|
|
dec_I32 :: DecS Int32 |
79 |
|
|
dec_I32 = |
80 |
pcg |
1.13 |
do w16_1 <- dec_U16 |
81 |
|
|
w16_2 <- dec_U16 |
82 |
pcg |
1.11 |
return $ (fI w16_2) `shiftL` 16 |
83 |
|
|
+ (fI w16_1) |
84 |
elmex |
1.9 |
where fI a = fromIntegral a :: Int32 |
85 |
|
|
|
86 |
|
|
dec_DATA :: DecS [Word8] |
87 |
|
|
dec_DATA = |
88 |
|
|
do da <- get |
89 |
|
|
put [] |
90 |
|
|
return da |
91 |
|
|
|
92 |
elmex |
1.12 |
dec_STRING :: DecS [Word16] |
93 |
elmex |
1.9 |
dec_STRING = |
94 |
pcg |
1.13 |
do c <- dec_U16 |
95 |
elmex |
1.12 |
if c == 0 then do return [] |
96 |
|
|
else return (c:dec_STRING) |
97 |
|
|
|
98 |
|
|
{- do da <- get |
99 |
elmex |
1.9 |
let (str,rest) = mkstr da |
100 |
|
|
where |
101 |
|
|
mkstr str [] = |
102 |
|
|
(reverse str,[]) |
103 |
|
|
mkstr str (0:rest) = |
104 |
|
|
(reverse str, rest) |
105 |
|
|
mkstr str (c:rest) = |
106 |
elmex |
1.12 |
mkstr ((toEnum (fromIntegral c :: Int)):str) rest -} |
107 |
pcg |
1.1 |
|
108 |
elmex |
1.9 |
{- |
109 |
pcg |
1.1 |
sub dec_STRING { |
110 |
|
|
$data =~ s/^((?:..)*?)(?:\x00\x00|\Z)//s; |
111 |
|
|
# use Encode... |
112 |
elmex |
1.9 |
join "", map chr, unpack "v*", $1; -- marc ??? |
113 |
|
|
} |
114 |
|
|
-} |
115 |
|
|
|
116 |
|
|
dec_CONSTANT :: DecS a |
117 |
|
|
dec_CONSTANT x = x |
118 |
|
|
|
119 |
|
|
type Password = Word64 |
120 |
|
|
|
121 |
|
|
dec_password :: DecS Password |
122 |
|
|
dec_password = dec_U64 |
123 |
|
|
|
124 |
|
|
dec_HEX :: DecS () |
125 |
|
|
dec_HEX = |
126 |
|
|
do da <- get |
127 |
|
|
putStr "HEX: " |
128 |
|
|
putStrLn $ (dec_data da) "" |
129 |
|
|
where dec_data (x:xs) = |
130 |
|
|
((drop 2) . showHex x . (':':)) . (dec_data xs) |
131 |
|
|
dec_data [] = (\_ -> "") |
132 |
pcg |
1.1 |
|
133 |
|
|
############################################################################# |
134 |
|
|
|
135 |
pcg |
1.13 |
enc_U8 :: Word8 -> DecS () |
136 |
|
|
enc_U8 a = |
137 |
elmex |
1.9 |
do x <- get |
138 |
|
|
put (a:x) |
139 |
|
|
return () |
140 |
|
|
|
141 |
pcg |
1.13 |
enc_U16 :: Word16 -> DecS () |
142 |
|
|
enc_U16 a = |
143 |
elmex |
1.9 |
do x <- get |
144 |
|
|
let b1 = fromIntegral (a `shiftR` 8) :: Word8 |
145 |
|
|
b2 = fromIntegral a :: Word8 |
146 |
pcg |
1.11 |
put (b1:b2:x) |
147 |
elmex |
1.9 |
|
148 |
|
|
enc_U32 :: Word32 -> DecS () |
149 |
|
|
enc_U32 a = |
150 |
|
|
let b1 = fromIntegral (a `shiftR` 16) :: Word16 |
151 |
|
|
b2 = fromIntegral a :: Word16 |
152 |
pcg |
1.13 |
enc_U16 b2 |
153 |
|
|
enc_U16 b1 |
154 |
elmex |
1.9 |
|
155 |
|
|
enc_U64 :: Word64 -> DecS () |
156 |
|
|
enc_U64 a = |
157 |
|
|
let b1 = fromIntegral (a `shiftR` 48) :: Word16 |
158 |
|
|
b2 = fromIntegral (a `shiftR` 32) :: Word16 |
159 |
|
|
b3 = fromIntegral (a `shiftR` 16) :: Word16 |
160 |
|
|
b4 = fromIntegral a :: Word16 |
161 |
pcg |
1.13 |
enc_U16 b4 |
162 |
|
|
enc_U16 b3 |
163 |
|
|
enc_U16 b2 |
164 |
|
|
enc_U16 b1 |
165 |
elmex |
1.9 |
|
166 |
|
|
enc_I8 :: Int8 -> DecS () |
167 |
|
|
enc_I8 a = |
168 |
pcg |
1.13 |
enc_U8 (fromIntegral a :: Word8) |
169 |
elmex |
1.9 |
|
170 |
|
|
enc_I16 :: Int16 -> DecS () |
171 |
|
|
enc_I16 a = |
172 |
|
|
let b1 = fromIntegral (a `shiftR` 8) :: Word8 |
173 |
|
|
b2 = fromIntegral a :: Word8 |
174 |
pcg |
1.13 |
enc_U8 b2 |
175 |
|
|
enc_U8 b1 |
176 |
elmex |
1.9 |
|
177 |
|
|
enc_I32 :: Int32 -> DecS () |
178 |
|
|
enc_I32 a = |
179 |
|
|
let |
180 |
|
|
b1 = fromIntegral (a `shiftR` 16) :: Word16 |
181 |
|
|
b2 = fromIntegral a :: Word16 |
182 |
pcg |
1.13 |
enc_U16 b2 |
183 |
|
|
enc_U16 b1 |
184 |
elmex |
1.9 |
|
185 |
|
|
enc_DATA :: [Word8] -> DecS () |
186 |
|
|
enc_DATA d = |
187 |
|
|
do x <- get |
188 |
|
|
put $ (reverse d) ++ x |
189 |
|
|
|
190 |
elmex |
1.12 |
enc_STRING :: [Word16] -> DecS () |
191 |
|
|
enc_STRING (s:ss) = |
192 |
pcg |
1.13 |
do enc_U16 s |
193 |
elmex |
1.12 |
enc_STRING ss |
194 |
|
|
|
195 |
|
|
{- do let mstr = reverse s |
196 |
elmex |
1.9 |
putall (u:ls) = |
197 |
pcg |
1.13 |
do enc_U8 u |
198 |
elmex |
1.9 |
putall ls |
199 |
|
|
putall [] = return () |
200 |
|
|
putall mstr |
201 |
pcg |
1.13 |
enc_U8 0 -} |
202 |
elmex |
1.9 |
|
203 |
|
|
enc_CONSTANT :: a -> DecS () |
204 |
|
|
enc_CONSTANT _ = return () |
205 |
|
|
|
206 |
|
|
enc_password :: Password -> DecS () |
207 |
elmex |
1.12 |
enc_password (p:ps) = |
208 |
|
|
(1055 * (enc_password ps)) + (fromEnum p) |
209 |
pcg |
1.1 |
|
210 |
elmex |
1.9 |
{- marc??? |
211 |
pcg |
1.1 |
sub enc_password { |
212 |
|
|
require Math::BigInt; # I insist on 32-bit-perl.. should use C |
213 |
|
|
# $hash must be 64 bit |
214 |
|
|
my $hash = new Math::BigInt; |
215 |
|
|
$hash = $hash * 1055 + ord for split //, $_[0]; |
216 |
|
|
enc_U64 $hash; |
217 |
|
|
} |
218 |
elmex |
1.9 |
-} |
219 |
pcg |
1.1 |
|
220 |
|
|
]]> |
221 |
|
|
|
222 |
|
|
############################################################################# |
223 |
|
|
# types |
224 |
|
|
<xsl:apply-templates select="descendant::type"/> |
225 |
|
|
|
226 |
|
|
############################################################################# |
227 |
|
|
# structures |
228 |
|
|
<xsl:apply-templates select="descendant::struct"/> |
229 |
|
|
|
230 |
|
|
############################################################################# |
231 |
|
|
# "less" primitive types<![CDATA[ |
232 |
|
|
|
233 |
pcg |
1.6 |
dec_TREE |
234 |
|
|
enc_TREE |
235 |
pcg |
1.3 |
|
236 |
pcg |
1.1 |
]]> |
237 |
|
|
|
238 |
|
|
############################################################################# |
239 |
|
|
# messages |
240 |
pcg |
1.13 |
data KGS_server_msg = |
241 |
|
|
KGS_server_msg_null |
242 |
|
|
<xsl:for-each select="descendant::message[@src='server']"> |
243 |
|
|
| KGS_server_<xsl:value-of select="@name"/> { |
244 |
|
|
<xsl:apply-templates select="member" mode="decl"/> |
245 |
|
|
<xsl:text> }</xsl:text> |
246 |
|
|
</xsl:for-each> |
247 |
|
|
|
248 |
|
|
data KGS_client_msg = |
249 |
|
|
KGS_server_msg_null |
250 |
|
|
<xsl:for-each select="descendant::message[@src='client']"> |
251 |
|
|
| KGS_client_<xsl:value-of select="@name"/> { |
252 |
|
|
<xsl:apply-templates select="member" mode="decl"/> |
253 |
|
|
<xsl:text> }</xsl:text> |
254 |
|
|
</xsl:for-each> |
255 |
|
|
|
256 |
pcg |
1.1 |
<xsl:apply-templates select="descendant::message"/> |
257 |
|
|
} |
258 |
|
|
|
259 |
|
|
1; |
260 |
|
|
</xsl:template> |
261 |
|
|
|
262 |
|
|
<xsl:template match="type[@type = 'S']"> |
263 |
pcg |
1.13 |
type <xsl:value-of select="@name"/> = String |
264 |
|
|
|
265 |
elmex |
1.10 |
-- decode UCS-2 string of length <xsl:value-of select="@length"/> |
266 |
|
|
-- the first 0 terminates the string, but not the field |
267 |
|
|
dec_<xsl:value-of select="@name"/> :: DecS String |
268 |
|
|
dec_<xsl:value-of select="@name"/> = |
269 |
|
|
do getS <xsl:value-of select="@length"/> |
270 |
|
|
where |
271 |
|
|
-- getS ls 0 = reverse ls |
272 |
|
|
getS ls 0 = reverse (map (\c -> toEnum (fromIntegral c :: Int)) ls) |
273 |
pcg |
1.13 |
getS ls n = dec_U8 >>=\c getS (c:[]) (n-1) |
274 |
elmex |
1.10 |
|
275 |
|
|
-- likewise, encode as UCS-2, fill space with 0 |
276 |
|
|
enc_<xsl:value-of select="@name"/> :: String -> DecS () |
277 |
|
|
enc_<xsl:value-of select="@name"/> str = |
278 |
|
|
do let rlen = (length str) - <xsl:value-of select="@length"/> |
279 |
|
|
putS str |
280 |
|
|
putN rlen |
281 |
|
|
where |
282 |
|
|
putN 0 = return () |
283 |
pcg |
1.13 |
putN n = enc_U8 0 n-1 |
284 |
elmex |
1.10 |
putS [] = return () |
285 |
pcg |
1.13 |
putS (c:cs) = do enc_U8 c |
286 |
elmex |
1.10 |
putS cs |
287 |
pcg |
1.1 |
</xsl:template> |
288 |
|
|
|
289 |
|
|
<xsl:template match="type[@type = 'A']"> |
290 |
pcg |
1.13 |
type <xsl:value-of select="@name"/> = String |
291 |
|
|
|
292 |
elmex |
1.10 |
-- decode ASCII string of length <xsl:value-of select="@length"/> |
293 |
|
|
-- the first 0 terminates the string, but not the field |
294 |
|
|
dec_<xsl:value-of select="@name"/> :: DecS String |
295 |
|
|
dec_<xsl:value-of select="@name"/> = |
296 |
|
|
do getS <xsl:value-of select="@length"/> |
297 |
|
|
where |
298 |
|
|
getS ls 0 = reverse (map (\c -> toEnum (fromIntegral c :: Int)) ls) |
299 |
|
|
-- getS (0:ls) n = getS (0:ls) (n-1) |
300 |
pcg |
1.13 |
getS ls n = dec_U8 >>=\c getS (c:[]) (n-1) |
301 |
elmex |
1.10 |
|
302 |
|
|
-- likewise, encode as ASCII, fill space with 0 |
303 |
|
|
enc_<xsl:value-of select="@name"/> :: String -> DecS () |
304 |
|
|
enc_<xsl:value-of select="@name"/> str = |
305 |
|
|
do let rlen = (length str) - <xsl:value-of select="@length"/> |
306 |
|
|
putS str |
307 |
|
|
putN rlen |
308 |
|
|
where |
309 |
|
|
putN 0 = return () |
310 |
pcg |
1.13 |
putN n = enc_U8 0 n-1 |
311 |
elmex |
1.10 |
putS [] = return () |
312 |
pcg |
1.13 |
putS (c:cs) = do enc_U8 c |
313 |
elmex |
1.10 |
putS cs |
314 |
pcg |
1.1 |
</xsl:template> |
315 |
|
|
|
316 |
|
|
<xsl:template match="type[@multiplier]"> |
317 |
pcg |
1.13 |
type <xsl:value-of select="@name"/> = Float |
318 |
|
|
|
319 |
pcg |
1.6 |
dec_<xsl:value-of select="@name"/> = do |
320 |
pcg |
1.13 |
n <- dec_<xsl:value-of select="@type"/> |
321 |
elmex |
1.10 |
return $ n * (1 / <xsl:value-of select="@multiplier"/>) |
322 |
pcg |
1.1 |
|
323 |
pcg |
1.6 |
enc_<xsl:value-of select="@name"/> n = |
324 |
pcg |
1.13 |
enc_<xsl:value-of select="@type"/> $ n * <xsl:value-of select="@multiplier"/> |
325 |
|
|
|
326 |
|
|
<xsl:text> |
327 |
|
|
</xsl:text> |
328 |
pcg |
1.1 |
</xsl:template> |
329 |
|
|
|
330 |
|
|
<xsl:template match="member[@array = 'yes']" mode="dec"> |
331 |
|
|
$r->{<xsl:value-of select="@name"/>} = (my $array = []); |
332 |
|
|
while (length $data) { |
333 |
|
|
push @$array, dec_<xsl:value-of select="@type"/> |
334 |
|
|
<xsl:text> </xsl:text> |
335 |
|
|
<xsl:value-of select="@default"/>; |
336 |
|
|
} |
337 |
|
|
</xsl:template> |
338 |
|
|
|
339 |
|
|
<xsl:template match="member" mode="dec"> |
340 |
|
|
<xsl:if test="@guard-cond"> |
341 |
pcg |
1.13 |
<xsl:text> if </xsl:text><xsl:value-of select="@guard-member"/><xsl:text> </xsl:text> <xsl:value-of select="@guard-cond"/> then do |
342 |
|
|
</xsl:if> |
343 |
|
|
<xsl:text> </xsl:text><xsl:value-of select="@name"/> <- dec_<xsl:value-of select="@type"/> |
344 |
|
|
<xsl:text> |
345 |
|
|
</xsl:text> |
346 |
pcg |
1.1 |
</xsl:template> |
347 |
|
|
|
348 |
|
|
<xsl:template match="member" mode="enc"> |
349 |
pcg |
1.13 |
<xsl:text> enc_</xsl:text><xsl:value-of select="@type"/> $ <xsl:value-of select="@name"/> s |
350 |
|
|
</xsl:template> |
351 |
|
|
|
352 |
|
|
<xsl:template match="member" mode="decl"> |
353 |
pcg |
1.15 |
<xsl:text> !</xsl:text><xsl:value-of select="@name"/> :: <xsl:value-of select="@type"/> |
354 |
pcg |
1.13 |
<xsl:text> |
355 |
|
|
</xsl:text> |
356 |
pcg |
1.1 |
</xsl:template> |
357 |
|
|
|
358 |
|
|
<xsl:template match="struct"> |
359 |
pcg |
1.13 |
data KGS_<xsl:value-of select="@name"/> = KGS_<xsl:value-of select="@name"/> |
360 |
|
|
{ |
361 |
|
|
<xsl:apply-templates select="member" mode="decl"/> |
362 |
|
|
} |
363 |
|
|
|
364 |
pcg |
1.6 |
dec_<xsl:value-of select="@name"/> = do |
365 |
pcg |
1.13 |
<xsl:apply-templates select="member" mode="dec"/> |
366 |
pcg |
1.15 |
return $ KGS_<xsl:value-of select="@name"/><xsl:for-each select="member"><xsl:text> </xsl:text><xsl:value-of select="@name"/></xsl:for-each> |
367 |
pcg |
1.1 |
|
368 |
pcg |
1.6 |
enc_<xsl:value-of select="@name"/> s = |
369 |
pcg |
1.13 |
<xsl:apply-templates select="member" mode="enc"/> |
370 |
|
|
<xsl:text> |
371 |
|
|
</xsl:text> |
372 |
pcg |
1.1 |
</xsl:template> |
373 |
|
|
|
374 |
|
|
<xsl:template match="message"> |
375 |
pcg |
1.6 |
-- <xsl:value-of select="@name"/> |
376 |
|
|
dec_<xsl:value-of select="@src"/>_<xsl:value-of select="@type"/> = do |
377 |
pcg |
1.13 |
<xsl:apply-templates select="member" mode="dec"/> |
378 |
pcg |
1.15 |
return $ KGS_<xsl:value-of select="@name"/><xsl:for-each select="member"><xsl:text> </xsl:text><xsl:value-of select="@name"/></xsl:for-each> |
379 |
pcg |
1.5 |
|
380 |
pcg |
1.6 |
enc_<xsl:value-of select="@src"/>_<xsl:value-of select="@name"/> = |
381 |
pcg |
1.13 |
enc_U16 0x<xsl:value-of select="@type"/> |
382 |
|
|
<xsl:apply-templates select="member" mode="enc"/> |
383 |
pcg |
1.5 |
|
384 |
pcg |
1.1 |
</xsl:template> |
385 |
|
|
|
386 |
|
|
<xsl:template match="text()"> |
387 |
|
|
</xsl:template> |
388 |
|
|
|
389 |
|
|
</xsl:stylesheet> |
390 |
|
|
|