4905
|
1 |
{-# LANGUAGE CPP #-}
|
|
2 |
|
|
3 |
module Main where
|
|
4 |
|
|
5 |
import IO
|
|
6 |
import System.IO
|
|
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
|
|
25 |
p <- io $ hGetPacket h []
|
|
26 |
return p
|
|
27 |
where
|
|
28 |
hGetPacket h buf = do
|
|
29 |
l <- hGetLine h
|
|
30 |
if (not $ null l) then hGetPacket h (buf ++ [l]) else return buf
|
|
31 |
|
|
32 |
waitPacket :: String -> StateT SState IO Bool
|
|
33 |
waitPacket s = do
|
|
34 |
p <- readPacket
|
|
35 |
return $ head p == s
|
|
36 |
|
|
37 |
sendPacket :: [String] -> StateT SState IO ()
|
|
38 |
sendPacket s = do
|
|
39 |
h <- get
|
|
40 |
io $ do
|
|
41 |
mapM_ (hPutStrLn h) s
|
|
42 |
hPutStrLn h ""
|
|
43 |
hFlush h
|
|
44 |
|
|
45 |
emulateSession :: StateT SState IO ()
|
|
46 |
emulateSession = do
|
|
47 |
n <- io $ randomRIO (100000::Int, 100100)
|
|
48 |
waitPacket "CONNECTED"
|
|
49 |
sendPacket ["NICK", "test" ++ (show n)]
|
|
50 |
waitPacket "NICK"
|
|
51 |
sendPacket ["PROTO", "31"]
|
|
52 |
waitPacket "PROTO"
|
|
53 |
b <- waitPacket "LOBBY:JOINED"
|
|
54 |
--io $ print b
|
|
55 |
sendPacket ["QUIT", "BYE"]
|
|
56 |
return ()
|
|
57 |
|
|
58 |
testing = Control.OldException.handle print $ do
|
|
59 |
putStr "+"
|
|
60 |
sock <- connectTo "127.0.0.1" (PortNumber 46631)
|
|
61 |
evalStateT emulateSession sock
|
|
62 |
--hClose sock
|
|
63 |
putStr "-"
|
|
64 |
hFlush stdout
|
|
65 |
|
|
66 |
forks = forM_ [1..100] $ const $ do
|
|
67 |
delay <- randomRIO (10000::Int, 30000)
|
|
68 |
threadDelay delay
|
|
69 |
forkIO testing
|
|
70 |
|
|
71 |
main = withSocketsDo $ do
|
|
72 |
#if !defined(mingw32_HOST_OS)
|
|
73 |
installHandler sigPIPE Ignore Nothing;
|
|
74 |
#endif
|
|
75 |
forks
|