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"
|
|
50 |
sendPacket ["PROTO", "31"]
|
|
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
|