13 import Network |
13 import Network |
14 import Network.BSD |
14 import Network.BSD |
15 import Network.Socket hiding (recv) |
15 import Network.Socket hiding (recv) |
16 import Network.Socket.ByteString |
16 import Network.Socket.ByteString |
17 import qualified Data.ByteString.Char8 as B |
17 import qualified Data.ByteString.Char8 as B |
|
18 import qualified Data.ByteString as BW |
|
19 import qualified Codec.Binary.Base64 as Base64 |
|
20 import System.Process |
|
21 import Data.Maybe |
18 #if !defined(mingw32_HOST_OS) |
22 #if !defined(mingw32_HOST_OS) |
19 import System.Posix |
23 import System.Posix |
20 #endif |
24 #endif |
21 |
25 |
22 data Message = Packet [B.ByteString] |
26 data Message = Packet [B.ByteString] |
23 deriving Show |
27 deriving Show |
24 |
28 |
25 protocolNumber = "43" |
29 protocolNumber = "43" |
|
30 |
|
31 checkReplay :: [B.ByteString] -> IO () |
|
32 checkReplay msgs = do |
|
33 tempDir <- getTemporaryDirectory |
|
34 (fileName, h) <- openBinaryTempFile tempDir "checker-demo" |
|
35 B.hPut h . BW.pack . concat . map (fromJust . Base64.decode . B.unpack) $ msgs |
|
36 hFlush h |
|
37 hClose h |
|
38 |
|
39 (_, _, Just hErr, _) <- createProcess (proc "/usr/home/unC0Rr/Sources/Hedgewars/Releases/0.9.18/bin/hwengine" |
|
40 ["/usr/home/unC0Rr/.hedgewars" |
|
41 , "/usr/home/unC0Rr/Sources/Hedgewars/Releases/0.9.18/share/hedgewars/Data" |
|
42 , fileName]) |
|
43 {std_err = CreatePipe} |
|
44 hSetBuffering hErr LineBuffering |
|
45 |
26 |
46 |
27 takePacks :: State B.ByteString [[B.ByteString]] |
47 takePacks :: State B.ByteString [[B.ByteString]] |
28 takePacks = do |
48 takePacks = do |
29 modify (until (not . B.isPrefixOf pDelim) (B.drop 2)) |
49 modify (until (not . B.isPrefixOf pDelim) (B.drop 2)) |
30 packet <- state $ B.breakSubstring pDelim |
50 packet <- state $ B.breakSubstring pDelim |
74 onPacket :: [B.ByteString] -> IO () |
94 onPacket :: [B.ByteString] -> IO () |
75 onPacket ("CONNECTED":_) = do |
95 onPacket ("CONNECTED":_) = do |
76 answer ["CHECKER", protocolNumber, l, p] |
96 answer ["CHECKER", protocolNumber, l, p] |
77 answer ["READY"] |
97 answer ["READY"] |
78 onPacket ["PING"] = answer ["PONG"] |
98 onPacket ["PING"] = answer ["PONG"] |
|
99 onPacket ("REPLAY":msgs) = checkReplay msgs |
79 onPacket ("BYE" : xs) = error $ show xs |
100 onPacket ("BYE" : xs) = error $ show xs |
80 onPacket _ = return () |
101 onPacket _ = return () |
81 |
102 |
82 |
103 |
83 main :: IO () |
104 main :: IO () |