- burp's patch cleaning up module dependancies + cabal file
- mixed with some changes by me trying to fight a bug
--- 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})
{-
--- 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
--- 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
--- 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
--- 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
------------------------
--- 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 )
--- 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)
--- 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)
--- 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
--- /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
--- 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