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