root / src / rpc-test.hs @ 83a451f5
History | View | Annotate | Download (8.6 kB)
1 |
{-# LANGUAGE BangPatterns #-} |
---|---|
2 |
|
3 |
{-| RPC test program. |
4 |
|
5 |
-} |
6 |
|
7 |
{- |
8 |
|
9 |
Copyright (C) 2011, 2012, 2013 Google Inc. |
10 |
|
11 |
This program is free software; you can redistribute it and/or modify |
12 |
it under the terms of the GNU General Public License as published by |
13 |
the Free Software Foundation; either version 2 of the License, or |
14 |
(at your option) any later version. |
15 |
|
16 |
This program is distributed in the hope that it will be useful, but |
17 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
18 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
19 |
General Public License for more details. |
20 |
|
21 |
You should have received a copy of the GNU General Public License |
22 |
along with this program; if not, write to the Free Software |
23 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
24 |
02110-1301, USA. |
25 |
|
26 |
-} |
27 |
|
28 |
import Control.Concurrent |
29 |
import Control.Monad |
30 |
import System.Console.GetOpt |
31 |
import System.Environment |
32 |
import System.IO |
33 |
import Text.JSON (decode) |
34 |
import Text.Printf |
35 |
|
36 |
import Ganeti.BasicTypes |
37 |
import Ganeti.Common |
38 |
import Ganeti.Config |
39 |
import Ganeti.Errors |
40 |
import Ganeti.JSON |
41 |
import Ganeti.Objects |
42 |
import qualified Ganeti.Path as P |
43 |
import Ganeti.Rpc |
44 |
import Ganeti.Utils |
45 |
|
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 |
| KRInstanceConsoleInfo RpcCallInstanceConsoleInfo |
86 |
| KRInstanceList RpcCallInstanceList |
87 |
| KRNodeInfo RpcCallNodeInfo |
88 |
| KRVersion RpcCallVersion |
89 |
| KRStorageList RpcCallStorageList |
90 |
| KRTestDelay RpcCallTestDelay |
91 |
| KRExportList RpcCallExportList |
92 |
deriving (Show) |
93 |
|
94 |
-- | The command line options. |
95 |
options :: [GenericOptType Options] |
96 |
options = |
97 |
[ (Option "r" ["rpc"] |
98 |
(ReqArg (\ r o -> Ok o { optRpc = r }) "RPC") |
99 |
"the rpc to use [version]", |
100 |
OptComplChoices []) |
101 |
, (Option "f" ["data-file"] |
102 |
(ReqArg (\ f o -> Ok o { optDataFile = f }) "FILE") |
103 |
"the rpc serialised form [\"rpc.json\"]", |
104 |
OptComplFile) |
105 |
, (Option "v" ["verbose"] |
106 |
(NoArg (\ opts -> Ok opts { optVerbose = True})) |
107 |
"show more information when executing RPCs", |
108 |
OptComplNone) |
109 |
, (Option "t" ["stats"] |
110 |
(NoArg (\ opts -> Ok opts { optStats = True})) |
111 |
"show timing information summary", |
112 |
OptComplNone) |
113 |
, (Option "c" ["count"] |
114 |
(reqWithConversion (tryRead "reading count") |
115 |
(\count opts -> Ok opts { optCount = count }) "NUMBER") |
116 |
"Count of (multi) RPCs to execute [1]", |
117 |
OptComplInteger) |
118 |
, (Option "b" ["batch"] |
119 |
(reqWithConversion (tryRead "reading batch size") |
120 |
(\batch opts -> Ok opts { optBatch = batch }) "NUMBER") |
121 |
"Parallelisation factor for RPCs [1]", |
122 |
OptComplInteger) |
123 |
, oShowHelp |
124 |
, oShowComp |
125 |
, oShowVer |
126 |
] |
127 |
|
128 |
-- | Arguments we expect |
129 |
arguments :: [ArgCompletion] |
130 |
arguments = [ArgCompletion OptComplOneNode 1 Nothing] |
131 |
|
132 |
-- | Log a message. |
133 |
logMsg :: MVar () -> String -> IO () |
134 |
logMsg outmvar text = |
135 |
withMVar outmvar $ \_ -> do |
136 |
let p = if null text || last text /= '\n' |
137 |
then putStrLn |
138 |
else putStr |
139 |
p text |
140 |
hFlush stdout |
141 |
|
142 |
-- | Parses a RPC. |
143 |
parseRpc :: String -> String -> Result KnownRpc |
144 |
parseRpc "instance_info" f = |
145 |
fromJResult "parsing rpc" (decode f) >>= Ok . KRInstanceInfo |
146 |
parseRpc "all_instances_info" f = |
147 |
fromJResult "parsing rpc" (decode f) >>= Ok . KRAllInstancesInfo |
148 |
parseRpc "console_instance_info" f = |
149 |
fromJResult "parsing rpc" (decode f) >>= Ok . KRConsoleInstanceInfo |
150 |
parseRpc "instance_list" f = |
151 |
fromJResult "parsing rpc" (decode f) >>= Ok . KRInstanceList |
152 |
parseRpc "node_info" f = |
153 |
fromJResult "parsing rpc" (decode f) >>= Ok . KRNodeInfo |
154 |
parseRpc "version" f = |
155 |
fromJResult "parsing rpc" (decode f) >>= Ok . KRVersion |
156 |
parseRpc "storage_list" f = |
157 |
fromJResult "parsing rpc" (decode f) >>= Ok . KRStorageList |
158 |
parseRpc "test_delay" f = |
159 |
fromJResult "parsing rpc" (decode f) >>= Ok . KRTestDelay |
160 |
parseRpc "export_list" f = |
161 |
fromJResult "parsing rpc" (decode f) >>= Ok . KRExportList |
162 |
parseRpc s _ = Bad $ "Unknown rpc '" ++ s ++ "'" |
163 |
|
164 |
-- | Executes a RPC. These duplicate definitions are needed due to the |
165 |
-- polymorphism of 'executeRpcCall', and the binding of the result |
166 |
-- based on the input rpc call. |
167 |
execRpc :: [Node] -> KnownRpc -> IO [[String]] |
168 |
execRpc n (KRInstanceInfo v) = formatRpcRes `fmap` executeRpcCall n v |
169 |
execRpc n (KRAllInstancesInfo v) = formatRpcRes `fmap` executeRpcCall n v |
170 |
execRpc n (KRConsoleInstanceInfo v) = formatRpcRes `fmap` executeRpcCall n v |
171 |
execRpc n (KRInstanceList v) = formatRpcRes `fmap` executeRpcCall n v |
172 |
execRpc n (KRNodeInfo v) = formatRpcRes `fmap` executeRpcCall n v |
173 |
execRpc n (KRVersion v) = formatRpcRes `fmap` executeRpcCall n v |
174 |
execRpc n (KRStorageList v) = formatRpcRes `fmap` executeRpcCall n v |
175 |
execRpc n (KRTestDelay v) = formatRpcRes `fmap` executeRpcCall n v |
176 |
execRpc n (KRExportList v) = formatRpcRes `fmap` executeRpcCall n v |
177 |
|
178 |
-- | Helper to format the RPC result such that it can be printed by |
179 |
-- 'printTable'. |
180 |
formatRpcRes :: (Show b) => [(Node, ERpcError b)] -> [[String]] |
181 |
formatRpcRes = map (\(n, r) -> [nodeName n, either explainRpcError show r]) |
182 |
|
183 |
-- | Main function. |
184 |
main :: IO () |
185 |
main = do |
186 |
cmd_args <- getArgs |
187 |
(opts, args) <- |
188 |
parseOpts defaultOptions cmd_args "rpc-test" options arguments |
189 |
rpc <- parseRpc (optRpc opts) `liftM` readFile (optDataFile opts) >>= |
190 |
exitIfBad "parsing RPC" |
191 |
cfg_file <- P.clusterConfFile |
192 |
cfg <- loadConfig cfg_file>>= exitIfBad "Can't load configuration" |
193 |
nodes <- exitIfBad "Can't find node" . errToResult $ |
194 |
mapM (getNode cfg) args |
195 |
token <- newEmptyMVar -- semaphore for batch calls |
196 |
outmvar <- newMVar () -- token for stdout non-interleaving |
197 |
let logger = if optVerbose opts |
198 |
then logMsg outmvar |
199 |
else const $ return () |
200 |
let batch = [1..optBatch opts] |
201 |
count = optCount opts |
202 |
rpcs = count * length nodes |
203 |
logger $ printf "Will execute %s multi-ops and %s RPCs" |
204 |
(show count) (show rpcs) |
205 |
tstart <- getCurrentTimeUSec |
206 |
_ <- forkIO $ mapM_ (\_ -> putMVar token ()) batch |
207 |
mapM_ (\idx -> do |
208 |
let str_idx = show idx |
209 |
logger $ "Acquiring token for run " ++ str_idx |
210 |
_ <- takeMVar token |
211 |
forkIO $ do |
212 |
start <- getCurrentTimeUSec |
213 |
logger $ "Start run " ++ str_idx |
214 |
!results <- execRpc nodes rpc |
215 |
stop <- getCurrentTimeUSec |
216 |
let delta = (fromIntegral (stop - start)::Double) / 1000 |
217 |
putMVar token () |
218 |
let stats = if optVerbose opts |
219 |
then printf "Done run %d in %7.3fmsec\n" idx delta |
220 |
else "" |
221 |
table = printTable "" ["Node", "Result"] |
222 |
results [False, False] |
223 |
logMsg outmvar $ stats ++ table |
224 |
) [1..count] |
225 |
mapM_ (\_ -> takeMVar token) batch |
226 |
_ <- takeMVar outmvar |
227 |
when (optStats opts) $ do |
228 |
tstop <- getCurrentTimeUSec |
229 |
let delta = (fromIntegral (tstop - tstart) / 1000000)::Double |
230 |
printf "Total runtime: %9.3fs\n" delta :: IO () |
231 |
printf "Total mult-ops: %9d\n" count :: IO () |
232 |
printf "Total single RPCs: %9d\n" rpcs :: IO () |
233 |
printf "Multi-ops/sec: %9.3f\n" (fromIntegral count / delta) :: IO () |
234 |
printf "RPCs/sec: %9.3f\n" (fromIntegral rpcs / delta) :: IO () |