17 import qualified Data.ByteString.Char8 as B |
17 import qualified Data.ByteString.Char8 as B |
18 import qualified Data.ByteString as BW |
18 import qualified Data.ByteString as BW |
19 import qualified Codec.Binary.Base64 as Base64 |
19 import qualified Codec.Binary.Base64 as Base64 |
20 import System.Process |
20 import System.Process |
21 import Data.Maybe |
21 import Data.Maybe |
|
22 import qualified Data.List as L |
22 #if !defined(mingw32_HOST_OS) |
23 #if !defined(mingw32_HOST_OS) |
23 import System.Posix |
24 import System.Posix |
24 #endif |
25 #endif |
25 |
26 |
26 data Message = Packet [B.ByteString] |
27 data Message = Packet [B.ByteString] |
|
28 | CheckFailed B.ByteString |
|
29 | CheckSuccess [B.ByteString] |
27 deriving Show |
30 deriving Show |
28 |
31 |
29 protocolNumber = "43" |
32 protocolNumber = "43" |
30 |
33 |
31 checkReplay :: [B.ByteString] -> IO () |
34 |
32 checkReplay msgs = do |
35 engineListener :: Chan Message -> Handle -> IO () |
|
36 engineListener coreChan h = do |
|
37 output <- liftM lines $ hGetContents h |
|
38 debugM "Engine" $ show output |
|
39 if isNothing $ L.find start output then |
|
40 writeChan coreChan $ CheckFailed "No stats msg" |
|
41 else |
|
42 writeChan coreChan $ CheckSuccess [] |
|
43 where |
|
44 start = flip L.elem ["WINNERS", "DRAW"] |
|
45 |
|
46 checkReplay :: Chan Message -> [B.ByteString] -> IO () |
|
47 checkReplay coreChan msgs = do |
33 tempDir <- getTemporaryDirectory |
48 tempDir <- getTemporaryDirectory |
34 (fileName, h) <- openBinaryTempFile tempDir "checker-demo" |
49 (fileName, h) <- openBinaryTempFile tempDir "checker-demo" |
35 B.hPut h . BW.pack . concat . map (fromJust . Base64.decode . B.unpack) $ msgs |
50 B.hPut h . BW.pack . concat . map (fromJust . Base64.decode . B.unpack) $ msgs |
36 hFlush h |
51 hFlush h |
37 hClose h |
52 hClose h |
38 |
53 |
39 (_, _, Just hErr, _) <- createProcess (proc "/usr/home/unC0Rr/Sources/Hedgewars/Releases/0.9.18/bin/hwengine" |
54 (_, Just hErr, _, _) <- createProcess (proc "/usr/home/unC0Rr/Sources/Hedgewars/Releases/0.9.18/bin/hwengine" |
40 ["/usr/home/unC0Rr/.hedgewars" |
55 ["/usr/home/unC0Rr/.hedgewars" |
41 , "/usr/home/unC0Rr/Sources/Hedgewars/Releases/0.9.18/share/hedgewars/Data" |
56 , "/usr/home/unC0Rr/Sources/Hedgewars/Releases/0.9.18/share/hedgewars/Data" |
42 , fileName |
57 , fileName |
43 , "--set-audio" |
58 , "--set-audio" |
44 , "0" |
59 , "0" |
45 , "0" |
60 , "0" |
46 , "0" |
61 , "0" |
47 ]) |
62 ]) |
48 {std_err = CreatePipe} |
63 {std_out = CreatePipe} |
49 hSetBuffering hErr LineBuffering |
64 hSetBuffering hErr LineBuffering |
|
65 void $ forkIO $ engineListener coreChan hErr |
50 |
66 |
51 |
67 |
52 takePacks :: State B.ByteString [[B.ByteString]] |
68 takePacks :: State B.ByteString [[B.ByteString]] |
53 takePacks = do |
69 takePacks = do |
54 modify (until (not . B.isPrefixOf pDelim) (B.drop 2)) |
70 modify (until (not . B.isPrefixOf pDelim) (B.drop 2)) |
88 forever $ do |
104 forever $ do |
89 p <- readChan coreChan |
105 p <- readChan coreChan |
90 case p of |
106 case p of |
91 Packet p -> do |
107 Packet p -> do |
92 debugM "Network" $ "Recv: " ++ show p |
108 debugM "Network" $ "Recv: " ++ show p |
93 onPacket p |
109 onPacket coreChan p |
|
110 CheckFailed msg -> do |
|
111 warningM "Check" "Check failed" |
|
112 answer ["CHECKED", "FAIL", msg] |
|
113 answer ["READY"] |
|
114 CheckSuccess msgs -> do |
|
115 warningM "Check" "Check succeeded" |
|
116 answer ("CHECKED" : "OK" : msgs) |
|
117 answer ["READY"] |
94 where |
118 where |
95 answer :: [B.ByteString] -> IO () |
119 answer :: [B.ByteString] -> IO () |
96 answer p = do |
120 answer p = do |
97 debugM "Network" $ "Send: " ++ show p |
121 debugM "Network" $ "Send: " ++ show p |
98 sendAll s $ B.unlines p `B.snoc` '\n' |
122 sendAll s $ B.unlines p `B.snoc` '\n' |
99 onPacket :: [B.ByteString] -> IO () |
123 onPacket :: Chan Message -> [B.ByteString] -> IO () |
100 onPacket ("CONNECTED":_) = do |
124 onPacket _ ("CONNECTED":_) = do |
101 answer ["CHECKER", protocolNumber, l, p] |
125 answer ["CHECKER", protocolNumber, l, p] |
102 answer ["READY"] |
126 answer ["READY"] |
103 onPacket ["PING"] = answer ["PONG"] |
127 onPacket _ ["PING"] = answer ["PONG"] |
104 onPacket ("REPLAY":msgs) = checkReplay msgs |
128 onPacket chan ("REPLAY":msgs) = checkReplay chan msgs |
105 onPacket ("BYE" : xs) = error $ show xs |
129 onPacket _ ("BYE" : xs) = error $ show xs |
106 onPacket _ = return () |
130 onPacket _ _ = return () |
107 |
131 |
108 |
132 |
109 main :: IO () |
133 main :: IO () |
110 main = withSocketsDo $ do |
134 main = withSocketsDo $ do |
111 #if !defined(mingw32_HOST_OS) |
135 #if !defined(mingw32_HOST_OS) |
113 installHandler sigCHLD Ignore Nothing |
137 installHandler sigCHLD Ignore Nothing |
114 #endif |
138 #endif |
115 |
139 |
116 updateGlobalLogger "Core" (setLevel DEBUG) |
140 updateGlobalLogger "Core" (setLevel DEBUG) |
117 updateGlobalLogger "Network" (setLevel DEBUG) |
141 updateGlobalLogger "Network" (setLevel DEBUG) |
|
142 updateGlobalLogger "Check" (setLevel DEBUG) |
|
143 updateGlobalLogger "Engine" (setLevel DEBUG) |
118 |
144 |
119 Right (login, password) <- runErrorT $ do |
145 Right (login, password) <- runErrorT $ do |
120 d <- liftIO $ getHomeDirectory |
146 d <- liftIO $ getHomeDirectory |
121 conf <- join . liftIO . CF.readfile CF.emptyCP $ d ++ "/.hedgewars/hedgewars.ini" |
147 conf <- join . liftIO . CF.readfile CF.emptyCP $ d ++ "/.hedgewars/hedgewars.ini" |
122 l <- CF.get conf "net" "nick" |
148 l <- CF.get conf "net" "nick" |