# HG changeset patch # User unc0rr # Date 1280069754 -14400 # Node ID a94d1dc4a8d9f5efe9531035dd38ebf13769faf1 # Parent 19be65b12c43cc2ec709137a58f022e9346a261b - burp's patch cleaning up module dependancies + cabal file - mixed with some changes by me trying to fight a bug diff -r 19be65b12c43 -r a94d1dc4a8d9 gameServer/Actions.hs --- a/gameServer/Actions.hs Sun Jul 25 10:16:34 2010 -0400 +++ b/gameServer/Actions.hs Sun Jul 25 18:55:54 2010 +0400 @@ -7,9 +7,9 @@ import qualified Data.Set as Set import qualified Data.Sequence as Seq import System.Log.Logger -import Monad +import Control.Monad import Data.Time -import Maybe +import Data.Maybe import Control.Monad.Reader import Control.Monad.State import qualified Data.ByteString.Char8 as B @@ -116,11 +116,11 @@ readyPlayers = if ready then readyPlayers r - 1 else readyPlayers r }) ri - removeClient rnc ci - modify (\s -> s{removedClients = ci `Set.insert` removedClients s}) processAction (DeleteClient ci) = do + rnc <- gets roomsClients + liftIO $ removeClient rnc ci modify (\s -> s{removedClients = ci `Set.delete` removedClients s}) {- diff -r 19be65b12c43 -r a94d1dc4a8d9 gameServer/ClientIO.hs --- a/gameServer/ClientIO.hs Sun Jul 25 10:16:34 2010 -0400 +++ b/gameServer/ClientIO.hs Sun Jul 25 18:55:54 2010 +0400 @@ -61,7 +61,7 @@ clientSendLoop s coreChan chan ci = do answer <- readChan chan doClose <- Exception.handle - (\(e :: Exception.IOException) -> if isQuit answer then return True else sendQuit e >> return False) $ do + (\(e :: Exception.IOException) -> if isQuit answer then return True else sendQuit e >> return True) $ do sendAll s $ (B.unlines answer) `B.append` (B.singleton '\n') return $ isQuit answer diff -r 19be65b12c43 -r a94d1dc4a8d9 gameServer/HWProtoCore.hs --- a/gameServer/HWProtoCore.hs Sun Jul 25 10:16:34 2010 -0400 +++ b/gameServer/HWProtoCore.hs Sun Jul 25 18:55:54 2010 +0400 @@ -3,7 +3,7 @@ import qualified Data.IntMap as IntMap import Data.Foldable -import Maybe +import Data.Maybe import Control.Monad.Reader -------------------------------------- import CoreTypes diff -r 19be65b12c43 -r a94d1dc4a8d9 gameServer/HWProtoNEState.hs --- a/gameServer/HWProtoNEState.hs Sun Jul 25 10:16:34 2010 -0400 +++ b/gameServer/HWProtoNEState.hs Sun Jul 25 18:55:54 2010 +0400 @@ -2,7 +2,7 @@ module HWProtoNEState where import qualified Data.IntMap as IntMap -import Maybe +import Data.Maybe import Data.List import Data.Word import Control.Monad.Reader diff -r 19be65b12c43 -r a94d1dc4a8d9 gameServer/OfficialServer/DBInteraction.hs --- a/gameServer/OfficialServer/DBInteraction.hs Sun Jul 25 10:16:34 2010 -0400 +++ b/gameServer/OfficialServer/DBInteraction.hs Sun Jul 25 18:55:54 2010 +0400 @@ -11,8 +11,7 @@ import qualified Control.Exception as Exception import Control.Monad import qualified Data.Map as Map -import Monad -import Maybe +import Data.Maybe import System.Log.Logger import Data.Time ------------------------ diff -r 19be65b12c43 -r a94d1dc4a8d9 gameServer/Opts.hs --- a/gameServer/Opts.hs Sun Jul 25 10:16:34 2010 -0400 +++ b/gameServer/Opts.hs Sun Jul 25 18:55:54 2010 +0400 @@ -3,7 +3,7 @@ getOpts, ) where -import System +import System.Environment import System.Console.GetOpt import Network import Data.Maybe ( fromMaybe ) diff -r 19be65b12c43 -r a94d1dc4a8d9 gameServer/ServerCore.hs --- a/gameServer/ServerCore.hs Sun Jul 25 10:16:34 2010 -0400 +++ b/gameServer/ServerCore.hs Sun Jul 25 18:55:54 2010 +0400 @@ -74,7 +74,7 @@ return () - forkIO $ timerLoop 0 $ coreChan serverInfo + --forkIO $ timerLoop 0 $ coreChan serverInfo startDBConnection serverInfo @@ -82,4 +82,4 @@ forkIO $ evalStateT mainLoop (ServerState Nothing serverInfo Set.empty rnc) - forever $ threadDelay (60 * 60 * 10^6) >> putStrLn "***" + forever $ threadDelay (60 * 60 * 10^6) diff -r 19be65b12c43 -r a94d1dc4a8d9 gameServer/Store.hs --- a/gameServer/Store.hs Sun Jul 25 10:16:34 2010 -0400 +++ b/gameServer/Store.hs Sun Jul 25 18:55:54 2010 +0400 @@ -77,7 +77,7 @@ removeElem :: MStore e -> ElemIndex -> IO () removeElem (MStore ref) (ElemIndex n) = do (busyElems, freeElems, arr) <- readIORef ref - IOA.writeArray arr n undefined + IOA.writeArray arr n (error "Store: no element") writeIORef ref (IntSet.delete n busyElems, IntSet.insert n freeElems, arr) diff -r 19be65b12c43 -r a94d1dc4a8d9 gameServer/Utils.hs --- a/gameServer/Utils.hs Sun Jul 25 10:16:34 2010 -0400 +++ b/gameServer/Utils.hs Sun Jul 25 18:55:54 2010 +0400 @@ -14,7 +14,7 @@ import System.IO import qualified Data.List as List import Control.Monad -import Maybe +import Data.Maybe ------------------------------------------------- import qualified Codec.Binary.Base64 as Base64 import qualified Data.ByteString.Char8 as B diff -r 19be65b12c43 -r a94d1dc4a8d9 gameServer/hedgewars-server.cabal --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/gameServer/hedgewars-server.cabal Sun Jul 25 18:55:54 2010 +0400 @@ -0,0 +1,32 @@ +Name: hedgewars-server +Version: 0.1 +Synopsis: hedgewars server +Description: hedgewars server +Homepage: http://www.hedgewars.org/ +License: GPL-2 +Author: unC0Rr +Maintainer: unC0Rr@hedgewars.org +Category: Game +Build-type: Simple +Cabal-version: >=1.2 + + +Executable hedgewars-server + main-is: hedgewars-server.hs + + Build-depends: + base >= 4, + unix, + containers, + array, + bytestring, + network-bytestring, + network, + time, + stm, + mtl, + dataenc, + hslogger, + process + + ghc-options: -O2 \ No newline at end of file diff -r 19be65b12c43 -r a94d1dc4a8d9 gameServer/stresstest3.hs --- a/gameServer/stresstest3.hs Sun Jul 25 10:16:34 2010 -0400 +++ b/gameServer/stresstest3.hs Sun Jul 25 18:55:54 2010 +0400 @@ -19,7 +19,6 @@ type SState = Handle io = liftIO - readPacket :: StateT SState IO [String] readPacket = do h <- get @@ -45,22 +44,26 @@ emulateSession :: StateT SState IO () emulateSession = do + n <- io $ randomRIO (100000::Int, 100000) waitPacket "CONNECTED" - sendPacket ["NICK", "test"] + sendPacket ["NICK", "test" ++ (show n)] waitPacket "NICK" sendPacket ["PROTO", "31"] waitPacket "PROTO" b <- waitPacket "LOBBY:JOINED" - io $ print b + --io $ print b + return () testing = Control.OldException.handle print $ do - putStrLn "Start" + putStr "+" sock <- connectTo "127.0.0.1" (PortNumber 46631) evalStateT emulateSession sock - putStrLn "Finish" + --hClose sock + putStr "-" + hFlush stdout forks = forever $ do - delay <- randomRIO (400000::Int, 600000) + delay <- randomRIO (20000::Int, 40000) threadDelay delay forkIO testing