code.grnet.gr Git - ganeti-local/blob - src/rpc-test.hs

   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               | 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.
 180 main :: IO ()
 181 main = do
 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"
 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
 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 ()