gameServer/OfficialServer/checker.hs
changeset 9423 43798a77f1d1
parent 9421 90fe753b3654
child 9581 eb35cc7ad9f0
equal deleted inserted replaced
9421:90fe753b3654 9423:43798a77f1d1
    22 import qualified Data.List as L
    22 import qualified Data.List as L
    23 #if !defined(mingw32_HOST_OS)
    23 #if !defined(mingw32_HOST_OS)
    24 import System.Posix
    24 import System.Posix
    25 #endif
    25 #endif
    26 
    26 
       
    27 readInt_ :: (Num a) => B.ByteString -> a
       
    28 readInt_ str =
       
    29   case B.readInt str of
       
    30        Just (i, t) | B.null t -> fromIntegral i
       
    31        _                      -> 0 
       
    32 
    27 data Message = Packet [B.ByteString]
    33 data Message = Packet [B.ByteString]
    28              | CheckFailed B.ByteString
    34              | CheckFailed B.ByteString
    29              | CheckSuccess [B.ByteString]
    35              | CheckSuccess [B.ByteString]
    30     deriving Show
    36     deriving Show
    31 
    37 
    45                 return $ fromJust l : lst
    51                 return $ fromJust l : lst
    46 
    52 
    47 
    53 
    48 engineListener :: Chan Message -> Handle -> String -> IO ()
    54 engineListener :: Chan Message -> Handle -> String -> IO ()
    49 engineListener coreChan h fileName = do
    55 engineListener coreChan h fileName = do
    50     stats <- liftM (L.takeWhile (not . B.null) . L.dropWhile (not . start)) $ getLines h
    56     stats <- liftM (ps . L.dropWhile (not . start)) $ getLines h
    51     debugM "Engine" $ show stats
    57     debugM "Engine" $ show stats
    52     if null stats then
    58     if null stats then
    53         writeChan coreChan $ CheckFailed "No stats msg"
    59         writeChan coreChan $ CheckFailed "No stats msg"
    54         else
    60         else
    55         writeChan coreChan $ CheckSuccess stats
    61         writeChan coreChan $ CheckSuccess stats
    56 
    62 
    57     removeFile fileName
    63     removeFile fileName
    58     where
    64     where
    59         start = flip L.elem ["WINNERS", "DRAW"]
    65         start = flip L.elem ["WINNERS", "DRAW"]
    60 
    66         ps ("DRAW" : bs) = "DRAW" : ps bs
       
    67         ps ("WINNERS" : n : bs) = let c = readInt_ n in "WINNERS" : n : take c bs ++ (ps $ drop c bs)
       
    68         ps ("ACHIEVEMENT" : typ : teamname : location : value : bs) =
       
    69             "ACHIEVEMENT" : typ : teamname : location : value : ps bs
       
    70         ps _ = []
    61 
    71 
    62 checkReplay :: Chan Message -> [B.ByteString] -> IO ()
    72 checkReplay :: Chan Message -> [B.ByteString] -> IO ()
    63 checkReplay coreChan msgs = do
    73 checkReplay coreChan msgs = do
    64     tempDir <- getTemporaryDirectory
    74     tempDir <- getTemporaryDirectory
    65     (fileName, h) <- openBinaryTempFile tempDir "checker-demo"
    75     (fileName, h) <- openBinaryTempFile tempDir "checker-demo"
   153     installHandler sigPIPE Ignore Nothing
   163     installHandler sigPIPE Ignore Nothing
   154     installHandler sigCHLD Ignore Nothing
   164     installHandler sigCHLD Ignore Nothing
   155 #endif
   165 #endif
   156 
   166 
   157     updateGlobalLogger "Core" (setLevel DEBUG)
   167     updateGlobalLogger "Core" (setLevel DEBUG)
   158     updateGlobalLogger "Network" (setLevel DEBUG)
   168     updateGlobalLogger "Network" (setLevel WARNING)
   159     updateGlobalLogger "Check" (setLevel DEBUG)
   169     updateGlobalLogger "Check" (setLevel DEBUG)
   160     updateGlobalLogger "Engine" (setLevel DEBUG)
   170     updateGlobalLogger "Engine" (setLevel DEBUG)
   161 
   171 
   162     Right (login, password) <- runErrorT $ do
   172     Right (login, password) <- runErrorT $ do
   163         d <- liftIO $ getHomeDirectory
   173         d <- liftIO $ getHomeDirectory