--- a/gameServer/Actions.hs Wed May 27 03:56:17 2009 +0000
+++ b/gameServer/Actions.hs Wed May 27 15:29:30 2009 +0000
@@ -22,7 +22,7 @@
| AnswerLobby [String]
| SendServerMessage
| RoomAddThisClient Int -- roomID
- | RoomRemoveThisClient
+ | RoomRemoveThisClient String
| RemoveTeam String
| RemoveRoom
| UnreadyRoomClients
@@ -188,13 +188,13 @@
AnswerThisRoom ["JOINED", nick client]
-processAction (clID, serverInfo, clients, rooms) (RoomRemoveThisClient) = do
+processAction (clID, serverInfo, clients, rooms) (RoomRemoveThisClient msg) = do
(_, _, newClients, newRooms) <-
if roomID client /= 0 then
foldM
processAction
(clID, serverInfo, clients, rooms)
- [AnswerOthersInRoom ["LEFT", nick client, "part"],
+ [AnswerOthersInRoom ["LEFT", nick client, msg],
RemoveClientTeams clID]
else
return (clID, serverInfo, clients, rooms)
@@ -339,7 +339,7 @@
processAction (clID, serverInfo, clients, rooms) (KickRoomClient kickID) = do
writeChan (sendChan $ clients ! kickID) ["KICKED"]
- liftM2 replaceID (return clID) (processAction (kickID, serverInfo, clients, rooms) $ RoomRemoveThisClient)
+ liftM2 replaceID (return clID) (processAction (kickID, serverInfo, clients, rooms) $ RoomRemoveThisClient "kicked")
processAction (clID, serverInfo, clients, rooms) (RemoveClientTeams teamsClID) = do
--- a/gameServer/ClientIO.hs Wed May 27 03:56:17 2009 +0000
+++ b/gameServer/ClientIO.hs Wed May 27 15:29:30 2009 +0000
@@ -43,4 +43,5 @@
where
sendQuit e = writeChan coreChan $ ClientMessage (clientID, ["QUIT", show e])
- isQuit answer = head answer == "BYE"
+ isQuit ("BYE":xs) = True
+ isQuit _ = False
--- a/gameServer/HWProtoCore.hs Wed May 27 03:56:17 2009 +0000
+++ b/gameServer/HWProtoCore.hs Wed May 27 15:29:30 2009 +0000
@@ -48,13 +48,15 @@
nick client,
"[" ++ host client ++ "]",
protoNumber2ver $ clientProto client,
- roomInfo]]
+ "[" ++ roomInfo ++ "]"]]
where
maybeClient = find (\cl -> asknick == nick cl) clients
noSuchClient = isNothing maybeClient
client = fromJust maybeClient
room = rooms IntMap.! roomID client
- roomInfo = if roomID client /= 0 then "room " ++ (name room) else "lobby"
+ roomInfo = if roomID client /= 0 then roomMasterSign ++ "room " ++ (name room) else adminSign ++ "lobby"
+ roomMasterSign = if isMaster client then "@" else ""
+ adminSign = if isAdministrator client then "@" else ""
handleCmd_loggedin clID clients rooms cmd =
--- a/gameServer/HWProtoInRoomState.hs Wed May 27 03:56:17 2009 +0000
+++ b/gameServer/HWProtoInRoomState.hs Wed May 27 15:29:30 2009 +0000
@@ -24,7 +24,7 @@
if isMaster client then
[RemoveRoom]
else
- [RoomRemoveThisClient]
+ [RoomRemoveThisClient "part"]
where
client = clients IntMap.! clID
--- a/gameServer/HWProtoLobbyState.hs Wed May 27 03:56:17 2009 +0000
+++ b/gameServer/HWProtoLobbyState.hs Wed May 27 15:29:30 2009 +0000
@@ -45,7 +45,7 @@
if haveSameRoom then
[Warning "Room exists"]
else
- [RoomRemoveThisClient, -- leave lobby
+ [RoomRemoveThisClient "", -- leave lobby
AddRoom newRoom roomPassword,
AnswerThisClient ["NOT_READY", clientNick]
]
@@ -66,7 +66,7 @@
else if roomPassword /= password jRoom then
[Warning "Wrong password"]
else
- [RoomRemoveThisClient, -- leave lobby
+ [RoomRemoveThisClient "", -- leave lobby
RoomAddThisClient rID] -- join room
++ answerNicks
++ answerReady
--- a/gameServer/OfficialServer/DBInteraction.hs Wed May 27 03:56:17 2009 +0000
+++ b/gameServer/OfficialServer/DBInteraction.hs Wed May 27 15:29:30 2009 +0000
@@ -14,6 +14,7 @@
import Monad
import Maybe
import System.Log.Logger
+import Data.Time
------------------------
import CoreTypes
import Utils
@@ -45,7 +46,8 @@
updatedCache <- case q of
CheckAccount clUid clNick _ -> do
let cacheEntry = clNick `Map.lookup` accountsCache
- if isNothing cacheEntry then
+ currentTime <- getCurrentTime
+ if (isNothing cacheEntry) || (currentTime `diffUTCTime` (fst . fromJust) cacheEntry > 2 * 24 * 60 * 60) then
do
hPutStrLn hIn $ show q
hFlush hIn
@@ -54,12 +56,12 @@
writeChan coreChan $ ClientAccountInfo (clId, accountInfo)
- return $ Map.insert clNick accountInfo accountsCache
+ return $ Map.insert clNick (currentTime, accountInfo) accountsCache
`onException`
(unGetChan queries q)
else
do
- writeChan coreChan $ ClientAccountInfo (clUid, fromJust cacheEntry)
+ writeChan coreChan $ ClientAccountInfo (clUid, snd $ fromJust cacheEntry)
return accountsCache
return updatedCache
@@ -70,26 +72,28 @@
pipeDbConnection accountsCache serverInfo = do
updatedCache <-
- Control.Exception.handle (\e -> warningM "Database" (show e) >> return accountsCache) $ do
- (Just hIn, Just hOut, _, _) <-
- createProcess (proc "./OfficialServer/extdbinterface" []) {std_in = CreatePipe, std_out = CreatePipe}
-
- hSetBuffering hIn LineBuffering
- hSetBuffering hOut LineBuffering
-
- hPutStrLn hIn $ dbHost serverInfo
- hPutStrLn hIn $ dbLogin serverInfo
- hPutStrLn hIn $ dbPassword serverInfo
- pipeDbConnectionLoop (dbQueries serverInfo) (coreChan serverInfo) hIn hOut accountsCache
+ Control.Exception.handle (\e -> warningM "Database" (show e) >> return accountsCache) $
+ bracket
+ (createProcess (proc "./OfficialServer/extdbinterface" []) {std_in = CreatePipe, std_out = CreatePipe})
+ (\(_, _, _, processHandle) -> getProcessExitCode processHandle >> return (accountsCache))
+ (\(Just hIn, Just hOut, _, _) -> do
+ hSetBuffering hIn LineBuffering
+ hSetBuffering hOut LineBuffering
+
+ hPutStrLn hIn $ dbHost serverInfo
+ hPutStrLn hIn $ dbLogin serverInfo
+ hPutStrLn hIn $ dbPassword serverInfo
+ pipeDbConnectionLoop (dbQueries serverInfo) (coreChan serverInfo) hIn hOut accountsCache
+ )
threadDelay (5 * 10^6)
pipeDbConnection updatedCache serverInfo
-dbConnectionLoop =
+dbConnectionLoop serverInfo =
if (not . null $ dbHost serverInfo) then
- pipeDbConnection Map.empty
+ pipeDbConnection Map.empty serverInfo
else
- fakeDbConnection
+ fakeDbConnection serverInfo
#else
dbConnectionLoop = fakeDbConnection
#endif