gameServer/stresstest3.hs
author lovelacer
Tue, 17 Jan 2012 09:01:31 -0500
changeset 6580 6155187bf599
parent 5058 4229507909d6
child 7751 8c7f5c43ea5e
permissions -rw-r--r--
A partial reformatting of the pascal code to have consistent syntax. Things that are still inconsistent. Some switch statements (uVisualGears.pas) are not lined up on the : so the internal code blocks are not aligned (lined up on the start of the label instead). Some function contents are indented against begin/end of function, some are not, some function begin/end are themselves indented (adler32). Also inconsistency in things like assigning of variables (whitespace before :=) and use of brackets in tests. Probably needs further review for possible code errors.

{-# LANGUAGE CPP #-}

module Main where

import System.IO
import System.IO.Error
import Control.Concurrent
import Network
import Control.OldException
import Control.Monad
import System.Random
import Control.Monad.State
import Data.List

#if !defined(mingw32_HOST_OS)
import System.Posix
#endif

type SState = Handle
io = liftIO

readPacket :: StateT SState IO [String]
readPacket = do
    h <- get
    io $ hGetPacket h []
    where
    hGetPacket h buf = do
        l <- hGetLine h
        if not $ null l then hGetPacket h (buf ++ [l]) else return buf

waitPacket :: String -> StateT SState IO Bool
waitPacket s = do
    p <- readPacket
    return $ head p == s

sendPacket :: [String] -> StateT SState IO ()
sendPacket s = do
    h <- get
    io $ do
        mapM_ (hPutStrLn h) s
        hPutStrLn h ""
        hFlush h

emulateSession :: StateT SState IO ()
emulateSession = do
    n <- io $ randomRIO (100000::Int, 100100)
    waitPacket "CONNECTED"
    sendPacket ["NICK", "test" ++ show n]
    waitPacket "NICK"
    sendPacket ["PROTO", "31"]
    waitPacket "PROTO"
    b <- waitPacket "LOBBY:JOINED"
    --io $ print b
    sendPacket ["QUIT", "BYE"]
    return ()

testing = Control.OldException.handle print $ do
    putStr "+"
    sock <- connectTo "127.0.0.1" (PortNumber 46631)
    evalStateT emulateSession sock
    --hClose sock
    putStr "-"
    hFlush stdout

forks = forever $ do
    delay <- randomRIO (0::Int, 80000)
    threadDelay delay
    forkIO testing

main = withSocketsDo $ do
#if !defined(mingw32_HOST_OS)
    installHandler sigPIPE Ignore Nothing;
#endif
    forks