gameServer/OfficialServer/checker.hs
author unc0rr
Sat, 27 Feb 2016 18:02:24 +0300
changeset 11578 013264e25d71
parent 11509 6a5bdf930edf
child 11606 99966b4a6e1e
child 12840 ad2d448bbcab
permissions -rw-r--r--
Recognize ghost points in checker
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
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
47a8c19ecb60 more copyright fixes
sheepluva
parents: 10746
diff changeset
     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
8515
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
    40
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
    41
#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
    42
import System.Posix
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
    43
#endif
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
    44
9423
43798a77f1d1 Send less garbage to the server
unc0rr
parents: 9421
diff changeset
    45
readInt_ :: (Num a) => B.ByteString -> a
43798a77f1d1 Send less garbage to the server
unc0rr
parents: 9421
diff changeset
    46
readInt_ str =
43798a77f1d1 Send less garbage to the server
unc0rr
parents: 9421
diff changeset
    47
  case B.readInt str of
43798a77f1d1 Send less garbage to the server
unc0rr
parents: 9421
diff changeset
    48
       Just (i, t) | B.null t -> fromIntegral i
10017
de822cd3df3a fixwhitespace and dos2unix
koda
parents: 10014
diff changeset
    49
       _                      -> 0
9423
43798a77f1d1 Send less garbage to the server
unc0rr
parents: 9421
diff changeset
    50
8474
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
    51
data Message = Packet [B.ByteString]
8515
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
    52
             | CheckFailed B.ByteString
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
    53
             | CheckSuccess [B.ByteString]
8474
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
    54
    deriving Show
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
    55
8517
648bb1cb7ebc Some fixes
unc0rr
parents: 8515
diff changeset
    56
serverAddress = "netserver.hedgewars.org"
11345
d3317d6162fe Airmines were added
unc0rr
parents: 11046
diff changeset
    57
protocolNumber = "51"
8474
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
    58
9399
1767c92eff37 Pass achievements info to extdbinterface
unc0rr
parents: 9397
diff changeset
    59
getLines :: Handle -> IO [B.ByteString]
8521
80229928563f Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents: 8517
diff changeset
    60
getLines h = g
80229928563f Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents: 8517
diff changeset
    61
    where
80229928563f Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents: 8517
diff changeset
    62
        g = do
9399
1767c92eff37 Pass achievements info to extdbinterface
unc0rr
parents: 9397
diff changeset
    63
            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
    64
            if isNothing l then
80229928563f Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents: 8517
diff changeset
    65
                return []
80229928563f Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents: 8517
diff changeset
    66
                else
80229928563f Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents: 8517
diff changeset
    67
                do
80229928563f Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents: 8517
diff changeset
    68
                lst <- g
80229928563f Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents: 8517
diff changeset
    69
                return $ fromJust l : lst
80229928563f Workaround hGetContents blocking all threads with my own version of the function
unc0rr
parents: 8517
diff changeset
    70
8515
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
    71
9397
7b7ee65f82ad Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
    72
engineListener :: Chan Message -> Handle -> String -> IO ()
7b7ee65f82ad Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
    73
engineListener coreChan h fileName = do
9423
43798a77f1d1 Send less garbage to the server
unc0rr
parents: 9421
diff changeset
    74
    stats <- liftM (ps . L.dropWhile (not . start)) $ getLines h
9399
1767c92eff37 Pass achievements info to extdbinterface
unc0rr
parents: 9397
diff changeset
    75
    debugM "Engine" $ show stats
1767c92eff37 Pass achievements info to extdbinterface
unc0rr
parents: 9397
diff changeset
    76
    if null stats then
8515
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
    77
        writeChan coreChan $ CheckFailed "No stats msg"
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
    78
        else
9399
1767c92eff37 Pass achievements info to extdbinterface
unc0rr
parents: 9397
diff changeset
    79
        writeChan coreChan $ CheckSuccess stats
9397
7b7ee65f82ad Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
    80
7b7ee65f82ad Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
    81
    removeFile fileName
8515
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
    82
    where
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
    83
        start = flip L.elem ["WINNERS", "DRAW"]
9423
43798a77f1d1 Send less garbage to the server
unc0rr
parents: 9421
diff changeset
    84
        ps ("DRAW" : bs) = "DRAW" : ps bs
43798a77f1d1 Send less garbage to the server
unc0rr
parents: 9421
diff changeset
    85
        ps ("WINNERS" : n : bs) = let c = readInt_ n in "WINNERS" : n : take c bs ++ (ps $ drop c bs)
11578
013264e25d71 Recognize ghost points in checker
unc0rr
parents: 11509
diff changeset
    86
        ps ("GHOST_POINTS" : n : bs) = let c = 2 * (readInt_ n) in "GHOST_POINTS" : n : take c bs ++ (ps $ drop c bs)
