gameServer/OfficialServer/checker.hs
author unc0rr
Sat, 24 Aug 2013 00:13:15 +0400
branch0.9.19
changeset 9138 9e94a9bc8c7e
parent 9135 151c8e553de2
child 9399 1767c92eff37
permissions -rw-r--r--
Store TrophyRace records in database
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
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
648bb1cb7ebc Some fixes
unc0rr
parents: 8515
diff changeset
    32
serverAddress = "netserver.hedgewars.org"
9135
151c8e553de2 Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
    33
protocolNumber = "45"
8474
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
9135
151c8e553de2 Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
    48
engineListener :: Chan Message -> Handle -> String -> IO ()
151c8e553de2 Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
    49
engineListener coreChan h fileName = 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 []
9135
151c8e553de2 Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
    56
151c8e553de2 Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
    57
    removeFile fileName
8515
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
    58
    where
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
    59
        start = flip L.elem ["WINNERS", "DRAW"]
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
    60
8517
648bb1cb7ebc Some fixes
unc0rr
parents: 8515
diff changeset
    61
8515
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
    62
checkReplay :: Chan Message -> [B.ByteString] -> IO ()
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
    63
checkReplay coreChan msgs = do
8497
c5605c6f5bb3 Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents: 8479
diff changeset
    64
    tempDir <- getTemporaryDirectory
c5605c6f5bb3 Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents: 8479
diff changeset
    65
    (fileName, h) <- openBinaryTempFile tempDir "checker-demo"
c5605c6f5bb3 Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents: 8479
diff changeset
    66
    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
    67
    hFlush h
c5605c6f5bb3 Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents: 8479
diff changeset
    68
    hClose h
c5605c6f5bb3 Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents: 8479
diff changeset
    69
9135
151c8e553de2 Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
    70
    (_, Just hOut, _, _) <- createProcess (proc "/usr/home/unC0Rr/Sources/Hedgewars/Releases/0.9.19/bin/hwengine"
151c8e553de2 Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
    71
                [fileName
151c8e553de2 Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
    72
                , "--user-prefix", "/usr/home/unC0Rr/.hedgewars"
151c8e553de2 Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
    73
                , "--prefix", "/usr/home/unC0Rr/Sources/Hedgewars/Releases/0.9.19/share/hedgewars/Data"
151c8e553de2 Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
    74
                , "--nomusic"
151c8e553de2 Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
    75
                , "--nosound"
8506
3889dab021b8 - Fix check for void message
unc0rr
parents: 8497
diff changeset
    76
                ])
8515
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
    77
            {std_out = CreatePipe}
8517
648bb1cb7ebc Some fixes
unc0rr
parents: 8515
diff changeset
    78
    hSetBuffering hOut LineBuffering
9135
151c8e553de2 Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
    79
    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
    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
648bb1cb7ebc Some fixes
unc0rr
parents: 8515
diff changeset
   142
    onPacket chan ("REPLAY":msgs) = do
648bb1cb7ebc Some fixes
unc0rr
parents: 8515
diff changeset
   143
        checkReplay chan msgs
648bb1cb7ebc Some fixes
unc0rr
parents: 8515
diff changeset
   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
f4475782cf45 Some more work on checker
unc0rr
parents: 8506
diff changeset
   152
    installHandler sigPIPE Ignore Nothing
f4475782cf45 Some more work on checker
unc0rr
parents: 8506
diff changeset
   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