author | sheepluva |
Thu, 12 Jun 2014 05:40:58 +0200 | |
changeset 10281 | dedc8f23e35e |
parent 10017 | de822cd3df3a |
child 10440 | b74a7bbe224e |
child 10460 | 8dcea9087d75 |
permissions | -rw-r--r-- |
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
1 |
{-# LANGUAGE CPP, ScopedTypeVariables, OverloadedStrings #-} |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
2 |
module Main where |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
3 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
4 |
import qualified Control.Exception as Exception |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
5 |
import System.IO |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
6 |
import System.Log.Logger |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
7 |
import qualified Data.ConfigFile as CF |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
8 |
import Control.Monad.Error |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
9 |
import System.Directory |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
10 |
import Control.Monad.State |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
11 |
import Control.Concurrent.Chan |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
12 |
import Control.Concurrent |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
13 |
import Network |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
14 |
import Network.BSD |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
15 |
import Network.Socket hiding (recv) |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
16 |
import Network.Socket.ByteString |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
17 |
import qualified Data.ByteString.Char8 as B |
8497
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
18 |
import qualified Data.ByteString as BW |
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
19 |
import qualified Codec.Binary.Base64 as Base64 |
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
20 |
import System.Process |
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
21 |
import Data.Maybe |
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
22 |
import qualified Data.List as L |
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
23 |
#if !defined(mingw32_HOST_OS) |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
24 |
import System.Posix |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
25 |
#endif |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
26 |
|
9423 | 27 |
readInt_ :: (Num a) => B.ByteString -> a |
28 |
readInt_ str = |
|
29 |
case B.readInt str of |
|
30 |
Just (i, t) | B.null t -> fromIntegral i |
|
10017 | 31 |
_ -> 0 |
9423 | 32 |
|
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
33 |
data Message = Packet [B.ByteString] |
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
34 |
| CheckFailed B.ByteString |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
35 |
| CheckSuccess [B.ByteString] |
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
36 |
deriving Show |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
37 |
|
8517 | 38 |
serverAddress = "netserver.hedgewars.org" |
9866 | 39 |
protocolNumber = "47" |
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
40 |
|
9399 | 41 |
getLines :: Handle -> IO [B.ByteString] |
8521
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
42 |
getLines h = g |
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
43 |
where |
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
44 |
g = do |
9399 | 45 |
l <- liftM Just (B.hGetLine h) `Exception.catch` (\(_ :: Exception.IOException) -> return Nothing) |
8521
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
46 |
if isNothing l then |
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
47 |
return [] |
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
48 |
else |
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
49 |
do |
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
50 |
lst <- g |
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
51 |
return $ fromJust l : lst |
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
52 |
|
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
53 |
|
9397 | 54 |
engineListener :: Chan Message -> Handle -> String -> IO () |
55 |
engineListener coreChan h fileName = do |
|
9423 | 56 |
stats <- liftM (ps . L.dropWhile (not . start)) $ getLines h |
9399 | 57 |
debugM "Engine" $ show stats |
58 |
if null stats then |
|
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
59 |
writeChan coreChan $ CheckFailed "No stats msg" |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
60 |
else |
9399 | 61 |
writeChan coreChan $ CheckSuccess stats |
9397 | 62 |
|
63 |
removeFile fileName |
|
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
64 |
where |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
65 |
start = flip L.elem ["WINNERS", "DRAW"] |
9423 | 66 |
ps ("DRAW" : bs) = "DRAW" : ps bs |
67 |
ps ("WINNERS" : n : bs) = let c = readInt_ n in "WINNERS" : n : take c bs ++ (ps $ drop c bs) |
|
68 |
ps ("ACHIEVEMENT" : typ : teamname : location : value : bs) = |
|
69 |
"ACHIEVEMENT" : typ : teamname : location : value : ps bs |
|
70 |
ps _ = [] |
|
8517 | 71 |
|
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
72 |
checkReplay :: Chan Message -> [B.ByteString] -> IO () |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
73 |
checkReplay coreChan msgs = do |
8497
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
74 |
tempDir <- getTemporaryDirectory |
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
75 |
(fileName, h) <- openBinaryTempFile tempDir "checker-demo" |
9403 | 76 |
B.hPut h . BW.pack . concat . map (fromMaybe [] . Base64.decode . B.unpack) $ msgs |
8497
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
77 |
hFlush h |
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
78 |
hClose h |
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
79 |
|
9866 | 80 |
(_, _, Just hOut, _) <- createProcess (proc "/usr/home/unC0Rr/Sources/Hedgewars/Releases/0.9.20/bin/hwengine" |
9397 | 81 |
[fileName |
82 |
, "--user-prefix", "/usr/home/unC0Rr/.hedgewars" |
|
9866 | 83 |
, "--prefix", "/usr/home/unC0Rr/Sources/Hedgewars/Releases/0.9.20/share/hedgewars/Data" |
9397 | 84 |
, "--nomusic" |
85 |
, "--nosound" |
|
9421 | 86 |
, "--stats-only" |
8506 | 87 |
]) |
9403 | 88 |
{std_err = CreatePipe} |
8517 | 89 |
hSetBuffering hOut LineBuffering |
9397 | 90 |
void $ forkIO $ engineListener coreChan hOut fileName |
8497
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
91 |
|
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
92 |
|
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
93 |
takePacks :: State B.ByteString [[B.ByteString]] |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
94 |
takePacks = do |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
95 |
modify (until (not . B.isPrefixOf pDelim) (B.drop 2)) |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
96 |
packet <- state $ B.breakSubstring pDelim |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
97 |
buf <- get |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
98 |
if B.null buf then put packet >> return [] else |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
99 |
if B.null packet then return [] else do |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
100 |
packets <- takePacks |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
101 |
return (B.splitWith (== '\n') packet : packets) |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
102 |
where |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
103 |
pDelim = "\n\n" |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
104 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
105 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
106 |
recvLoop :: Socket -> Chan Message -> IO () |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
107 |
recvLoop s chan = |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
108 |
((receiveWithBufferLoop B.empty >> return "Connection closed") |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
109 |
`Exception.catch` (\(e :: Exception.SomeException) -> return . B.pack . show $ e) |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
110 |
) |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
111 |
>>= disconnected |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
112 |
where |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
113 |
disconnected msg = writeChan chan $ Packet ["BYE", msg] |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
114 |
receiveWithBufferLoop recvBuf = do |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
115 |
recvBS <- recv s 4096 |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
116 |
unless (B.null recvBS) $ do |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
117 |
let (packets, newrecvBuf) = runState takePacks $ B.append recvBuf recvBS |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
118 |
forM_ packets sendPacket |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
119 |
receiveWithBufferLoop $ B.copy newrecvBuf |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
120 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
121 |
sendPacket packet = writeChan chan $ Packet packet |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
122 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
123 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
124 |
session :: B.ByteString -> B.ByteString -> Socket -> IO () |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
125 |
session l p s = do |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
126 |
noticeM "Core" "Connected" |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
127 |
coreChan <- newChan |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
128 |
forkIO $ recvLoop s coreChan |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
129 |
forever $ do |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
130 |
p <- readChan coreChan |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
131 |
case p of |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
132 |
Packet p -> do |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
133 |
debugM "Network" $ "Recv: " ++ show p |
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
134 |
onPacket coreChan p |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
135 |
CheckFailed msg -> do |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
136 |
warningM "Check" "Check failed" |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
137 |
answer ["CHECKED", "FAIL", msg] |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
138 |
answer ["READY"] |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
139 |
CheckSuccess msgs -> do |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
140 |
warningM "Check" "Check succeeded" |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
141 |
answer ("CHECKED" : "OK" : msgs) |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
142 |
answer ["READY"] |
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
143 |
where |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
144 |
answer :: [B.ByteString] -> IO () |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
145 |
answer p = do |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
146 |
debugM "Network" $ "Send: " ++ show p |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
147 |
sendAll s $ B.unlines p `B.snoc` '\n' |
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
148 |
onPacket :: Chan Message -> [B.ByteString] -> IO () |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
149 |
onPacket _ ("CONNECTED":_) = do |
8479
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
8474
diff
changeset
|
150 |
answer ["CHECKER", protocolNumber, l, p] |
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
151 |
onPacket _ ["PING"] = answer ["PONG"] |
10014 | 152 |
onPacket _ ["LOGONPASSED"] = answer ["READY"] |
8517 | 153 |
onPacket chan ("REPLAY":msgs) = do |
154 |
checkReplay chan msgs |
|
155 |
warningM "Check" "Started check" |
|
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
156 |
onPacket _ ("BYE" : xs) = error $ show xs |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
157 |
onPacket _ _ = return () |
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
158 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
159 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
160 |
main :: IO () |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
161 |
main = withSocketsDo $ do |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
162 |
#if !defined(mingw32_HOST_OS) |
8507 | 163 |
installHandler sigPIPE Ignore Nothing |
164 |
installHandler sigCHLD Ignore Nothing |
|
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
165 |
#endif |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
166 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
167 |
updateGlobalLogger "Core" (setLevel DEBUG) |
9423 | 168 |
updateGlobalLogger "Network" (setLevel WARNING) |
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
169 |
updateGlobalLogger "Check" (setLevel DEBUG) |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
170 |
updateGlobalLogger "Engine" (setLevel DEBUG) |
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
171 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
172 |
Right (login, password) <- runErrorT $ do |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
173 |
d <- liftIO $ getHomeDirectory |
9581 | 174 |
conf <- join . liftIO . CF.readfile CF.emptyCP $ d ++ "/.hedgewars/settings.ini" |
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
175 |
l <- CF.get conf "net" "nick" |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
176 |
p <- CF.get conf "net" "passwordhash" |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
177 |
return (B.pack l, B.pack p) |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
178 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
179 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
180 |
Exception.bracket |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
181 |
setupConnection |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
182 |
(\s -> noticeM "Core" "Shutting down" >> sClose s) |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
183 |
(session login password) |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
184 |
where |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
185 |
setupConnection = do |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
186 |
noticeM "Core" "Connecting to the server..." |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
187 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
188 |
proto <- getProtocolNumber "tcp" |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
189 |
let hints = defaultHints { addrFlags = [AI_ADDRCONFIG, AI_CANONNAME] } |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
190 |
(addr:_) <- getAddrInfo (Just hints) (Just serverAddress) Nothing |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
191 |
let (SockAddrInet _ host) = addrAddress addr |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
192 |
sock <- socket AF_INET Stream proto |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
193 |
connect sock (SockAddrInet 46631 host) |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
194 |
return sock |