1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
import qualified Spread.Client as SC
import qualified Data.ByteString.Char8 as B
import qualified Control.Concurrent.Chan.Closeable as C
import System.Environment (getArgs)
import Control.Monad
import Data.Maybe
import Text.Regex.Base
import Text.Regex.Posix
import Network
import Data.List
makeConf p n u = (SC.Conf n p (SC.mkPrivateName $ B.pack u) True True [])
argVal o args =
case args of
[] -> Nothing
a:v:tl -> if o == a then Just v else argVal o (v:tl)
_:tl -> argVal o tl
argExists o args = any (\i -> i == o) args
withReplyGroup f verbose g (m,c) = do
f g c
msg <- C.readChan m
when verbose (putStrLn $ show msg)
withReply f verbose (m,c) = do
f c
msg <- C.readChan m
when verbose (putStrLn $ show msg)
waitForMsg verbose (m,c) = do
msg <- C.readChan m
when verbose (putStrLn $ show msg)
sendRecvNoDiscard verbose repjl g (m,c) msg wo ro = do
when repjl (withReplyGroup SC.join verbose g (m,c))
when wo (SC.send msg c)
unless wo (do
--putStrLn "not writeOnly"
--when ro (putStrLn "waitForMsg")
when ro (waitForMsg verbose (m,c))
--unless ro (putStrLn "withReply")
unless ro (withReply (SC.send msg) verbose (m,c)))
when repjl (withReplyGroup SC.leave verbose g (m,c))
parseSpreadName s =
case s of
Nothing -> (Nothing,Nothing)
Just a ->
let p = Just (fromIntegral (read (a =~ "^[0-9]+" :: String) :: Int) :: PortNumber)
h = Just (drop 1 (a =~ "@[a-zA-Z0-9\\.]+" :: String))
in
(p,h)
main = do
args <- getArgs
if (argExists "-h" args) || (argExists "--help" args) || (argExists "-help" args)
then putStrLn usage
else do
let (port,host) = parseSpreadName $ argVal "-s" args;
conf = makeConf port host $ fromMaybe "user" (argVal "-u" args);
reps = read $ fromMaybe "10000" (argVal "-m" args);
gname = fromMaybe "flooder" (argVal "-g" args);
mbytes = read $ fromMaybe "1000" (argVal "-b" args);
sendRecvMode = fromMaybe "sendRecvNoDiscard" (argVal "-s" args);
checkMsg = argExists "-check" args;
verbose = argExists "-v" args;
repjl = argExists "-repjl" args;
writeOnly = argExists "-wo" args;
readOnly = argExists "-ro" args;
msgData = B.pack (replicate mbytes 't');
g = (fromJust (SC.makeGroup gname));
msg = SC.Outgoing SC.Reliable writeOnly msgData [g] 1;
f = case sendRecvMode of
"sendRecvNoDiscard" -> sendRecvNoDiscard
_ -> sendRecvNoDiscard
(m,c) <- SC.connect conf
putStrLn ("Starting test loop with count " ++ (show reps))
SC.startReceive c
when (not repjl) $ withReplyGroup SC.join verbose g (m,c)
replicateM_ reps $ f verbose repjl g (m,c) msg writeOnly readOnly
when (not repjl) $ withReplyGroup SC.leave verbose g (m,c)
putStrLn "Finished test loop"
SC.stopReceive c
putStrLn "stopped receiving"
SC.disconnect c
putStrLn "Disconnected"
usage = concat . intersperse "\n" $
["hspflooder usage:"
,"hspflooder <options>"
,"\t[-s spreadname]\t\tport or port@machine, if unspecified, defaults to \"4803@localhost\""
,"\t[-u username]\t\tif unspecified, defaults to \"user\""
,"\t[-m msgcount]\t\tnumber of messages to send -> if unspecified, defaults to 10000"
,"\t[-g groupname]\t\tname of group to send msgs to -> if unspecified, defaults to \"flooder\""
,"\t[-b msgbytes]\t\tbyte size of messages to send -> if unspecified, defaults to \"1000\""
,"\t[-v]\t\tverbose output"
,"\t[-repjl]\t\tjoin before every message,leave after each message"
,"\t[-wo]\t\twrite non-group messages with selfDiscard == true, "
,"\t[-ro]\t\tonly receive messages, ignored if -wo is specified"
,"\t[-check]\t\t(Currently ignored) check input match output, ignored if -wo or -ro is specified"
]
|
