21 |
21 |
22 |
22 |
23 sockAddr2String :: SockAddr -> IO String |
23 sockAddr2String :: SockAddr -> IO String |
24 sockAddr2String (SockAddrInet _ hostAddr) = inet_ntoa hostAddr |
24 sockAddr2String (SockAddrInet _ hostAddr) = inet_ntoa hostAddr |
25 sockAddr2String (SockAddrInet6 _ _ (a, b, c, d) _) = |
25 sockAddr2String (SockAddrInet6 _ _ (a, b, c, d) _) = |
26 return $ (foldr1 (.) |
26 return $ (foldr1 (.) |
27 $ List.intersperse (\a -> ':':a) |
27 $ List.intersperse (\a -> ':':a) |
28 $ concatMap (\n -> (\(a, b) -> [showHex a, showHex b]) $ divMod n 65536) [a, b, c, d]) [] |
28 $ concatMap (\n -> (\(a, b) -> [showHex a, showHex b]) $ divMod n 65536) [a, b, c, d]) [] |
29 |
29 |
30 toEngineMsg :: String -> String |
30 toEngineMsg :: String -> String |
31 toEngineMsg msg = Base64.encode (fromIntegral (length encodedMsg) : encodedMsg) |
31 toEngineMsg msg = Base64.encode (fromIntegral (length encodedMsg) : encodedMsg) |
32 where |
32 where |
33 encodedMsg = UTF8.encode msg |
33 encodedMsg = UTF8.encode msg |
34 |
34 |
35 fromEngineMsg :: String -> Maybe String |
35 fromEngineMsg :: String -> Maybe String |
36 fromEngineMsg msg = liftM (map w2c) (Base64.decode msg >>= removeLength) |
36 fromEngineMsg msg = liftM (map w2c) (Base64.decode msg >>= removeLength) |
37 where |
37 where |
38 removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing |
38 removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing |
39 removeLength _ = Nothing |
39 removeLength _ = Nothing |
40 |
40 |
41 checkNetCmd :: String -> (Bool, Bool) |
41 checkNetCmd :: String -> (Bool, Bool) |
42 checkNetCmd msg = check decoded |
42 checkNetCmd msg = check decoded |
43 where |
43 where |
44 decoded = fromEngineMsg msg |
44 decoded = fromEngineMsg msg |
45 check Nothing = (False, False) |
45 check Nothing = (False, False) |
46 check (Just (m:ms)) = (m `Set.member` legalMessages, m == '+') |
46 check (Just (m:ms)) = (m `Set.member` legalMessages, m == '+') |
47 check _ = (False, False) |
47 check _ = (False, False) |
48 legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sFNpPwtghb12345" ++ slotMessages |
48 legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sFNpPwtghb12345" ++ slotMessages |
49 slotMessages = "\128\129\130\131\132\133\134\135\136\137\138" |
49 slotMessages = "\128\129\130\131\132\133\134\135\136\137\138" |
50 |
50 |
51 maybeRead :: Read a => String -> Maybe a |
51 maybeRead :: Read a => String -> Maybe a |
52 maybeRead s = case reads s of |
52 maybeRead s = case reads s of |
53 [(x, rest)] | all isSpace rest -> Just x |
53 [(x, rest)] | all isSpace rest -> Just x |
54 _ -> Nothing |
54 _ -> Nothing |
55 |
55 |
56 teamToNet team = [ |
56 teamToNet :: Word16 -> TeamInfo -> [String] |
57 "ADD_TEAM", |
57 teamToNet protocol team |
58 teamname team, |
58 | protocol < 30 = [ |
59 teamgrave team, |
59 "ADD_TEAM", |
60 teamfort team, |
60 teamname team, |
61 teamvoicepack team, |
61 teamgrave team, |
62 teamflag team, |
62 teamfort team, |
63 teamowner team, |
63 teamvoicepack team, |
64 show $ difficulty team |
64 teamowner team, |
65 ] |
65 show $ difficulty team |
66 ++ hhsInfo |
66 ] |
67 where |
67 ++ hhsInfo |
68 hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team |
68 | otherwise = [ |
|
69 "ADD_TEAM", |
|
70 teamname team, |
|
71 teamgrave team, |
|
72 teamfort team, |
|
73 teamvoicepack team, |
|
74 teamflag team, |
|
75 teamowner team, |
|
76 show $ difficulty team |
|
77 ] |
|
78 ++ hhsInfo |
|
79 where |
|
80 hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team |
69 |
81 |
70 modifyTeam :: TeamInfo -> RoomInfo -> RoomInfo |
82 modifyTeam :: TeamInfo -> RoomInfo -> RoomInfo |
71 modifyTeam team room = room{teams = replaceTeam team $ teams room} |
83 modifyTeam team room = room{teams = replaceTeam team $ teams room} |
72 where |
84 where |
73 replaceTeam _ [] = error "modifyTeam: no such team" |
85 replaceTeam _ [] = error "modifyTeam: no such team" |
74 replaceTeam team (t:teams) = |
86 replaceTeam team (t:teams) = |
75 if teamname team == teamname t then |
87 if teamname team == teamname t then |
76 team : teams |
88 team : teams |
77 else |
89 else |
78 t : replaceTeam team teams |
90 t : replaceTeam team teams |
79 |
91 |
80 illegalName :: String -> Bool |
92 illegalName :: String -> Bool |
81 illegalName = all isSpace |
93 illegalName = all isSpace |
82 |
94 |
83 protoNumber2ver :: Word16 -> String |
95 protoNumber2ver :: Word16 -> String |