author  sheepluva 
Sat, 17 Sep 2011 11:39:42 +0200  
changeset 5948  e389a60ae8ab 
parent 5880  a6573cc5903e 
child 6068  e18713ecf1e0 
permissions  rwrr 
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.13dev
unc0rr
parents:
2747
diff
changeset

34 
where 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
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.13dev
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.13dev
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.13dev
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.13dev
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.13dev
unc0rr
parents:
2747
diff
changeset

50 
[(x, rest)]  all isSpace rest > Just x 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
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.13dev
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.13dev
unc0rr
parents:
2747
diff
changeset

69 
where 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
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.13dev
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.7dev") 
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.8dev") 
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.9dev") 
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.10dev") 
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.11dev") 
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.12dev") 
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.13dev") 
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.14dev") 
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.15dev") 
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.16dev") 
5880  106 
, (39, "0.9.16") 
107 
, (40, "0.9.17dev") 

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

108 
] 
1804  109 

4921  110 
askFromConsole :: B.ByteString > IO B.ByteString 
1964  111 
askFromConsole msg = do 
4921  112 
B.putStr msg 
2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

113 
hFlush stdout 
4921  114 
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

115 

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 

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 
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

118 
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

119 
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

120 
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

121 
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

122 

5030
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4975
diff
changeset

123 
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

124 
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

125 

42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4975
diff
changeset

126 
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

127 
readInt_ str = 
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4975
diff
changeset

128 
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

129 
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

130 
_ > 0 
5060
7d0f6e5b1c1c
Hide last two octets of IP address from usual users
unc0rr
parents:
5030
diff
changeset

131 

7d0f6e5b1c1c
Hide last two octets of IP address from usual users
unc0rr
parents:
5030
diff
changeset

132 
cutHost :: B.ByteString > B.ByteString 
7d0f6e5b1c1c
Hide last two octets of IP address from usual users
unc0rr
parents:
5030
diff
changeset

133 
cutHost = B.intercalate "." . flip (++) ["*","*"] . List.take 2 . B.split '.' 