1 {-# LANGUAGE BangPatterns #-}
9 Copyright (C) 2011, 2012, 2013 Google Inc.
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.
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.
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
28 import Control.Concurrent
30 import System.Console.GetOpt
31 import System.Environment
33 import Text.JSON (decode)
36 import Ganeti.BasicTypes
42 import qualified Ganeti.Path as P
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
60 -- | Default values for the command line options.
61 defaultOptions :: Options
62 defaultOptions = Options
64 , optDataFile = "rpc.json"
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 }
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
93 -- | The command line options.
94 options :: [GenericOptType Options]
97 (ReqArg (\ r o -> Ok o { optRpc = r }) "RPC")
98 "the rpc to use [version]",
100 , (Option "f" ["data-file"]
101 (ReqArg (\ f o -> Ok o { optDataFile = f }) "FILE")
102 "the rpc serialised form [\"rpc.json\"]",
104 , (Option "v" ["verbose"]
105 (NoArg (\ opts -> Ok opts { optVerbose = True}))
106 "show more information when executing RPCs",
108 , (Option "t" ["stats"]
109 (NoArg (\ opts -> Ok opts { optStats = True}))
110 "show timing information summary",
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]",
117 , (Option "b" ["batch"]
118 (reqWithConversion (tryRead "reading batch size")
119 (\batch opts -> Ok opts { optBatch = batch }) "NUMBER")
120 "Parallelisation factor for RPCs [1]",
127 -- | Arguments we expect
128 arguments :: [ArgCompletion]
129 arguments = [ArgCompletion OptComplOneNode 1 Nothing]
132 logMsg :: MVar () -> String -> IO ()
133 logMsg outmvar text =
134 withMVar outmvar $ \_ -> do
135 let p = if null text || last text /= '\n'
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 ++ "'"
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
174 -- | Helper to format the RPC result such that it can be printed by
176 formatRpcRes :: (Show b) => [(Node, ERpcError b)] -> [[String]]
177 formatRpcRes = map (\(n, r) -> [nodeName n, either explainRpcError show r])
184 parseOpts defaultOptions cmd_args "rpc-test" options arguments
185 rpc <- parseRpc (optRpc opts) `liftM` readFile (optDataFile opts) >>=
186 exitIfBad "parsing RPC"
187 cfg_file <- P.clusterConfFile
188 cfg <- loadConfig cfg_file>>= exitIfBad "Can't load configuration"
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
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
204 let str_idx = show idx
205 logger $ "Acquiring token for run " ++ str_idx
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
214 let stats = if optVerbose opts
215 then printf "Done run %d in %7.3fmsec\n" idx delta
217 table = printTable "" ["Node", "Result"]
218 results [False, False]
219 logMsg outmvar $ stats ++ table
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 ()