9423
43798a77f1d1 Send less garbage to the server
unc0rr
parents: 9421
diff changeset
    87
        ps ("ACHIEVEMENT" : typ : teamname : location : value : bs) =
43798a77f1d1 Send less garbage to the server
unc0rr
parents: 9421
diff changeset
    88
            "ACHIEVEMENT" : typ : teamname : location : value : ps bs
43798a77f1d1 Send less garbage to the server
unc0rr
parents: 9421
diff changeset
    89
        ps _ = []
8517
648bb1cb7ebc Some fixes
unc0rr
parents: 8515
diff changeset
    90
10742
34c1afbda24a checker.ini to avoid hardcoded paths
unc0rr
parents: 10478
diff changeset
    91
checkReplay :: String -> String -> String -> Chan Message -> [B.ByteString] -> IO ()
34c1afbda24a checker.ini to avoid hardcoded paths
unc0rr
parents: 10478
diff changeset
    92
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
    93
    tempDir <- getTemporaryDirectory
c5605c6f5bb3 Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents: 8479
diff changeset
    94
    (fileName, h) <- openBinaryTempFile tempDir "checker-demo"
9403
9f6ca48d8e9c Fixes to checker
unc0rr
parents: 9399
diff changeset
    95
    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
    96
    hFlush h
c5605c6f5bb3 Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents: 8479
diff changeset
    97
    hClose h
c5605c6f5bb3 Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents: 8479
diff changeset
    98
10742
34c1afbda24a checker.ini to avoid hardcoded paths
unc0rr
parents: 10478
diff changeset
    99
    (_, _, Just hOut, _) <- createProcess (proc exe
9397
7b7ee65f82ad Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
   100
                [fileName
10742
34c1afbda24a checker.ini to avoid hardcoded paths
unc0rr
parents: 10478
diff changeset
   101
                , "--user-prefix", home
34c1afbda24a checker.ini to avoid hardcoded paths
unc0rr
parents: 10478
diff changeset
   102
                , "--prefix", prefix
9397
7b7ee65f82ad Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
   103
                , "--nomusic"
7b7ee65f82ad Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
   104
                , "--nosound"
9421
90fe753b3654 Fix 'non-exhaustive pattern' crash
unc0rr
parents: 9403
diff changeset
   105
                , "--stats-only"
8506
3889dab021b8 - Fix check for void message
unc0rr
parents: 8497
diff changeset
   106
                ])
9403
9f6ca48d8e9c Fixes to checker
unc0rr
parents: 9399
diff changeset
   107
            {std_err = CreatePipe}
8517
648bb1cb7ebc Some fixes
unc0rr
parents: 8515
diff changeset
   108
    hSetBuffering hOut LineBuffering
9397
7b7ee65f82ad Declare achievements in console statistics output
unc0rr
parents: 8521
diff changeset
   109
    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
   110
c5605c6f5bb3 Hack checker to run engine with record file received (uses hardcoded paths)
unc0rr
parents: 8479
diff changeset
   111
8474
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   112
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
   113
takePacks = do
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   114
    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
   115
    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
   116
    buf <- get
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   117
    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
   118
        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
   119
            packets <- takePacks
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   120
            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
   121
    where
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   122
    pDelim = "\n\n"
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
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   125
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
   126
