gameServer/OfficialServer/checker.hs
author Vittorio Giovara <vittorio.giovara@gmail.com>
Fri, 17 Jan 2014 06:58:28 -0800
changeset 10002 29acde6f200c
parent 9866 62ffe234127d
child 10014 56d2f2d5aad8
permissions -rw-r--r--
Merge pull request #11 from LocutusOfBorg/fix-arm Added cast to qreal, avoiding ftbfs due to issue #758
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
9423
43798a77f1d1 Send less garbage to the server
unc0rr
parents: 9421
diff changeset
    27
readInt_ :: (Num a) => B.ByteString -> a
43798a77f1d1 Send less garbage to the server
unc0rr
parents: 9421
diff changeset
    28
readInt_ str =
43798a77f1d1 Send less garbage to the server
unc0rr
parents: 9421
diff changeset
    29
  case B.readInt str of
43798a77f1d1 Send less garbage to the server
unc0rr
parents: 9421
diff changeset
    30
       Just (i, t) | B.null t -> fromIntegral i
43798a77f1d1 Send less garbage to the server
unc0rr
parents: 9421
diff changeset
    31
       _                      -> 0 
43798a77f1d1 Send less garbage to the server
unc0rr
parents: 9421
diff changeset
    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
648bb1cb7ebc Some fixes
unc0rr
parents: 8515
diff changeset
    38
serverAddress = "netserver.hedgewars.org"
9866
62ffe234127d Heh, hardcoded paths :D
unc0rr
parents: 9581
diff changeset
    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
1767c92eff37 Pass achievements info to extdbinterface
unc0rr
parents: 9397
diff changeset
    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
1767c92eff37 Pass achievements info to extdbinterface
unc0rr
parents: 9397
diff changeset
    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
7b7ee65f82ad Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
    54
engineListener :: Chan Message -> Handle -> String -> IO ()
7b7ee65f82ad Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
    55
engineListener coreChan h fileName = do
9423
43798a77f1d1 Send less garbage to the server
unc0rr
parents: 9421
diff changeset
    56
    stats <- liftM (ps . L.dropWhile (not . start)) $ getLines h
9399
1767c92eff37 Pass achievements info to extdbinterface
unc0rr
parents: 9397
diff changeset
    57
    debugM "Engine" $ show stats
1767c92eff37 Pass achievements info to extdbinterface
unc0rr
parents: 9397
diff changeset
    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
1767c92eff37 Pass achievements info to extdbinterface
unc0rr
parents: 9397
diff changeset
    61
        writeChan coreChan $ CheckSuccess stats
9397
7b7ee65f82ad Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
    62
7b7ee65f82ad Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
    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
43798a77f1d1 Send less garbage to the server
unc0rr
parents: 9421
diff changeset
    66
        ps ("DRAW" : bs) = "DRAW" : ps bs
43798a77f1d1 Send less garbage to the server
unc0rr
parents: 9421
diff changeset
    67
        ps ("WINNERS" : n : bs) = let c = readInt_ n in "WINNERS" : n : take c bs ++ (ps $ drop c bs)
43798a77f1d1 Send less garbage to the server
unc0rr
parents: 9421
diff changeset
    68
        ps ("ACHIEVEMENT" : typ : teamname : location : value : bs) =
43798a77f1d1 Send less garbage to the server
unc0rr
parents: 9421
diff changeset
    69
            "ACHIEVEMENT" : typ : teamname : location : value : ps bs
43798a77f1d1 Send less garbage to the server
unc0rr
parents: 9421
diff changeset
    70
        ps _ = []
8517
648bb1cb7ebc Some fixes
unc0rr
parents: 8515
diff changeset
    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
9f6ca48d8e9c Fixes to checker
unc0rr
parents: 9399
diff changeset
    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
62ffe234127d Heh, hardcoded paths :D
unc0rr
parents: 9581
diff changeset
    80
    (_, _, Just hOut, _) <- createProcess (proc "/usr/home/unC0Rr/Sources/Hedgewars/Releases/0.9.20/bin/hwengine"
9397
7b7ee65f82ad Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
    81
                [fileName
7b7ee65f82ad Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
    82
                , "--user-prefix", "/usr/home/unC0Rr/.hedgewars"
9866
62ffe234127d Heh, hardcoded paths :D
unc0rr
parents: 9581
diff changeset
    83
                , "--prefix", "/usr/home/unC0Rr/Sources/Hedgewars/Releases/0.9.20/share/hedgewars/Data"
9397
7b7ee65f82ad Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
    84
                , "--nomusic"
7b7ee65f82ad Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
    85
                , "--nosound"
9421
90fe753b3654 Fix 'non-exhaustive pattern' crash
unc0rr
parents: 9403
diff changeset
    86
                , "--stats-only"
8506
3889dab021b8 - Fix check for void message
unc0rr
parents: 8497
diff changeset
    87
                ])
9403
9f6ca48d8e9c Fixes to checker
unc0rr
parents: 9399
diff changeset
    88
            {std_err = CreatePipe}
8517
648bb1cb7ebc Some fixes
unc0rr
parents: 8515
diff changeset
    89
    hSetBuffering hOut LineBuffering
9397
7b7ee65f82ad Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
    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]
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 8474
diff changeset
   151
        answer ["READY"]
8515
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
   152
    onPacket _ ["PING"] = answer ["PONG"]
8517
648bb1cb7ebc Some fixes
unc0rr
parents: 8515
diff changeset
   153
    onPacket chan ("REPLAY":msgs) = do
648bb1cb7ebc Some fixes
unc0rr
parents: 8515
diff changeset
   154
        checkReplay chan msgs
648bb1cb7ebc Some fixes
unc0rr
parents: 8515
diff changeset
   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
f4475782cf45 Some more work on checker
unc0rr
parents: 8506
diff changeset
   163
    installHandler sigPIPE Ignore Nothing
f4475782cf45 Some more work on checker
unc0rr
parents: 8506
diff changeset
   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
43798a77f1d1 Send less garbage to the server
unc0rr
parents: 9421
diff changeset
   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
eb35cc7ad9f0 Oops, looked in the deprecated file
unc0rr
parents: 9423
diff changeset
   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