1 |
<!DOCTYPE xsl:stylesheet> |
2 |
<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 |
module KGSProtocoll where |
18 |
import Numeric |
19 |
import Data.Word |
20 |
import Control.Monad.State |
21 |
|
22 |
data DecState = DecState { data :: [Word8] } |
23 |
|
24 |
-- type DecS a = State DecState a |
25 |
type DecS a = StateT DecState IO a -- for dec_HEX |
26 |
|
27 |
|
28 |
hasData :: DecS Bool |
29 |
hasData = do |
30 |
xs <- get |
31 |
return $ not $ null xs |
32 |
|
33 |
getU8 :: Word8 |
34 |
getU8 = |
35 |
do (x:xs) <- get |
36 |
put xs |
37 |
return x |
38 |
|
39 |
getU16 :: DecS Word16 |
40 |
getU16 = |
41 |
do a <- getU8 |
42 |
b <- getU8 |
43 |
return $ (fromIntegral a :: Word16) + (fromIntegral b :: Word16) * 256 |
44 |
|
45 |
|
46 |
dec_U8 :: DecS Word8 |
47 |
dec_U8 = getU8 |
48 |
|
49 |
dec_U16 :: DecS Word16 |
50 |
dec_U16 = getU16 |
51 |
|
52 |
dec_U64 :: DecS Word64 |
53 |
dec_U64 = |
54 |
do a1 <- getU16 |
55 |
a2 <- getU16 |
56 |
a3 <- getU16 |
57 |
a4 <- getU16 |
58 |
return $ (fI a1) `shiftL` 48 -- please check endians |
59 |
+ (fI a2) `shiftL` 32 |
60 |
+ (fI a3) `shiftL` 16 |
61 |
+ (fI a4) |
62 |
where fI a = fromIntegral a :: Word64 |
63 |
|
64 |
|
65 |
dec_I8 :: DecS Int8 |
66 |
dec_I8 = |
67 |
do w8 <- getU8 |
68 |
return $ fromIntegral w8 :: Int8 |
69 |
|
70 |
dec_I16 :: DecS Int16 |
71 |
dec_I16 = |
72 |
do w16 <- getU16 |
73 |
return $ fromIntegral w16 :: Int16 |
74 |
|
75 |
dec_I32 :: DecS Int32 |
76 |
dec_I32 = |
77 |
do w16_1 <- getU16 |
78 |
w16_2 <- getU16 |
79 |
return $ (fI w16_1) `shiftL` 16 -- please cgecj endians |
80 |
+ (fI w16_2) |
81 |
where fI a = fromIntegral a :: Int32 |
82 |
|
83 |
dec_DATA :: DecS [Word8] |
84 |
dec_DATA = |
85 |
do da <- get |
86 |
put [] |
87 |
return da |
88 |
|
89 |
dec_STRING :: DecS String |
90 |
dec_STRING = |
91 |
do da <- get |
92 |
let (str,rest) = mkstr da |
93 |
where |
94 |
mkstr str [] = |
95 |
(reverse str,[]) |
96 |
mkstr str (0:rest) = |
97 |
(reverse str, rest) |
98 |
mkstr str (c:rest) = |
99 |
mkstr ((toEnum (fromIntegra c :: Int)):str) rest |
100 |
|
101 |
{- |
102 |
sub dec_STRING { |
103 |
$data =~ s/^((?:..)*?)(?:\x00\x00|\Z)//s; |
104 |
# use Encode... |
105 |
join "", map chr, unpack "v*", $1; -- marc ??? |
106 |
} |
107 |
-} |
108 |
|
109 |
dec_CONSTANT :: DecS a |
110 |
dec_CONSTANT x = x |
111 |
|
112 |
type Password = Word64 |
113 |
|
114 |
dec_password :: DecS Password |
115 |
dec_password = dec_U64 |
116 |
|
117 |
dec_HEX :: DecS () |
118 |
dec_HEX = |
119 |
do da <- get |
120 |
putStr "HEX: " |
121 |
putStrLn $ (dec_data da) "" |
122 |
where dec_data (x:xs) = |
123 |
((drop 2) . showHex x . (':':)) . (dec_data xs) |
124 |
dec_data [] = (\_ -> "") |
125 |
|
126 |
############################################################################# |
127 |
|
128 |
putU8 :: Word8 -> DecS () |
129 |
putU8 a = |
130 |
do x <- get |
131 |
put (a:x) |
132 |
return () |
133 |
|
134 |
putU16 :: Word16 -> DecS () |
135 |
putU16 a = |
136 |
do x <- get |
137 |
let b1 = fromIntegral (a `shiftR` 8) :: Word8 |
138 |
b2 = fromIntegral a :: Word8 |
139 |
put (b2:b1:x) -- check endians |
140 |
|
141 |
enc_U8 :: Word8 -> DecS () |
142 |
enc_U8 = |
143 |
putU8 |
144 |
|
145 |
enc_U16 :: Word16 -> DecS () |
146 |
enc_U16 = |
147 |
putU16 |
148 |
|
149 |
enc_U32 :: Word32 -> DecS () |
150 |
enc_U32 a = |
151 |
let b1 = fromIntegral (a `shiftR` 16) :: Word16 |
152 |
b2 = fromIntegral a :: Word16 |
153 |
putU16 b1 -- check the goddamn endians marc :) |
154 |
putU16 b2 |
155 |
|
156 |
enc_U64 :: Word64 -> DecS () |
157 |
enc_U64 a = |
158 |
let b1 = fromIntegral (a `shiftR` 48) :: Word16 |
159 |
b2 = fromIntegral (a `shiftR` 32) :: Word16 |
160 |
b3 = fromIntegral (a `shiftR` 16) :: Word16 |
161 |
b4 = fromIntegral a :: Word16 |
162 |
putU16 b1 -- check the goddamn endians marc :) |
163 |
putU16 b2 |
164 |
putU16 b3 |
165 |
putU16 b4 |
166 |
|
167 |
enc_I8 :: Int8 -> DecS () |
168 |
enc_I8 a = |
169 |
putU8 (fromIntegral a :: Word8) |
170 |
|
171 |
enc_I16 :: Int16 -> DecS () |
172 |
enc_I16 a = |
173 |
let b1 = fromIntegral (a `shiftR` 8) :: Word8 |
174 |
b2 = fromIntegral a :: Word8 |
175 |
putU8 b1 |
176 |
putU8 b2 |
177 |
|
178 |
enc_I32 :: Int32 -> DecS () |
179 |
enc_I32 a = |
180 |
let |
181 |
b1 = fromIntegral (a `shiftR` 16) :: Word16 |
182 |
b2 = fromIntegral a :: Word16 |
183 |
putU16 b1 |
184 |
putU16 b2 |
185 |
|
186 |
enc_DATA :: [Word8] -> DecS () |
187 |
enc_DATA d = |
188 |
do x <- get |
189 |
put $ (reverse d) ++ x |
190 |
|
191 |
enc_STRING :: String -> DecS () |
192 |
enc_STRING s = |
193 |
do let mstr = reverse s |
194 |
putall (u:ls) = |
195 |
do putU8 u |
196 |
putall ls |
197 |
putall [] = return () |
198 |
putall mstr |
199 |
putU8 0 |
200 |
|
201 |
enc_CONSTANT :: a -> DecS () |
202 |
enc_CONSTANT _ = return () |
203 |
|
204 |
enc_password :: Password -> DecS () |
205 |
enc_password p = |
206 |
enc_U64 p |
207 |
|
208 |
{- marc??? |
209 |
sub enc_password { |
210 |
require Math::BigInt; # I insist on 32-bit-perl.. should use C |
211 |
# $hash must be 64 bit |
212 |
my $hash = new Math::BigInt; |
213 |
$hash = $hash * 1055 + ord for split //, $_[0]; |
214 |
enc_U64 $hash; |
215 |
} |
216 |
-} |
217 |
|
218 |
]]> |
219 |
|
220 |
############################################################################# |
221 |
# types |
222 |
<xsl:apply-templates select="descendant::type"/> |
223 |
|
224 |
############################################################################# |
225 |
# structures |
226 |
<xsl:apply-templates select="descendant::struct"/> |
227 |
|
228 |
############################################################################# |
229 |
# "less" primitive types<![CDATA[ |
230 |
|
231 |
dec_TREE |
232 |
enc_TREE |
233 |
|
234 |
]]> |
235 |
|
236 |
############################################################################# |
237 |
# messages |
238 |
<xsl:apply-templates select="descendant::message"/> |
239 |
} |
240 |
|
241 |
1; |
242 |
</xsl:template> |
243 |
|
244 |
<xsl:template match="type[@type = 'S']"> |
245 |
dec_<xsl:value-of select="@name"/> :: State [Word8] [Char] |
246 |
dec_<xsl:value-of select="@name"/> = do |
247 |
-- decode UCS-2 string of length <xsl:value-of select="@length"/> |
248 |
-- the first 0 terminates the string, but not the field |
249 |
|
250 |
enc_<xsl:value-of select="@name"/> = |
251 |
-- likewise, encode as UCS-2, fill space with 0 |
252 |
|
253 |
</xsl:template> |
254 |
|
255 |
<xsl:template match="type[@type = 'A']"> |
256 |
dec_<xsl:value-of select="@name"/> :: State [Word8] [Char] |
257 |
dec_<xsl:value-of select="@name"/> = do |
258 |
-- decode ASCII string of length <xsl:value-of select="@length"/> |
259 |
-- the first 0 terminates the string, but not the field |
260 |
|
261 |
enc_<xsl:value-of select="@name"/> = |
262 |
-- likewise, encode as ASCII, fill space with 0 |
263 |
|
264 |
</xsl:template> |
265 |
|
266 |
<xsl:template match="type[@multiplier]"> |
267 |
dec_<xsl:value-of select="@name"/> = do |
268 |
n <- dec<xsl:value-of select="@type"/> |
269 |
return n * (1 / <xsl:value-of select="@multiplier"/>) |
270 |
|
271 |
enc_<xsl:value-of select="@name"/> n = |
272 |
enc<xsl:value-of select="@type"/> $ n * <xsl:value-of select="@multiplier"/> |
273 |
-- |
274 |
|
275 |
</xsl:template> |
276 |
|
277 |
<xsl:template match="member[@array = 'yes']" mode="dec"> |
278 |
$r->{<xsl:value-of select="@name"/>} = (my $array = []); |
279 |
while (length $data) { |
280 |
push @$array, dec_<xsl:value-of select="@type"/> |
281 |
<xsl:text> </xsl:text> |
282 |
<xsl:value-of select="@default"/>; |
283 |
} |
284 |
|
285 |
</xsl:template> |
286 |
|
287 |
<xsl:template match="member" mode="dec"> |
288 |
<xsl:if test="@guard-cond"> |
289 |
-- decode next only when <xsl:value-of select="@guard-member"/> <xsl:value-of select="@guard-cond"/> -- |
290 |
</xsl:if> |
291 |
<xsl:text> </xsl:text><xsl:value-of select="@name"/> <- dec<xsl:value-of select="@type"/> -- default <xsl:value-of select="@default"/> -- |
292 |
</xsl:template> |
293 |
|
294 |
<xsl:template match="member" mode="enc"> |
295 |
enc<xsl:value-of select="@type"/> defined $_[0]{<xsl:value-of select="@name"/>} ? $_[0]{<xsl:value-of select="@name"/> s |
296 |
<xsl:text>} : (</xsl:text> |
297 |
<xsl:value-of select="@default"/> |
298 |
<xsl:text>);</xsl:text> |
299 |
</xsl:template> |
300 |
|
301 |
<xsl:template match="struct"> |
302 |
dec_<xsl:value-of select="@name"/> = do |
303 |
<xsl:apply-templates select="member" mode="dec"/> |
304 |
<xsl:if test="@class"> |
305 |
-- result has class <xsl:value-of select="@class"/> -- |
306 |
</xsl:if> |
307 |
|
308 |
enc_<xsl:value-of select="@name"/> s = |
309 |
<xsl:apply-templates select="member" mode="enc"/> |
310 |
|
311 |
</xsl:template> |
312 |
|
313 |
<xsl:template match="message"> |
314 |
-- <xsl:value-of select="@name"/> |
315 |
dec_<xsl:value-of select="@src"/>_<xsl:value-of select="@type"/> = do |
316 |
-- type "<xsl:value-of select="@name"/>" -- |
317 |
<xsl:apply-templates select="member" mode="dec"/> |
318 |
|
319 |
enc_<xsl:value-of select="@src"/>_<xsl:value-of select="@name"/> = |
320 |
encU16 0x<xsl:value-of select="@type"/> |
321 |
<xsl:apply-templates select="member" mode="enc"/> |
322 |
|
323 |
</xsl:template> |
324 |
|
325 |
<xsl:template match="text()"> |
326 |
</xsl:template> |
327 |
|
328 |
</xsl:stylesheet> |
329 |
|