author | unc0rr |
Wed, 24 Oct 2018 00:08:23 +0200 | |
changeset 13958 | e98e2fc556a7 |
parent 13677 | 8bd973ab9c9c |
permissions | -rw-r--r-- |
10460
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10017
diff
changeset
|
1 |
{- |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10017
diff
changeset
|
2 |
* Hedgewars, a free turn based strategy game |
11046 | 3 |
* Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com> |
10460
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10017
diff
changeset
|
4 |
* |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10017
diff
changeset
|
5 |
* This program is free software; you can redistribute it and/or modify |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10017
diff
changeset
|
6 |
* it under the terms of the GNU General Public License as published by |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10017
diff
changeset
|
7 |
* the Free Software Foundation; version 2 of the License |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10017
diff
changeset
|
8 |
* |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10017
diff
changeset
|
9 |
* This program is distributed in the hope that it will be useful, |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10017
diff
changeset
|
10 |
* but WITHOUT ANY WARRANTY; without even the implied warranty of |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10017
diff
changeset
|
11 |
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10017
diff
changeset
|
12 |
* GNU General Public License for more details. |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10017
diff
changeset
|
13 |
* |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10017
diff
changeset
|
14 |
* You should have received a copy of the GNU General Public License |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10017
diff
changeset
|
15 |
* along with this program; if not, write to the Free Software |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10017
diff
changeset
|
16 |
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10017
diff
changeset
|
17 |
\-} |
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10017
diff
changeset
|
18 |
|
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
19 |
{-# LANGUAGE CPP, ScopedTypeVariables, OverloadedStrings #-} |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
20 |
module Main where |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
21 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
22 |
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
|
23 |
import System.IO |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
24 |
import System.Log.Logger |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
25 |
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
|
26 |
import Control.Monad.Error |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
27 |
import System.Directory |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
28 |
import Control.Monad.State |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
29 |
import Control.Concurrent.Chan |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
30 |
import Control.Concurrent |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
31 |
import Network |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
32 |
import Network.BSD |
10478
12662c21e0e9
Fix use of uninitialized variables (fixes straight lines in maze gen aswell)
unc0rr
parents:
10460
diff
changeset
|
33 |
import Network.Socket hiding (recv, sClose) |
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
34 |
import Network.Socket.ByteString |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
35 |
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
|
36 |
import qualified Data.ByteString as BW |
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
37 |
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
|
38 |
import System.Process |
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
39 |
import Data.Maybe |
12845 | 40 |
import Data.Either |
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
41 |
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
|
42 |
#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
|
43 |
import System.Posix |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
44 |
#endif |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
45 |
|
9423 | 46 |
readInt_ :: (Num a) => B.ByteString -> a |
47 |
readInt_ str = |
|
48 |
case B.readInt str of |
|
49 |
Just (i, t) | B.null t -> fromIntegral i |
|
10017 | 50 |
_ -> 0 |
9423 | 51 |
|
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
52 |
data Message = Packet [B.ByteString] |
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
53 |
| CheckFailed B.ByteString |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
54 |
| CheckSuccess [B.ByteString] |
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
55 |
deriving Show |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
56 |
|
8517 | 57 |
serverAddress = "netserver.hedgewars.org" |
13677
8bd973ab9c9c
- Add checker dependencies to hedgewars-server.cabal
unc0rr
parents:
12845
diff
changeset
|
58 |
protocolNumber = "55" |
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
59 |
|
9399 | 60 |
getLines :: Handle -> IO [B.ByteString] |
8521
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
61 |
getLines h = g |
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
62 |
where |
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
63 |
g = do |
9399 | 64 |
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
|
65 |
if isNothing l then |
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
66 |
return [] |
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
67 |
else |
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
68 |
do |
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
69 |
lst <- g |
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
70 |
return $ fromJust l : lst |
80229928563f
Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents:
8517
diff
changeset
|
71 |
|
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
72 |
|
9397 | 73 |
engineListener :: Chan Message -> Handle -> String -> IO () |
74 |
engineListener coreChan h fileName = do |
|
9423 | 75 |
stats <- liftM (ps . L.dropWhile (not . start)) $ getLines h |
9399 | 76 |
debugM "Engine" $ show stats |
77 |
if null stats then |
|
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
78 |
writeChan coreChan $ CheckFailed "No stats msg" |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
79 |
else |
9399 | 80 |
writeChan coreChan $ CheckSuccess stats |
9397 | 81 |
|
82 |
removeFile fileName |
|
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
83 |
where |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
84 |
start = flip L.elem ["WINNERS", "DRAW"] |
9423 | 85 |
ps ("DRAW" : bs) = "DRAW" : ps bs |
86 |
ps ("WINNERS" : n : bs) = let c = readInt_ n in "WINNERS" : n : take c bs ++ (ps $ drop c bs) |
|
11583 | 87 |
ps ("GHOST_POINTS" : n : bs) = let c = 2 * (readInt_ n) in "GHOST_POINTS" : n : take c bs ++ (ps $ drop c bs) |
9423 | 88 |
ps ("ACHIEVEMENT" : typ : teamname : location : value : bs) = |
89 |
"ACHIEVEMENT" : typ : teamname : location : value : ps bs |
|
90 |
ps _ = [] |
|
8517 | 91 |
|
10742 | 92 |
checkReplay :: String -> String -> String -> Chan Message -> [B.ByteString] -> IO () |
93 |
checkReplay home exe prefix coreChan msgs = do |
|
8497
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
94 |
tempDir <- getTemporaryDirectory |
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
95 |
(fileName, h) <- openBinaryTempFile tempDir "checker-demo" |
12845 | 96 |
B.hPut h . B.concat . map (either (const B.empty) id . Base64.decode) $ msgs |
8497
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
97 |
hFlush h |
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
98 |
hClose h |
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
99 |
|
10742 | 100 |
(_, _, Just hOut, _) <- createProcess (proc exe |
9397 | 101 |
[fileName |
10742 | 102 |
, "--user-prefix", home |
103 |
, "--prefix", prefix |
|
9397 | 104 |
, "--nomusic" |
105 |
, "--nosound" |
|
9421 | 106 |
, "--stats-only" |
8506 | 107 |
]) |
9403 | 108 |
{std_err = CreatePipe} |
8517 | 109 |
hSetBuffering hOut LineBuffering |
9397 | 110 |
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
|
111 |
|
c5605c6f5bb3
Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents:
8479
diff
changeset
|
112 |
|
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
113 |
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
|
114 |
takePacks = do |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
115 |
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
|
116 |
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
|
117 |
buf <- get |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
118 |
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
|
119 |
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
|
120 |
packets <- takePacks |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
121 |
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
|
122 |
where |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
123 |
pDelim = "\n\n" |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
124 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
125 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
126 |
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
|
127 |
recvLoop s chan = |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
128 |
((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
|
129 |
`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
|
130 |
) |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
131 |
>>= disconnected |
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 |
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
|
134 |
receiveWithBufferLoop recvBuf = do |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
135 |
recvBS <- recv s 4096 |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
136 |
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
|
137 |
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
|
138 |
forM_ packets sendPacket |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
139 |
receiveWithBufferLoop $ B.copy newrecvBuf |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
140 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
141 |
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
|
142 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
143 |
|
10742 | 144 |
session :: B.ByteString -> B.ByteString -> String -> String -> String -> Socket -> IO () |
145 |
session l p home exe prefix s = do |
|
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
146 |
noticeM "Core" "Connected" |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
147 |
coreChan <- newChan |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
148 |
forkIO $ recvLoop s coreChan |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
149 |
forever $ do |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
150 |
p <- readChan coreChan |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
151 |
case p of |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
152 |
Packet p -> do |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
153 |
debugM "Network" $ "Recv: " ++ show p |
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
154 |
onPacket coreChan p |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
155 |
CheckFailed msg -> do |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
156 |
warningM "Check" "Check failed" |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
157 |
answer ["CHECKED", "FAIL", msg] |
11514 | 158 |
threadDelay 1500000 |
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
159 |
answer ["READY"] |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
160 |
CheckSuccess msgs -> do |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
161 |
warningM "Check" "Check succeeded" |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
162 |
answer ("CHECKED" : "OK" : msgs) |
11514 | 163 |
threadDelay 1500000 |
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
164 |
answer ["READY"] |
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
165 |
where |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
166 |
answer :: [B.ByteString] -> IO () |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
167 |
answer p = do |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
168 |
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
|
169 |
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
|
170 |
onPacket :: Chan Message -> [B.ByteString] -> IO () |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
171 |
onPacket _ ("CONNECTED":_) = do |
8479
8d71109b04d2
Some work on loading replay and interaction with checker
unc0rr
parents:
8474
diff
changeset
|
172 |
answer ["CHECKER", protocolNumber, l, p] |
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
173 |
onPacket _ ["PING"] = answer ["PONG"] |
10014 | 174 |
onPacket _ ["LOGONPASSED"] = answer ["READY"] |
8517 | 175 |
onPacket chan ("REPLAY":msgs) = do |
10742 | 176 |
checkReplay home exe prefix chan msgs |
8517 | 177 |
warningM "Check" "Started check" |
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
178 |
onPacket _ ("BYE" : xs) = error $ show xs |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
179 |
onPacket _ _ = return () |
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
180 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
181 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
182 |
main :: IO () |
11514 | 183 |
main = withSocketsDo . forever $ do |
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
184 |
#if !defined(mingw32_HOST_OS) |
8507 | 185 |
installHandler sigPIPE Ignore Nothing |
186 |
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
|
187 |
#endif |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
188 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
189 |
updateGlobalLogger "Core" (setLevel DEBUG) |
9423 | 190 |
updateGlobalLogger "Network" (setLevel WARNING) |
8515
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
191 |
updateGlobalLogger "Check" (setLevel DEBUG) |
222f43420615
Parse engine output to deside whether simulation ran to the end
unc0rr
parents:
8507
diff
changeset
|
192 |
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
|
193 |
|
10742 | 194 |
d <- getHomeDirectory |
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
195 |
Right (login, password) <- runErrorT $ do |
9581 | 196 |
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
|
197 |
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
|
198 |
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
|
199 |
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
|
200 |
|
10742 | 201 |
Right (exeFullname, dataPrefix) <- runErrorT $ do |
202 |
conf <- join . liftIO . CF.readfile CF.emptyCP $ d ++ "/.hedgewars/checker.ini" |
|
203 |
l <- CF.get conf "engine" "exe" |
|
204 |
p <- CF.get conf "engine" "prefix" |
|
205 |
return (l, p) |
|
206 |
||
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
207 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
208 |
Exception.bracket |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
209 |
setupConnection |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
210 |
(\s -> noticeM "Core" "Shutting down" >> sClose s) |
10746 | 211 |
(session login password (d ++ "/.hedgewars") exeFullname dataPrefix) |
8474
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
212 |
where |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
213 |
setupConnection = do |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
214 |
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
|
215 |
|
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
216 |
proto <- getProtocolNumber "tcp" |
f6abe50095d2
Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff
changeset
|
217 |
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
|
218 |
(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
|
219 |
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
|
220 |
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
|
221 |
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
|
222 |
return sock |