--- a/netserver/HWProto.hs Mon Nov 03 14:47:23 2008 +0000
+++ b/netserver/HWProto.hs Tue Nov 04 14:43:31 2008 +0000
@@ -63,6 +63,7 @@
answerTooFewClans = [(clientOnly, ["ERROR", "Too few clans in game"])]
answerRestricted = [(clientOnly, ["WARNING", "Room joining restricted"])]
answerPing = [(allClients, ["PING"])]
+answerConnected = [(clientOnly, ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"])]
-- Main state-independent cmd handler
handleCmd :: CmdHandler
@@ -82,6 +83,9 @@
handleCmd _ _ _ ["PING"] = -- core requsted
(noChangeClients, noChangeRooms, answerPing)
+handleCmd _ _ _ ["ASKME"] = -- core requsted
+ (noChangeClients, noChangeRooms, answerConnected)
+
handleCmd _ _ _ ["PONG"] =
(noChangeClients, noChangeRooms, [])
--- a/netserver/hedgewars-server.hs Mon Nov 03 14:47:23 2008 +0000
+++ b/netserver/hedgewars-server.hs Tue Nov 04 14:43:31 2008 +0000
@@ -28,13 +28,12 @@
atomically $ writeTChan messagesChan ["PING"]
acceptLoop :: Socket -> TChan ClientInfo -> IO ()
-acceptLoop servSock acceptChan = do
+acceptLoop servSock acceptChan = Control.Exception.handle (const $ putStrLn "exception on connect" >> acceptLoop servSock acceptChan) $ do
(cHandle, host, port) <- accept servSock
- hPutStrLn cHandle "CONNECTED\n"
- hFlush cHandle
cChan <- atomically newTChan
forkIO $ clientLoop cHandle cChan
atomically $ writeTChan acceptChan (ClientInfo cChan cHandle "" 0 "" False False False)
+ atomically $ writeTChan cChan ["ASKME"]
acceptLoop servSock acceptChan