27 data Message = Packet [B.ByteString] |
27 data Message = Packet [B.ByteString] |
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 protocolNumber = "43" |
33 protocolNumber = "43" |
33 |
34 |
34 |
35 |
35 engineListener :: Chan Message -> Handle -> IO () |
36 engineListener :: Chan Message -> Handle -> IO () |
36 engineListener coreChan h = do |
37 engineListener coreChan h = do |
41 else |
42 else |
42 writeChan coreChan $ CheckSuccess [] |
43 writeChan coreChan $ CheckSuccess [] |
43 where |
44 where |
44 start = flip L.elem ["WINNERS", "DRAW"] |
45 start = flip L.elem ["WINNERS", "DRAW"] |
45 |
46 |
|
47 |
46 checkReplay :: Chan Message -> [B.ByteString] -> IO () |
48 checkReplay :: Chan Message -> [B.ByteString] -> IO () |
47 checkReplay coreChan msgs = do |
49 checkReplay coreChan msgs = do |
48 tempDir <- getTemporaryDirectory |
50 tempDir <- getTemporaryDirectory |
49 (fileName, h) <- openBinaryTempFile tempDir "checker-demo" |
51 (fileName, h) <- openBinaryTempFile tempDir "checker-demo" |
50 B.hPut h . BW.pack . concat . map (fromJust . Base64.decode . B.unpack) $ msgs |
52 B.hPut h . BW.pack . concat . map (fromJust . Base64.decode . B.unpack) $ msgs |
51 hFlush h |
53 hFlush h |
52 hClose h |
54 hClose h |
53 |
55 |
54 (_, Just hErr, _, _) <- createProcess (proc "/usr/home/unC0Rr/Sources/Hedgewars/Releases/0.9.18/bin/hwengine" |
56 (_, Just hOut, _, _) <- createProcess (proc "/usr/home/unC0Rr/Sources/Hedgewars/Releases/0.9.18/bin/hwengine" |
55 ["/usr/home/unC0Rr/.hedgewars" |
57 ["/usr/home/unC0Rr/.hedgewars" |
56 , "/usr/home/unC0Rr/Sources/Hedgewars/Releases/0.9.18/share/hedgewars/Data" |
58 , "/usr/home/unC0Rr/Sources/Hedgewars/Releases/0.9.18/share/hedgewars/Data" |
57 , fileName |
59 , fileName |
58 , "--set-audio" |
60 , "--set-audio" |
59 , "0" |
61 , "0" |
60 , "0" |
62 , "0" |
61 , "0" |
63 , "0" |
62 ]) |
64 ]) |
63 {std_out = CreatePipe} |
65 {std_out = CreatePipe} |
64 hSetBuffering hErr LineBuffering |
66 hSetBuffering hOut LineBuffering |
65 void $ forkIO $ engineListener coreChan hErr |
67 void $ forkIO $ engineListener coreChan hOut |
66 |
68 |
67 |
69 |
68 takePacks :: State B.ByteString [[B.ByteString]] |
70 takePacks :: State B.ByteString [[B.ByteString]] |
69 takePacks = do |
71 takePacks = do |
70 modify (until (not . B.isPrefixOf pDelim) (B.drop 2)) |
72 modify (until (not . B.isPrefixOf pDelim) (B.drop 2)) |
123 onPacket :: Chan Message -> [B.ByteString] -> IO () |
125 onPacket :: Chan Message -> [B.ByteString] -> IO () |
124 onPacket _ ("CONNECTED":_) = do |
126 onPacket _ ("CONNECTED":_) = do |
125 answer ["CHECKER", protocolNumber, l, p] |
127 answer ["CHECKER", protocolNumber, l, p] |
126 answer ["READY"] |
128 answer ["READY"] |
127 onPacket _ ["PING"] = answer ["PONG"] |
129 onPacket _ ["PING"] = answer ["PONG"] |
128 onPacket chan ("REPLAY":msgs) = checkReplay chan msgs |
130 onPacket chan ("REPLAY":msgs) = do |
|
131 checkReplay chan msgs |
|
132 warningM "Check" "Started check" |
129 onPacket _ ("BYE" : xs) = error $ show xs |
133 onPacket _ ("BYE" : xs) = error $ show xs |
130 onPacket _ _ = return () |
134 onPacket _ _ = return () |
131 |
135 |
132 |
136 |
133 main :: IO () |
137 main :: IO () |
163 (addr:_) <- getAddrInfo (Just hints) (Just serverAddress) Nothing |
167 (addr:_) <- getAddrInfo (Just hints) (Just serverAddress) Nothing |
164 let (SockAddrInet _ host) = addrAddress addr |
168 let (SockAddrInet _ host) = addrAddress addr |
165 sock <- socket AF_INET Stream proto |
169 sock <- socket AF_INET Stream proto |
166 connect sock (SockAddrInet 46631 host) |
170 connect sock (SockAddrInet 46631 host) |
167 return sock |
171 return sock |
168 |
|
169 serverAddress = "netserver.hedgewars.org" |
|