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