--- a/QTfrontend/newnetclient.cpp Sun Oct 05 23:36:11 2008 +0000
+++ b/QTfrontend/newnetclient.cpp Mon Oct 06 18:07:38 2008 +0000
@@ -173,12 +173,20 @@
if (lst[0] == "ERROR") {
if (lst.size() == 2)
- QMessageBox::information(0, 0, lst[1]);
+ QMessageBox::information(0, 0, "Error: " + lst[1]);
else
QMessageBox::information(0, 0, "Unknown error");
return;
}
+ if (lst[0] == "WARNING") {
+ if (lst.size() == 2)
+ QMessageBox::information(0, 0, "Warning: " + lst[1]);
+ else
+ QMessageBox::information(0, 0, "Unknown warning");
+ return;
+ }
+
if (lst[0] == "CONNECTED") {
m_game_connected=true;
emit Connected();
--- a/netserver/HWProto.hs Sun Oct 05 23:36:11 2008 +0000
+++ b/netserver/HWProto.hs Mon Oct 06 18:07:38 2008 +0000
@@ -23,16 +23,18 @@
answerWrongPassword = [(clientOnly, ["WARNING", "Wrong password"])]
answerChatString nick msg = [(othersInRoom, ["CHAT_STRING", nick, msg])]
+
-- Main state-independent cmd handler
handleCmd :: CmdHandler
handleCmd client _ rooms ("QUIT":xs) =
if null (room client) then
(noChangeClients, noChangeRooms, answerQuit)
else if isMaster client then
- (noChangeClients, removeRoom (room client), (answerQuitInform $ nick client) ++ answerAbandoned) -- core disconnects clients on ROOMABANDONED answer
+ (noChangeClients, removeRoom (room client), answerAbandoned ++ (answerQuitInform $ nick client)) -- core disconnects clients on ROOMABANDONED answer
else
(noChangeClients, noChangeRooms, answerQuitInform $ nick client)
+
-- check state and call state-dependent commmand handlers
handleCmd client clients rooms cmd =
if null (nick client) || protocol client == 0 then
@@ -42,6 +44,7 @@
else
handleCmd_inRoom client clients rooms cmd
+
-- 'no info' state - need to get protocol number and nickname
handleCmd_noInfo :: CmdHandler
handleCmd_noInfo client clients _ ["NICK", newNick] =
@@ -66,6 +69,7 @@
handleCmd_noInfo _ _ _ _ = (noChangeClients, noChangeRooms, answerBadCmd)
+
-- 'noRoom' clients state command handlers
handleCmd_noRoom :: CmdHandler
handleCmd_noRoom client _ rooms ["LIST"] =
@@ -97,6 +101,7 @@
handleCmd_noRoom _ _ _ _ = (noChangeClients, noChangeRooms, answerBadCmd)
+
-- 'inRoom' clients state command handlers
handleCmd_inRoom :: CmdHandler
--- a/netserver/newhwserv.hs Sun Oct 05 23:36:11 2008 +0000
+++ b/netserver/newhwserv.hs Mon Oct 06 18:07:38 2008 +0000
@@ -5,7 +5,7 @@
import System.IO
import Control.Concurrent
import Control.Concurrent.STM
-import Control.Exception (finally)
+import Control.Exception (setUncaughtExceptionHandler, handle, finally)
import Control.Monad (forM, forM_, filterM, liftM)
import Data.List
import Miscutils
@@ -20,6 +20,7 @@
hPutStrLn cHandle "CONNECTED\n"
acceptLoop servSock acceptChan
+
listenLoop :: Handle -> [String] -> TChan [String] -> IO ()
listenLoop handle buf chan = do
str <- hGetLine handle
@@ -29,31 +30,32 @@
else
listenLoop handle (buf ++ [str]) chan
+
clientLoop :: Handle -> TChan [String] -> IO ()
clientLoop handle chan =
listenLoop handle [] chan
`catch` (const $ clientOff >> return ())
where clientOff = atomically $ writeTChan chan ["QUIT"] -- если клиент отключается, то делаем вид, что от него пришла команда QUIT
+
sendAnswers [] _ clients _ = return clients
sendAnswers ((handlesFunc, answer):answers) client clients rooms = do
- putStrLn ("< " ++ show answer)
-
let recipients = handlesFunc client clients rooms
+ putStrLn ("< " ++ (show answer) ++ " (" ++ (show $ length recipients) ++ " recipients)")
clHandles' <- forM recipients $
- \ch -> do
+ \ch -> Control.Exception.handle (\e -> putStrLn (show e) >> hClose ch >> return [ch]) $
+ do
forM_ answer (\str -> hPutStrLn ch str)
hPutStrLn ch ""
hFlush ch
if (not $ null answer) && (head answer == "BYE") then hClose ch >> return [ch] else return []
- `catch` const (hClose ch >> return [ch])
let mclients = remove clients $ concat clHandles'
sendAnswers answers client mclients rooms
where
- remove list rmClHandles = deleteFirstsBy2t (\ a b -> (handle a) == b) list rmClHandles
+ remove list rmClHandles = deleteFirstsBy2t (\ a b -> (Miscutils.handle a) == b) list rmClHandles
mainLoop :: Socket -> TChan ClientInfo -> [ClientInfo] -> [RoomInfo] -> IO ()
@@ -64,20 +66,21 @@
mainLoop servSock acceptChan (ci:clients) rooms
Right (cmd, client) -> do
putStrLn ("> " ++ show cmd)
+
let (clientsFunc, roomsFunc, answers) = handleCmd client clients rooms $ cmd
-
- let mclients = clientsFunc clients
let mrooms = roomsFunc rooms
- mclients <- sendAnswers answers client clients rooms
+ clientsIn <- sendAnswers answers client (clientsFunc clients) mrooms
- mainLoop servSock acceptChan mclients mrooms
+ mainLoop servSock acceptChan clientsIn mrooms
+
startServer serverSocket = do
acceptChan <- atomically newTChan
forkIO $ acceptLoop serverSocket acceptChan
mainLoop serverSocket acceptChan [] []
+
main = withSocketsDo $ do
serverSocket <- listenOn $ Service "hedgewars"
startServer serverSocket `finally` sClose serverSocket