85 ps ("WINNERS" : n : bs) = let c = readInt_ n in "WINNERS" : n : take c bs ++ (ps $ drop c bs) |
85 ps ("WINNERS" : n : bs) = let c = readInt_ n in "WINNERS" : n : take c bs ++ (ps $ drop c bs) |
86 ps ("ACHIEVEMENT" : typ : teamname : location : value : bs) = |
86 ps ("ACHIEVEMENT" : typ : teamname : location : value : bs) = |
87 "ACHIEVEMENT" : typ : teamname : location : value : ps bs |
87 "ACHIEVEMENT" : typ : teamname : location : value : ps bs |
88 ps _ = [] |
88 ps _ = [] |
89 |
89 |
90 checkReplay :: Chan Message -> [B.ByteString] -> IO () |
90 checkReplay :: String -> String -> String -> Chan Message -> [B.ByteString] -> IO () |
91 checkReplay coreChan msgs = do |
91 checkReplay home exe prefix coreChan msgs = do |
92 tempDir <- getTemporaryDirectory |
92 tempDir <- getTemporaryDirectory |
93 (fileName, h) <- openBinaryTempFile tempDir "checker-demo" |
93 (fileName, h) <- openBinaryTempFile tempDir "checker-demo" |
94 B.hPut h . BW.pack . concat . map (fromMaybe [] . Base64.decode . B.unpack) $ msgs |
94 B.hPut h . BW.pack . concat . map (fromMaybe [] . Base64.decode . B.unpack) $ msgs |
95 hFlush h |
95 hFlush h |
96 hClose h |
96 hClose h |
97 |
97 |
98 (_, _, Just hOut, _) <- createProcess (proc "/usr/home/unC0Rr/Sources/Hedgewars/Releases/0.9.20/bin/hwengine" |
98 (_, _, Just hOut, _) <- createProcess (proc exe |
99 [fileName |
99 [fileName |
100 , "--user-prefix", "/usr/home/unC0Rr/.hedgewars" |
100 , "--user-prefix", home |
101 , "--prefix", "/usr/home/unC0Rr/Sources/Hedgewars/Releases/0.9.20/share/hedgewars/Data" |
101 , "--prefix", prefix |
102 , "--nomusic" |
102 , "--nomusic" |
103 , "--nosound" |
103 , "--nosound" |
104 , "--stats-only" |
104 , "--stats-only" |
105 ]) |
105 ]) |
106 {std_err = CreatePipe} |
106 {std_err = CreatePipe} |
137 receiveWithBufferLoop $ B.copy newrecvBuf |
137 receiveWithBufferLoop $ B.copy newrecvBuf |
138 |
138 |
139 sendPacket packet = writeChan chan $ Packet packet |
139 sendPacket packet = writeChan chan $ Packet packet |
140 |
140 |
141 |
141 |
142 session :: B.ByteString -> B.ByteString -> Socket -> IO () |
142 session :: B.ByteString -> B.ByteString -> String -> String -> String -> Socket -> IO () |
143 session l p s = do |
143 session l p home exe prefix s = do |
144 noticeM "Core" "Connected" |
144 noticeM "Core" "Connected" |
145 coreChan <- newChan |
145 coreChan <- newChan |
146 forkIO $ recvLoop s coreChan |
146 forkIO $ recvLoop s coreChan |
147 forever $ do |
147 forever $ do |
148 p <- readChan coreChan |
148 p <- readChan coreChan |
167 onPacket _ ("CONNECTED":_) = do |
167 onPacket _ ("CONNECTED":_) = do |
168 answer ["CHECKER", protocolNumber, l, p] |
168 answer ["CHECKER", protocolNumber, l, p] |
169 onPacket _ ["PING"] = answer ["PONG"] |
169 onPacket _ ["PING"] = answer ["PONG"] |
170 onPacket _ ["LOGONPASSED"] = answer ["READY"] |
170 onPacket _ ["LOGONPASSED"] = answer ["READY"] |
171 onPacket chan ("REPLAY":msgs) = do |
171 onPacket chan ("REPLAY":msgs) = do |
172 checkReplay chan msgs |
172 checkReplay home exe prefix chan msgs |
173 warningM "Check" "Started check" |
173 warningM "Check" "Started check" |
174 onPacket _ ("BYE" : xs) = error $ show xs |
174 onPacket _ ("BYE" : xs) = error $ show xs |
175 onPacket _ _ = return () |
175 onPacket _ _ = return () |
176 |
176 |
177 |
177 |
185 updateGlobalLogger "Core" (setLevel DEBUG) |
185 updateGlobalLogger "Core" (setLevel DEBUG) |
186 updateGlobalLogger "Network" (setLevel WARNING) |
186 updateGlobalLogger "Network" (setLevel WARNING) |
187 updateGlobalLogger "Check" (setLevel DEBUG) |
187 updateGlobalLogger "Check" (setLevel DEBUG) |
188 updateGlobalLogger "Engine" (setLevel DEBUG) |
188 updateGlobalLogger "Engine" (setLevel DEBUG) |
189 |
189 |
|
190 d <- getHomeDirectory |
190 Right (login, password) <- runErrorT $ do |
191 Right (login, password) <- runErrorT $ do |
191 d <- liftIO $ getHomeDirectory |
|
192 conf <- join . liftIO . CF.readfile CF.emptyCP $ d ++ "/.hedgewars/settings.ini" |
192 conf <- join . liftIO . CF.readfile CF.emptyCP $ d ++ "/.hedgewars/settings.ini" |
193 l <- CF.get conf "net" "nick" |
193 l <- CF.get conf "net" "nick" |
194 p <- CF.get conf "net" "passwordhash" |
194 p <- CF.get conf "net" "passwordhash" |
195 return (B.pack l, B.pack p) |
195 return (B.pack l, B.pack p) |
196 |
196 |
|
197 Right (exeFullname, dataPrefix) <- runErrorT $ do |
|
198 conf <- join . liftIO . CF.readfile CF.emptyCP $ d ++ "/.hedgewars/checker.ini" |
|
199 l <- CF.get conf "engine" "exe" |
|
200 p <- CF.get conf "engine" "prefix" |
|
201 return (l, p) |
|
202 |
197 |
203 |
198 Exception.bracket |
204 Exception.bracket |
199 setupConnection |
205 setupConnection |
200 (\s -> noticeM "Core" "Shutting down" >> sClose s) |
206 (\s -> noticeM "Core" "Shutting down" >> sClose s) |
201 (session login password) |
207 (session login password (d ++ "/.hedgewars") exeFullname dataPrefix) |
202 where |
208 where |
203 setupConnection = do |
209 setupConnection = do |
204 noticeM "Core" "Connecting to the server..." |
210 noticeM "Core" "Connecting to the server..." |
205 |
211 |
206 proto <- getProtocolNumber "tcp" |
212 proto <- getProtocolNumber "tcp" |