recvLoop s chan =
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   127
        ((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
   128
            `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
   129
        )
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   130
        >>= disconnected
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   131
    where
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   132
        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
   133
        receiveWithBufferLoop recvBuf = do
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   134
            recvBS <- recv s 4096
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   135
            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
   136
                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
   137
                forM_ packets sendPacket
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   138
                receiveWithBufferLoop $ B.copy newrecvBuf
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   139
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   140
        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
   141
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   142
10742
34c1afbda24a checker.ini to avoid hardcoded paths
unc0rr
parents: 10478
diff changeset
   143
session :: B.ByteString -> B.ByteString -> String -> String -> String -> Socket -> IO ()
34c1afbda24a checker.ini to avoid hardcoded paths
unc0rr
parents: 10478
diff changeset
   144
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
   145
    noticeM "Core" "Connected"
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   146
    coreChan <- newChan
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   147
    forkIO $ recvLoop s coreChan
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   148
    forever $ do
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   149
        p <- readChan coreChan
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   150
        case p of
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   151
            Packet p -> do
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   152
                debugM "Network" $ "Recv: " ++ show p
8515
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
   153
                onPacket coreChan p
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
   154
            CheckFailed msg -> do
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
   155
                warningM "Check" "Check failed"
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
   156
                answer ["CHECKED", "FAIL", msg]
11509
6a5bdf930edf Add some delay to checker
unc0rr
parents: 11345
diff changeset
   157
                threadDelay 1500000
8515
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
   158
                answer ["READY"]
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
   159
            CheckSuccess msgs -> do
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
   160
                warningM "Check" "Check succeeded"
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
   161
                answer ("CHECKED" : "OK" : msgs)
11509
6a5bdf930edf Add some delay to checker
unc0rr
parents: 11345
diff changeset
   162
                threadDelay 1500000
8515
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
   163
                answer ["READY"]
8474
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   164
    where
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   165
    answer :: [B.ByteString] -> IO ()
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   166
    answer p = do
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   167
        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
   168
        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
   169
    onPacket :: Chan Message -> [B.ByteString] -> IO ()
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
   170
    onPacket _ ("CONNECTED":_) = do
8479
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 8474
diff changeset
   171
        answer ["CHECKER", protocolNumber, l, p]
8515
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
   172
    onPacket _ ["PING"] = answer ["PONG"]
10014
56d2f2d5aad8 Fix checker logon process
Wohlstand
parents: 9866
diff changeset
   173
    onPacket _ ["LOGONPASSED"] = answer ["READY"]
8517
648bb1cb7ebc Some fixes
unc0rr
parents: 8515
diff changeset
   174
    onPacket chan ("REPLAY":msgs) = do
10742
34c1afbda24a checker.ini to avoid hardcoded paths
unc0rr
parents: 10478
diff changeset
   175
        checkReplay home exe prefix chan msgs
8517
648bb1cb7ebc Some fixes
unc0rr
parents: 8515
diff changeset
   176
        warningM "Check" "Started check"
8515
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
   177
    onPacket _ ("BYE" : xs) = error $ show xs
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
   178
    onPacket _ _ = return ()
8474
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
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   181
main :: IO ()
11509
6a5bdf930edf Add some delay to checker
unc0rr
parents: 11345
diff changeset
   182
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
   183
#if !defined(mingw32_HOST_OS)
8507
f4475782cf45 Some more work on checker
unc0rr
parents: 8506
diff changeset
   184
    installHandler sigPIPE Ignore Nothing
f4475782cf45 Some more work on checker
unc0rr
parents: 8506
diff changeset
   185
    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
   186
#endif
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
    updateGlobalLogger "Core" (setLevel DEBUG)
9423
43798a77f1d1 Send less garbage to the server
unc0rr
parents: 9421
diff changeset
   189
    updateGlobalLogger "Network" (setLevel WARNING)
8515
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
   190
    updateGlobalLogger "Check" (setLevel DEBUG)
222f43420615 Parse engine output to deside whether simulation ran to the end
unc0rr
parents: 8507
diff changeset
   191
    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
   192
10742
34c1afbda24a checker.ini to avoid hardcoded paths
unc0rr
parents: 10478
diff changeset
   193
    d <- getHomeDirectory
8474
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   194
    Right (login, password) <- runErrorT $ do
9581
eb35cc7ad9f0 Oops, looked in the deprecated file
unc0rr
parents: 9423
diff changeset
   195
        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
   196
        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
   197
        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
   198
        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
   199
10742
34c1afbda24a checker.ini to avoid hardcoded paths
unc0rr
parents: 10478
diff changeset
   200
    Right (exeFullname, dataPrefix) <- runErrorT $ do
34c1afbda24a checker.ini to avoid hardcoded paths
unc0rr
parents: 10478
diff changeset
   201
        conf <- join . liftIO . CF.readfile CF.emptyCP $ d ++ "/.hedgewars/checker.ini"
34c1afbda24a checker.ini to avoid hardcoded paths
unc0rr
parents: 10478
diff changeset
   202
        l <- CF.get conf "engine" "exe"
34c1afbda24a checker.ini to avoid hardcoded paths
unc0rr
parents: 10478
diff changeset
   203
        p <- CF.get conf "engine" "prefix"
34c1afbda24a checker.ini to avoid hardcoded paths
unc0rr
parents: 10478
diff changeset
   204
        return (l, p)
34c1afbda24a checker.ini to avoid hardcoded paths
unc0rr
parents: 10478
diff changeset
   205
8474
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   206
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   207
    Exception.bracket
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   208
        setupConnection
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   209
        (\s -> noticeM "Core" "Shutting down" >> sClose s)
10746
c882355f7bc3 Fix home path
unc0rr
parents: 10742
diff changeset
   210
        (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
   211
    where
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   212
        setupConnection = do
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   213
            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
   214
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   215
            proto <- getProtocolNumber "tcp"
f6abe50095d2 Start work on the checker. Not it could connect to the server and... crash it.
unc0rr
parents:
diff changeset
   216
            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
   217
            (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
   218
            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
   219
            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
   220
            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
   221
            return sock