gameServer/OfficialServer/checker.hs
branch0.9.19
changeset 9135 151c8e553de2
parent 8521 80229928563f
child 9399 1767c92eff37
equal deleted inserted replaced
9132:57ce31b696ff 9135:151c8e553de2
    28              | CheckFailed B.ByteString
    28              | CheckFailed B.ByteString
    29              | CheckSuccess [B.ByteString]
    29              | CheckSuccess [B.ByteString]
    30     deriving Show
    30     deriving Show
    31 
    31 
    32 serverAddress = "netserver.hedgewars.org"
    32 serverAddress = "netserver.hedgewars.org"
    33 protocolNumber = "43"
    33 protocolNumber = "45"
    34 
    34 
    35 getLines :: Handle -> IO [String]
    35 getLines :: Handle -> IO [String]
    36 getLines h = g
    36 getLines h = g
    37     where
    37     where
    38         g = do
    38         g = do
    43                 do
    43                 do
    44                 lst <- g
    44                 lst <- g
    45                 return $ fromJust l : lst
    45                 return $ fromJust l : lst
    46 
    46 
    47 
    47 
    48 engineListener :: Chan Message -> Handle -> IO ()
    48 engineListener :: Chan Message -> Handle -> String -> IO ()
    49 engineListener coreChan h = do
    49 engineListener coreChan h fileName = do
    50     output <- getLines h
    50     output <- getLines h
    51     debugM "Engine" $ show output
    51     debugM "Engine" $ show output
    52     if isNothing $ L.find start output then
    52     if isNothing $ L.find start output then
    53         writeChan coreChan $ CheckFailed "No stats msg"
    53         writeChan coreChan $ CheckFailed "No stats msg"
    54         else
    54         else
    55         writeChan coreChan $ CheckSuccess []
    55         writeChan coreChan $ CheckSuccess []
       
    56 
       
    57     removeFile fileName
    56     where
    58     where
    57         start = flip L.elem ["WINNERS", "DRAW"]
    59         start = flip L.elem ["WINNERS", "DRAW"]
    58 
    60 
    59 
    61 
    60 checkReplay :: Chan Message -> [B.ByteString] -> IO ()
    62 checkReplay :: Chan Message -> [B.ByteString] -> IO ()
    63     (fileName, h) <- openBinaryTempFile tempDir "checker-demo"
    65     (fileName, h) <- openBinaryTempFile tempDir "checker-demo"
    64     B.hPut h . BW.pack . concat . map (fromJust . Base64.decode . B.unpack) $ msgs
    66     B.hPut h . BW.pack . concat . map (fromJust . Base64.decode . B.unpack) $ msgs
    65     hFlush h
    67     hFlush h
    66     hClose h
    68     hClose h
    67 
    69 
    68     (_, Just hOut, _, _) <- createProcess (proc "/usr/home/unC0Rr/Sources/Hedgewars/Releases/0.9.18/bin/hwengine"
    70     (_, Just hOut, _, _) <- createProcess (proc "/usr/home/unC0Rr/Sources/Hedgewars/Releases/0.9.19/bin/hwengine"
    69                 ["/usr/home/unC0Rr/.hedgewars"
    71                 [fileName
    70                 , "/usr/home/unC0Rr/Sources/Hedgewars/Releases/0.9.18/share/hedgewars/Data"
    72                 , "--user-prefix", "/usr/home/unC0Rr/.hedgewars"
    71                 , fileName
    73                 , "--prefix", "/usr/home/unC0Rr/Sources/Hedgewars/Releases/0.9.19/share/hedgewars/Data"
    72                 , "--set-audio"
    74                 , "--nomusic"
    73                 , "0"
    75                 , "--nosound"
    74                 , "0"
       
    75                 , "0"
       
    76                 ])
    76                 ])
    77             {std_out = CreatePipe}
    77             {std_out = CreatePipe}
    78     hSetBuffering hOut LineBuffering
    78     hSetBuffering hOut LineBuffering
    79     void $ forkIO $ engineListener coreChan hOut
    79     void $ forkIO $ engineListener coreChan hOut fileName
    80 
    80 
    81 
    81 
    82 takePacks :: State B.ByteString [[B.ByteString]]
    82 takePacks :: State B.ByteString [[B.ByteString]]
    83 takePacks = do
    83 takePacks = do
    84     modify (until (not . B.isPrefixOf pDelim) (B.drop 2))
    84     modify (until (not . B.isPrefixOf pDelim) (B.drop 2))