Statistics
| Branch: | Tag: | Revision:

root / src / rpc-test.hs @ a895fa19

History | View | Annotate | Download (8.3 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
              | 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 ()