Statistics
| Branch: | Tag: | Revision:

root / src / rpc-test.hs @ 4b49a72b

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