author | unc0rr |
Sat, 15 Jun 2013 23:44:37 +0400 | |
branch | webgl |
changeset 9164 | d923ba9d1145 |
parent 8521 | 80229928563f |
child 9135 | 151c8e553de2 |
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 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
27 |
data Message = Packet [B.ByteString] |
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
28 |
| CheckFailed B.ByteString |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
29 |
| CheckSuccess [B.ByteString] |
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
30 |
deriving Show |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
31 |
|
8517 | 32 |
serverAddress = "netserver.hedgewars.org" |
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
33 |
protocolNumber = "43" |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
34 |
|
8521
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
35 |
getLines :: Handle -> IO [String] |
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
36 |
getLines h = g |
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
37 |
where |
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
38 |
g = do |
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
39 |
l <- liftM Just (hGetLine h) `Exception.catch` (\(_ :: Exception.IOException) -> return Nothing) |
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
40 |
if isNothing l then |
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
41 |
return [] |
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
42 |
else |
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
43 |
do |
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
44 |
lst <- g |
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
45 |
return $ fromJust l : lst |
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
46 |
|
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
47 |
|
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
48 |
engineListener :: Chan Message -> Handle -> IO () |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
49 |
engineListener coreChan h = do |
8521
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
50 |
output <- getLines h |
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
51 |
debugM "Engine" $ show output |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
52 |
if isNothing $ L.find start output then |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
53 |
writeChan coreChan $ CheckFailed "No stats msg" |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
54 |
else |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
55 |
writeChan coreChan $ CheckSuccess [] |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
56 |
where |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
57 |
start = flip L.elem ["WINNERS", "DRAW"] |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
58 |
|
8517 | 59 |
|
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
60 |
checkReplay :: Chan Message -> [B.ByteString] -> IO () |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
61 |
checkReplay coreChan msgs = do |
8497
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
62 |
tempDir <- getTemporaryDirectory |
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
63 |
(fileName, h) <- openBinaryTempFile tempDir "checker-demo" |
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
64 |
B.hPut h . BW.pack . concat . map (fromJust . Base64.decode . B.unpack) $ msgs |
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
65 |
hFlush h |
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
66 |
hClose h |
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
67 |
|
8517 | 68 |
(_, Just hOut, _, _) <- createProcess (proc "/usr/home/unC0Rr/Sources/Hedgewars/Releases/0.9.18/bin/hwengine" |
8497
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
69 |
["/usr/home/unC0Rr/.hedgewars" |
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
70 |
, "/usr/home/unC0Rr/Sources/Hedgewars/Releases/0.9.18/share/hedgewars/Data" |
8506 | 71 |
, fileName |
72 |
, "--set-audio" |
|
73 |
, "0" |
|
74 |
, "0" |
|
75 |
, "0" |
|
76 |
]) |
|
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
77 |
{std_out = CreatePipe} |
8517 | 78 |
hSetBuffering hOut LineBuffering |
79 |
void $ forkIO $ engineListener coreChan hOut |
|
8497
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
80 |
|
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
81 |
|
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
82 |
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
|
83 |
takePacks = do |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
84 |
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
|
85 |
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
|
86 |
buf <- get |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
87 |
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
|
88 |
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
|
89 |
packets <- takePacks |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
90 |
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
|
91 |
where |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
92 |
pDelim = "\n\n" |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
93 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
94 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
95 |
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
|
96 |
recvLoop s chan = |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
97 |
((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
|
98 |
`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
|
99 |
) |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
100 |
>>= disconnected |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
101 |
where |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
102 |
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
|
103 |
receiveWithBufferLoop recvBuf = do |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
104 |
recvBS <- recv s 4096 |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
105 |
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
|
106 |
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
|
107 |
forM_ packets sendPacket |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
108 |
receiveWithBufferLoop $ B.copy newrecvBuf |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
109 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
110 |
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
|
111 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
112 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
113 |
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
|
114 |
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
|
115 |
noticeM "Core" "Connected" |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
116 |
coreChan <- newChan |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
117 |
forkIO $ recvLoop s coreChan |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
118 |
forever $ do |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
119 |
p <- readChan coreChan |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
120 |
case p of |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
121 |
Packet p -> do |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
122 |
debugM "Network" $ "Recv: " ++ show p |
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
123 |
onPacket coreChan p |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
124 |
CheckFailed msg -> do |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
125 |
warningM "Check" "Check failed" |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
126 |
answer ["CHECKED", "FAIL", msg] |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
127 |
answer ["READY"] |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
128 |
CheckSuccess msgs -> do |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
129 |
warningM "Check" "Check succeeded" |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
130 |
answer ("CHECKED" : "OK" : msgs) |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
131 |
answer ["READY"] |
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
132 |
where |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
133 |
answer :: [B.ByteString] -> IO () |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
134 |
answer p = do |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
135 |
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
|
136 |
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
|
137 |
onPacket :: Chan Message -> [B.ByteString] -> IO () |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
138 |
onPacket _ ("CONNECTED":_) = do |
8479
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
8474
diff
changeset
|
139 |
answer ["CHECKER", protocolNumber, l, p] |
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
8474
diff
changeset
|
140 |
answer ["READY"] |
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
141 |
onPacket _ ["PING"] = answer ["PONG"] |
8517 | 142 |
onPacket chan ("REPLAY":msgs) = do |
143 |
checkReplay chan msgs |
|
144 |
warningM "Check" "Started check" |
|
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
145 |
onPacket _ ("BYE" : xs) = error $ show xs |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
146 |
onPacket _ _ = return () |
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
147 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
148 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
149 |
main :: IO () |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
150 |
main = withSocketsDo $ do |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
151 |
#if !defined(mingw32_HOST_OS) |
8507 | 152 |
installHandler sigPIPE Ignore Nothing |
153 |
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
|
154 |
#endif |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
155 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
156 |
updateGlobalLogger "Core" (setLevel DEBUG) |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
157 |
updateGlobalLogger "Network" (setLevel DEBUG) |
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
158 |
updateGlobalLogger "Check" (setLevel DEBUG) |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
159 |
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
|
160 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
161 |
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
|
162 |
d <- liftIO $ getHomeDirectory |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
163 |
conf <- join . liftIO . CF.readfile CF.emptyCP $ d ++ "/.hedgewars/hedgewars.ini" |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
164 |
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
|
165 |
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
|
166 |
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
|
167 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
168 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
169 |
Exception.bracket |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
170 |
setupConnection |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
171 |
(\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
|
172 |
(session login password) |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
173 |
where |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
174 |
setupConnection = do |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
175 |
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
|
176 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
177 |
proto <- getProtocolNumber "tcp" |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
178 |
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
|
179 |
(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
|
180 |
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
|
181 |
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
|
182 |
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
|
183 |
return sock |