Revision b9b4f1bf src/rpc-test.hs
b/src/rpc-test.hs | ||
---|---|---|
1 |
{-# LANGUAGE BangPatterns #-} |
|
2 |
|
|
1 | 3 |
{-| RPC test program. |
2 | 4 |
|
3 | 5 |
-} |
4 | 6 |
|
5 | 7 |
{- |
6 | 8 |
|
7 |
Copyright (C) 2011, 2012 Google Inc. |
|
9 |
Copyright (C) 2011, 2012, 2013 Google Inc.
|
|
8 | 10 |
|
9 | 11 |
This program is free software; you can redistribute it and/or modify |
10 | 12 |
it under the terms of the GNU General Public License as published by |
... | ... | |
23 | 25 |
|
24 | 26 |
-} |
25 | 27 |
|
28 |
import Control.Concurrent |
|
29 |
import Control.Monad |
|
30 |
import System.Console.GetOpt |
|
26 | 31 |
import System.Environment |
32 |
import System.IO |
|
33 |
import Text.JSON (decode) |
|
34 |
import Text.Printf |
|
27 | 35 |
|
28 |
import Ganeti.Errors |
|
36 |
import Ganeti.BasicTypes |
|
37 |
import Ganeti.Common |
|
29 | 38 |
import Ganeti.Config |
39 |
import Ganeti.Errors |
|
40 |
import Ganeti.JSON |
|
30 | 41 |
import Ganeti.Objects |
31 | 42 |
import qualified Ganeti.Path as P |
32 | 43 |
import Ganeti.Rpc |
33 | 44 |
import Ganeti.Utils |
34 | 45 |
|
35 |
-- | Show usage info and exit. |
|
36 |
usage :: IO () |
|
37 |
usage = do |
|
38 |
prog <- getProgName |
|
39 |
exitErr $ "Usage: " ++ prog ++ " delay node..." |
|
40 | 46 |
|
47 |
-- | Command line options structure. |
|
48 |
data Options = Options |
|
49 |
{ optRpc :: String -- ^ RPC to execute |
|
50 |
, optDataFile :: FilePath -- ^ Path to the RPC serialised form |
|
51 |
, optVerbose :: Bool -- ^ Verbosity level |
|
52 |
, optStats :: Bool -- ^ Whether to show timing stats |
|
53 |
, optCount :: Int -- ^ Count of (multi) RPCs to do |
|
54 |
, optBatch :: Int -- ^ How many (multi) RPCs to run in parallel |
|
55 |
, optShowHelp :: Bool -- ^ Just show the help |
|
56 |
, optShowComp :: Bool -- ^ Just show the completion info |
|
57 |
, optShowVer :: Bool -- ^ Just show the program version |
|
58 |
} deriving Show |
|
59 |
|
|
60 |
-- | Default values for the command line options. |
|
61 |
defaultOptions :: Options |
|
62 |
defaultOptions = Options |
|
63 |
{ optRpc = "version" |
|
64 |
, optDataFile = "rpc.json" |
|
65 |
, optVerbose = False |
|
66 |
, optStats = False |
|
67 |
, optCount = 1 |
|
68 |
, optBatch = 1 |
|
69 |
, optShowHelp = False |
|
70 |
, optShowComp = False |
|
71 |
, optShowVer = False |
|
72 |
} |
|
73 |
|
|
74 |
instance StandardOptions Options where |
|
75 |
helpRequested = optShowHelp |
|
76 |
verRequested = optShowVer |
|
77 |
compRequested = optShowComp |
|
78 |
requestHelp o = o { optShowHelp = True } |
|
79 |
requestVer o = o { optShowVer = True } |
|
80 |
requestComp o = o { optShowComp = True } |
|
81 |
|
|
82 |
-- | The rpcs we support. Sadly this duplicates the RPC list. |
|
83 |
data KnownRpc = KRInstanceInfo RpcCallInstanceInfo |
|
84 |
| KRAllInstancesInfo RpcCallAllInstancesInfo |
|
85 |
| KRInstanceList RpcCallInstanceList |
|
86 |
| KRNodeInfo RpcCallNodeInfo |
|
87 |
| KRVersion RpcCallVersion |
|
88 |
| KRStorageList RpcCallStorageList |
|
89 |
| KRTestDelay RpcCallTestDelay |
|
90 |
| KRExportList RpcCallExportList |
|
91 |
deriving (Show) |
|
92 |
|
|
93 |
-- | The command line options. |
|
94 |
options :: [GenericOptType Options] |
|
95 |
options = |
|
96 |
[ (Option "r" ["rpc"] |
|
97 |
(ReqArg (\ r o -> Ok o { optRpc = r }) "RPC") |
|
98 |
"the rpc to use [version]", |
|
99 |
OptComplChoices []) |
|
100 |
, (Option "f" ["data-file"] |
|
101 |
(ReqArg (\ f o -> Ok o { optDataFile = f }) "FILE") |
|
102 |
"the rpc serialised form [\"rpc.json\"]", |
|
103 |
OptComplFile) |
|
104 |
, (Option "v" ["verbose"] |
|
105 |
(NoArg (\ opts -> Ok opts { optVerbose = True})) |
|
106 |
"show more information when executing RPCs", |
|
107 |
OptComplNone) |
|
108 |
, (Option "t" ["stats"] |
|
109 |
(NoArg (\ opts -> Ok opts { optStats = True})) |
|
110 |
"show timing information summary", |
|
111 |
OptComplNone) |
|
112 |
, (Option "c" ["count"] |
|
113 |
(reqWithConversion (tryRead "reading count") |
|
114 |
(\count opts -> Ok opts { optCount = count }) "NUMBER") |
|
115 |
"Count of (multi) RPCs to execute [1]", |
|
116 |
OptComplInteger) |
|
117 |
, (Option "b" ["batch"] |
|
118 |
(reqWithConversion (tryRead "reading batch size") |
|
119 |
(\batch opts -> Ok opts { optBatch = batch }) "NUMBER") |
|
120 |
"Parallelisation factor for RPCs [1]", |
|
121 |
OptComplInteger) |
|
122 |
, oShowHelp |
|
123 |
, oShowComp |
|
124 |
, oShowVer |
|
125 |
] |
|
126 |
|
|
127 |
-- | Arguments we expect |
|
128 |
arguments :: [ArgCompletion] |
|
129 |
arguments = [ArgCompletion OptComplOneNode 1 Nothing] |
|
130 |
|
|
131 |
-- | Log a message. |
|
132 |
logMsg :: MVar () -> String -> IO () |
|
133 |
logMsg outmvar text = |
|
134 |
withMVar outmvar $ \_ -> do |
|
135 |
let p = if null text || last text /= '\n' |
|
136 |
then putStrLn |
|
137 |
else putStr |
|
138 |
p text |
|
139 |
hFlush stdout |
|
140 |
|
|
141 |
-- | Parses a RPC. |
|
142 |
parseRpc :: String -> String -> Result KnownRpc |
|
143 |
parseRpc "instance_info" f = |
|
144 |
fromJResult "parsing rpc" (decode f) >>= Ok . KRInstanceInfo |
|
145 |
parseRpc "all_instances_info" f = |
|
146 |
fromJResult "parsing rpc" (decode f) >>= Ok . KRAllInstancesInfo |
|
147 |
parseRpc "instance_list" f = |
|
148 |
fromJResult "parsing rpc" (decode f) >>= Ok . KRInstanceList |
|
149 |
parseRpc "node_info" f = |
|
150 |
fromJResult "parsing rpc" (decode f) >>= Ok . KRNodeInfo |
|
151 |
parseRpc "version" f = |
|
152 |
fromJResult "parsing rpc" (decode f) >>= Ok . KRVersion |
|
153 |
parseRpc "storage_list" f = |
|
154 |
fromJResult "parsing rpc" (decode f) >>= Ok . KRStorageList |
|
155 |
parseRpc "test_delay" f = |
|
156 |
fromJResult "parsing rpc" (decode f) >>= Ok . KRTestDelay |
|
157 |
parseRpc "export_list" f = |
|
158 |
fromJResult "parsing rpc" (decode f) >>= Ok . KRExportList |
|
159 |
parseRpc s _ = Bad $ "Unknown rpc '" ++ s ++ "'" |
|
160 |
|
|
161 |
-- | Executes a RPC. These duplicate definitions are needed due to the |
|
162 |
-- polymorphism of 'executeRpcCall', and the binding of the result |
|
163 |
-- based on the input rpc call. |
|
164 |
execRpc :: [Node] -> KnownRpc -> IO [[String]] |
|
165 |
execRpc n (KRInstanceInfo v) = formatRpcRes `fmap` executeRpcCall n v |
|
166 |
execRpc n (KRAllInstancesInfo v) = formatRpcRes `fmap` executeRpcCall n v |
|
167 |
execRpc n (KRInstanceList v) = formatRpcRes `fmap` executeRpcCall n v |
|
168 |
execRpc n (KRNodeInfo v) = formatRpcRes `fmap` executeRpcCall n v |
|
169 |
execRpc n (KRVersion v) = formatRpcRes `fmap` executeRpcCall n v |
|
170 |
execRpc n (KRStorageList v) = formatRpcRes `fmap` executeRpcCall n v |
|
171 |
execRpc n (KRTestDelay v) = formatRpcRes `fmap` executeRpcCall n v |
|
172 |
execRpc n (KRExportList v) = formatRpcRes `fmap` executeRpcCall n v |
|
173 |
|
|
174 |
-- | Helper to format the RPC result such that it can be printed by |
|
175 |
-- 'printTable'. |
|
176 |
formatRpcRes :: (Show b) => [(Node, ERpcError b)] -> [[String]] |
|
177 |
formatRpcRes = map (\(n, r) -> [nodeName n, either explainRpcError show r]) |
|
178 |
|
|
179 |
-- | Main function. |
|
41 | 180 |
main :: IO () |
42 | 181 |
main = do |
43 |
args <- getArgs |
|
44 |
(delay, nodes) <- case args of
|
|
45 |
[] -> usage >> return ("", []) -- workaround types...
|
|
46 |
_:[] -> usage >> return ("", [])
|
|
47 |
x:xs -> return (x, xs)
|
|
182 |
cmd_args <- getArgs
|
|
183 |
(opts, args) <-
|
|
184 |
parseOpts defaultOptions cmd_args "rpc-test" options arguments
|
|
185 |
rpc <- parseRpc (optRpc opts) `liftM` readFile (optDataFile opts) >>=
|
|
186 |
exitIfBad "parsing RPC"
|
|
48 | 187 |
cfg_file <- P.clusterConfFile |
49 | 188 |
cfg <- loadConfig cfg_file>>= exitIfBad "Can't load configuration" |
50 |
let call = RpcCallTestDelay (read delay) |
|
51 |
nodes' <- exitIfBad "Can't find node" . errToResult $ |
|
52 |
mapM (getNode cfg) nodes |
|
53 |
results <- executeRpcCall nodes' call |
|
54 |
putStr $ printTable "" ["Node", "Result"] |
|
55 |
(map (\(n, r) -> [nodeName n, either explainRpcError show r]) |
|
56 |
results) |
|
57 |
[False, False] |
|
189 |
nodes <- exitIfBad "Can't find node" . errToResult $ |
|
190 |
mapM (getNode cfg) args |
|
191 |
token <- newEmptyMVar -- semaphore for batch calls |
|
192 |
outmvar <- newMVar () -- token for stdout non-interleaving |
|
193 |
let logger = if optVerbose opts |
|
194 |
then logMsg outmvar |
|
195 |
else const $ return () |
|
196 |
let batch = [1..optBatch opts] |
|
197 |
count = optCount opts |
|
198 |
rpcs = count * length nodes |
|
199 |
logger $ printf "Will execute %s multi-ops and %s RPCs" |
|
200 |
(show count) (show rpcs) |
|
201 |
tstart <- getCurrentTimeUSec |
|
202 |
_ <- forkIO $ mapM_ (\_ -> putMVar token ()) batch |
|
203 |
mapM_ (\idx -> do |
|
204 |
let str_idx = show idx |
|
205 |
logger $ "Acquiring token for run " ++ str_idx |
|
206 |
_ <- takeMVar token |
|
207 |
forkIO $ do |
|
208 |
start <- getCurrentTimeUSec |
|
209 |
logger $ "Start run " ++ str_idx |
|
210 |
!results <- execRpc nodes rpc |
|
211 |
stop <- getCurrentTimeUSec |
|
212 |
let delta = (fromIntegral (stop - start)::Double) / 1000 |
|
213 |
putMVar token () |
|
214 |
let stats = if optVerbose opts |
|
215 |
then printf "Done run %d in %7.3fmsec\n" idx delta |
|
216 |
else "" |
|
217 |
table = printTable "" ["Node", "Result"] |
|
218 |
results [False, False] |
|
219 |
logMsg outmvar $ stats ++ table |
|
220 |
) [1..count] |
|
221 |
mapM_ (\_ -> takeMVar token) batch |
|
222 |
_ <- takeMVar outmvar |
|
223 |
when (optStats opts) $ do |
|
224 |
tstop <- getCurrentTimeUSec |
|
225 |
let delta = (fromIntegral (tstop - tstart) / 1000000)::Double |
|
226 |
printf "Total runtime: %9.3fs\n" delta :: IO () |
|
227 |
printf "Total mult-ops: %9d\n" count :: IO () |
|
228 |
printf "Total single RPCs: %9d\n" rpcs :: IO () |
|
229 |
printf "Multi-ops/sec: %9.3f\n" (fromIntegral count / delta) :: IO () |
|
230 |
printf "RPCs/sec: %9.3f\n" (fromIntegral rpcs / delta) :: IO () |
Also available in: Unified diff