author | Xeli |
Thu, 04 Aug 2011 17:44:55 +0200 | |
branch | hedgeroid |
changeset 5495 | 272ed78e59a7 |
parent 5269 | e32fc0fcaad0 |
child 5880 | a6573cc5903e |
permissions | -rw-r--r-- |
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
1 |
{-# LANGUAGE OverloadedStrings #-} |
1804 | 2 |
module Utils where |
3 |
||
4 |
import Data.Char |
|
5 |
import Data.Word |
|
6 |
import qualified Data.Map as Map |
|
2304 | 7 |
import qualified Data.Set as Set |
1917 | 8 |
import Numeric |
9 |
import Network.Socket |
|
1964 | 10 |
import System.IO |
1917 | 11 |
import qualified Data.List as List |
2349 | 12 |
import Control.Monad |
1804 | 13 |
import qualified Codec.Binary.Base64 as Base64 |
5030
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4975
diff
changeset
|
14 |
import qualified Data.ByteString.Lazy as BL |
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4975
diff
changeset
|
15 |
import qualified Text.Show.ByteString as BS |
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
16 |
import qualified Data.ByteString.Char8 as B |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
17 |
import qualified Data.ByteString as BW |
4975
31da8979e5b1
Use Data.TConfig to read and store server config in hedgewars.ini (a little bit of hate to the author for not exporting Conf type)
unc0rr
parents:
4972
diff
changeset
|
18 |
------------------------------------------------- |
1804 | 19 |
import CoreTypes |
20 |
||
1917 | 21 |
|
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
22 |
sockAddr2String :: SockAddr -> IO B.ByteString |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
23 |
sockAddr2String (SockAddrInet _ hostAddr) = liftM B.pack $ inet_ntoa hostAddr |
1917 | 24 |
sockAddr2String (SockAddrInet6 _ _ (a, b, c, d) _) = |
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
25 |
return $ B.pack $ (foldr1 (.) |
4932 | 26 |
$ List.intersperse (':':) |
27 |
$ concatMap (\n -> (\(a0, a1) -> [showHex a0, showHex a1]) $ divMod n 65536) [a, b, c, d]) [] |
|
1917 | 28 |
|
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
29 |
toEngineMsg :: B.ByteString -> B.ByteString |
4932 | 30 |
toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : BW.unpack msg) |
1804 | 31 |
|
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
32 |
fromEngineMsg :: B.ByteString -> Maybe B.ByteString |
4932 | 33 |
fromEngineMsg msg = liftM BW.pack (Base64.decode (B.unpack msg) >>= removeLength) |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
34 |
where |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
35 |
removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
36 |
removeLength _ = Nothing |
2304 | 37 |
|
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
38 |
checkNetCmd :: B.ByteString -> (Bool, Bool) |
5030
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4975
diff
changeset
|
39 |
checkNetCmd msg = check decoded |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
40 |
where |
5030
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4975
diff
changeset
|
41 |
decoded = fromEngineMsg msg |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
42 |
check Nothing = (False, False) |
5030
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4975
diff
changeset
|
43 |
check (Just ms) | B.length ms > 0 = let m = B.head ms in (m `Set.member` legalMessages, m == '+') |
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4975
diff
changeset
|
44 |
| otherwise = (False, False) |
4972 | 45 |
legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sFNpPwtghbc12345" ++ slotMessages |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
46 |
slotMessages = "\128\129\130\131\132\133\134\135\136\137\138" |
1804 | 47 |
|
48 |
maybeRead :: Read a => String -> Maybe a |
|
49 |
maybeRead s = case reads s of |
|
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
50 |
[(x, rest)] | all isSpace rest -> Just x |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
51 |
_ -> Nothing |
1804 | 52 |
|
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
53 |
teamToNet :: TeamInfo -> [B.ByteString] |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
54 |
teamToNet team = |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
55 |
"ADD_TEAM" |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
56 |
: teamname team |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
57 |
: teamgrave team |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
58 |
: teamfort team |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
59 |
: teamvoicepack team |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
60 |
: teamflag team |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
61 |
: teamowner team |
5030
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4975
diff
changeset
|
62 |
: (showB . difficulty $ team) |
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
63 |
: hhsInfo |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
64 |
where |
4932 | 65 |
hhsInfo = concatMap (\(HedgehogInfo n hat) -> [n, hat]) $ hedgehogs team |
1804 | 66 |
|
67 |
modifyTeam :: TeamInfo -> RoomInfo -> RoomInfo |
|
68 |
modifyTeam team room = room{teams = replaceTeam team $ teams room} |
|
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
69 |
where |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
70 |
replaceTeam _ [] = error "modifyTeam: no such team" |
4932 | 71 |
replaceTeam tm (t:ts) = |
72 |
if teamname tm == teamname t then |
|
73 |
tm : ts |
|
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
74 |
else |
4932 | 75 |
t : replaceTeam tm ts |
1804 | 76 |
|
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
77 |
illegalName :: B.ByteString -> Bool |
5269 | 78 |
illegalName s = B.null s || B.all isSpace s || isSpace (B.head s) || isSpace (B.last s) || B.any isIllegalChar s |
79 |
where |
|
80 |
isIllegalChar c = c `List.elem` "$()*+?[]^{|}" |
|
2150
45b695f3a7b9
Forbid room names and nicknames consisting only of space characters
unc0rr
parents:
2113
diff
changeset
|
81 |
|
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
82 |
protoNumber2ver :: Word16 -> B.ByteString |
4569 | 83 |
protoNumber2ver v = Map.findWithDefault "Unknown" v vermap |
84 |
where |
|
85 |
vermap = Map.fromList [ |
|
4936
d65d438acd23
Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents:
4932
diff
changeset
|
86 |
(17, "0.9.7-dev") |
d65d438acd23
Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents:
4932
diff
changeset
|
87 |
, (19, "0.9.7") |
d65d438acd23
Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents:
4932
diff
changeset
|
88 |
, (20, "0.9.8-dev") |
d65d438acd23
Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents:
4932
diff
changeset
|
89 |
, (21, "0.9.8") |
d65d438acd23
Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents:
4932
diff
changeset
|
90 |
, (22, "0.9.9-dev") |
d65d438acd23
Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents:
4932
diff
changeset
|
91 |
, (23, "0.9.9") |
d65d438acd23
Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents:
4932
diff
changeset
|
92 |
, (24, "0.9.10-dev") |
d65d438acd23
Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents:
4932
diff
changeset
|
93 |
, (25, "0.9.10") |
d65d438acd23
Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents:
4932
diff
changeset
|
94 |
, (26, "0.9.11-dev") |
d65d438acd23
Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents:
4932
diff
changeset
|
95 |
, (27, "0.9.11") |
d65d438acd23
Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents:
4932
diff
changeset
|
96 |
, (28, "0.9.12-dev") |
d65d438acd23
Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents:
4932
diff
changeset
|
97 |
, (29, "0.9.12") |
d65d438acd23
Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents:
4932
diff
changeset
|
98 |
, (30, "0.9.13-dev") |
d65d438acd23
Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents:
4932
diff
changeset
|
99 |
, (31, "0.9.13") |
d65d438acd23
Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents:
4932
diff
changeset
|
100 |
, (32, "0.9.14-dev") |
d65d438acd23
Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents:
4932
diff
changeset
|
101 |
, (33, "0.9.14") |
d65d438acd23
Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents:
4932
diff
changeset
|
102 |
, (34, "0.9.15-dev") |
d65d438acd23
Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents:
4932
diff
changeset
|
103 |
, (35, "0.9.14.1") |
d65d438acd23
Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents:
4932
diff
changeset
|
104 |
, (37, "0.9.15") |
d65d438acd23
Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents:
4932
diff
changeset
|
105 |
, (38, "0.9.16-dev") |
d65d438acd23
Merge MAP, MAPGEN and SEED params into one on room join, so engine isn't spawned three times for a preview. Not tested as I'm unable to see my rooms (why?)
unc0rr
parents:
4932
diff
changeset
|
106 |
] |
1804 | 107 |
|
4921 | 108 |
askFromConsole :: B.ByteString -> IO B.ByteString |
1964 | 109 |
askFromConsole msg = do |
4921 | 110 |
B.putStr msg |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
111 |
hFlush stdout |
4921 | 112 |
B.getLine |
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
113 |
|
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
114 |
|
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
115 |
unfoldrE :: (b -> Either b (a, b)) -> b -> ([a], b) |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
116 |
unfoldrE f b = |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
117 |
case f b of |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
118 |
Right (a, new_b) -> let (a', b') = unfoldrE f new_b in (a : a', b') |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
119 |
Left new_b -> ([], new_b) |
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset
|
120 |
|
5030
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4975
diff
changeset
|
121 |
showB :: (BS.Show a) => a -> B.ByteString |
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4975
diff
changeset
|
122 |
showB = B.concat . BL.toChunks . BS.show |
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4975
diff
changeset
|
123 |
|
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4975
diff
changeset
|
124 |
readInt_ :: (Num a) => B.ByteString -> a |
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4975
diff
changeset
|
125 |
readInt_ str = |
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4975
diff
changeset
|
126 |
case B.readInt str of |
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4975
diff
changeset
|
127 |
Just (i, t) | B.null t -> fromIntegral i |
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4975
diff
changeset
|
128 |
_ -> 0 |
5060
7d0f6e5b1c1c
Hide last two octets of IP address from usual users
unc0rr
parents:
5030
diff
changeset
|
129 |
|
7d0f6e5b1c1c
Hide last two octets of IP address from usual users
unc0rr
parents:
5030
diff
changeset
|
130 |
cutHost :: B.ByteString -> B.ByteString |
7d0f6e5b1c1c
Hide last two octets of IP address from usual users
unc0rr
parents:
5030
diff
changeset
|
131 |
cutHost = B.intercalate "." . flip (++) ["*","*"] . List.take 2 . B.split '.' |