Statistics
| Branch: | Tag: | Revision:

root / src / rpc-test.hs @ b54ecf12

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 ()