4905
+ − 1
{-# LANGUAGE CPP #-}
+ − 2
+ − 3
module Main where
+ − 4
+ − 5
import System.IO
4932
+ − 6
import System.IO.Error
4905
+ − 7
import Control.Concurrent
+ − 8
import Network
+ − 9
import Control.OldException
+ − 10
import Control.Monad
+ − 11
import System.Random
+ − 12
import Control.Monad.State
+ − 13
import Data.List
+ − 14
+ − 15
#if !defined(mingw32_HOST_OS)
+ − 16
import System.Posix
+ − 17
#endif
+ − 18
+ − 19
type SState = Handle
+ − 20
io = liftIO
+ − 21
+ − 22
readPacket :: StateT SState IO [String]
+ − 23
readPacket = do
+ − 24
h <- get
4932
+ − 25
io $ hGetPacket h []
4905
+ − 26
where
+ − 27
hGetPacket h buf = do
+ − 28
l <- hGetLine h
4932
+ − 29
if not $ null l then hGetPacket h (buf ++ [l]) else return buf
4905
+ − 30
+ − 31
waitPacket :: String -> StateT SState IO Bool
+ − 32
waitPacket s = do
+ − 33
p <- readPacket
+ − 34
return $ head p == s
+ − 35
+ − 36
sendPacket :: [String] -> StateT SState IO ()
+ − 37
sendPacket s = do
+ − 38
h <- get
+ − 39
io $ do
+ − 40
mapM_ (hPutStrLn h) s
+ − 41
hPutStrLn h ""
+ − 42
hFlush h
+ − 43
+ − 44
emulateSession :: StateT SState IO ()
+ − 45
emulateSession = do
+ − 46
n <- io $ randomRIO (100000::Int, 100100)
+ − 47
waitPacket "CONNECTED"
4932
+ − 48
sendPacket ["NICK", "test" ++ show n]
4905
+ − 49
waitPacket "NICK"
7751
+ − 50
sendPacket ["PROTO", "41"]
4905
+ − 51
waitPacket "PROTO"
+ − 52
b <- waitPacket "LOBBY:JOINED"
+ − 53
--io $ print b
+ − 54
sendPacket ["QUIT", "BYE"]
+ − 55
return ()
+ − 56
+ − 57
testing = Control.OldException.handle print $ do
+ − 58
putStr "+"
+ − 59
sock <- connectTo "127.0.0.1" (PortNumber 46631)
+ − 60
evalStateT emulateSession sock
+ − 61
--hClose sock
+ − 62
putStr "-"
+ − 63
hFlush stdout
+ − 64
5058
+ − 65
forks = forever $ do
+ − 66
delay <- randomRIO (0::Int, 80000)
4905
+ − 67
threadDelay delay
+ − 68
forkIO testing
+ − 69
+ − 70
main = withSocketsDo $ do
+ − 71
#if !defined(mingw32_HOST_OS)
+ − 72
installHandler sigPIPE Ignore Nothing;
+ − 73
#endif
+ − 74
forks