Print idx <-> uuid mappings in machine readable mode

[ganeti-local] / htools / Ganeti / HTools / CLI.hs

diff --git a/htools/Ganeti/HTools/CLI.hs b/htools/Ganeti/HTools/CLI.hs
index 4e801fd..a3b9a0c 100644 (file)
--- a/htools/Ganeti/HTools/CLI.hs
+++ b/htools/Ganeti/HTools/CLI.hs
@@ -8,7 +8,7 @@ used in many other places and this is more IO oriented.
 
 {-
 
 
 {-
 

-Copyright (C) 2009, 2010, 2011 Google Inc.
+Copyright (C) 2009, 2010, 2011, 2012 Google Inc.

 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by

@@ -31,22 +31,29 @@ module Ganeti.HTools.CLI
   ( Options(..)
   , OptType
   , parseOpts
   ( Options(..)
   , OptType
   , parseOpts

+  , parseOptsInner
+  , parseYesNo
+  , parseISpecString

   , shTemplate
   , defaultLuxiSocket
   , maybePrintNodes
   , maybePrintInsts
   , maybeShowWarnings
   , shTemplate
   , defaultLuxiSocket
   , maybePrintNodes
   , maybePrintInsts
   , maybeShowWarnings

+  , printKeys
+  , printFinal

   , setNodeStatus
   -- * The options
   , oDataFile
   , oDiskMoves
   , oDiskTemplate
   , setNodeStatus
   -- * The options
   , oDataFile
   , oDiskMoves
   , oDiskTemplate

+  , oSpindleUse

   , oDynuFile
   , oEvacMode
   , oExInst
   , oExTags
   , oExecJobs
   , oGroup
   , oDynuFile
   , oEvacMode
   , oExInst
   , oExTags
   , oExecJobs
   , oGroup

+  , oIAllocSrc

   , oInstMoves
   , oLuxiSocket
   , oMachineReadable
   , oInstMoves
   , oLuxiSocket
   , oMachineReadable

@@ -57,6 +64,7 @@ module Ganeti.HTools.CLI
   , oMinGainLim
   , oMinScore
   , oNoHeaders
   , oMinGainLim
   , oMinScore
   , oNoHeaders

+  , oNoSimulation

   , oNodeSim
   , oOfflineNode
   , oOutputDir
   , oNodeSim
   , oOfflineNode
   , oOutputDir

@@ -71,18 +79,20 @@ module Ganeti.HTools.CLI
   , oShowHelp
   , oShowVer
   , oStdSpec
   , oShowHelp
   , oShowVer
   , oStdSpec

+  , oTestCount

   , oTieredSpec
   , oVerbose
   ) where
 
 import Control.Monad
   , oTieredSpec
   , oVerbose
   ) where
 
 import Control.Monad

+import Data.Char (toUpper)

 import Data.Maybe (fromMaybe)
 import qualified Data.Version
 import System.Console.GetOpt
 import System.IO
 import System.Info
 import System.Exit
 import Data.Maybe (fromMaybe)
 import qualified Data.Version
 import System.Console.GetOpt
 import System.IO
 import System.Info
 import System.Exit

-import Text.Printf (printf, hPrintf)
+import Text.Printf (printf)

 
 import qualified Ganeti.HTools.Version as Version(version)
 import qualified Ganeti.HTools.Container as Container
 
 import qualified Ganeti.HTools.Version as Version(version)
 import qualified Ganeti.HTools.Container as Container

@@ -107,24 +117,27 @@ data Options = Options
   { optDataFile    :: Maybe FilePath -- ^ Path to the cluster data file
   , optDiskMoves   :: Bool           -- ^ Allow disk moves
   , optInstMoves   :: Bool           -- ^ Allow instance moves
   { optDataFile    :: Maybe FilePath -- ^ Path to the cluster data file
   , optDiskMoves   :: Bool           -- ^ Allow disk moves
   , optInstMoves   :: Bool           -- ^ Allow instance moves

-  , optDiskTemplate :: DiskTemplate  -- ^ The requested disk template
+  , optDiskTemplate :: Maybe DiskTemplate  -- ^ Override for the disk template
+  , optSpindleUse  :: Maybe Int      -- ^ Override for the spindle usage

   , optDynuFile    :: Maybe FilePath -- ^ Optional file with dynamic use data
   , optEvacMode    :: Bool           -- ^ Enable evacuation mode
   , optExInst      :: [String]       -- ^ Instances to be excluded
   , optExTags      :: Maybe [String] -- ^ Tags to use for exclusion
   , optExecJobs    :: Bool           -- ^ Execute the commands via Luxi
   , optGroup       :: Maybe GroupID  -- ^ The UUID of the group to process
   , optDynuFile    :: Maybe FilePath -- ^ Optional file with dynamic use data
   , optEvacMode    :: Bool           -- ^ Enable evacuation mode
   , optExInst      :: [String]       -- ^ Instances to be excluded
   , optExTags      :: Maybe [String] -- ^ Tags to use for exclusion
   , optExecJobs    :: Bool           -- ^ Execute the commands via Luxi
   , optGroup       :: Maybe GroupID  -- ^ The UUID of the group to process

+  , optIAllocSrc   :: Maybe FilePath -- ^ The iallocation spec

   , optSelInst     :: [String]       -- ^ Instances to be excluded
   , optLuxi        :: Maybe FilePath -- ^ Collect data from Luxi
   , optMachineReadable :: Bool       -- ^ Output machine-readable format
   , optMaster      :: String         -- ^ Collect data from RAPI
   , optMaxLength   :: Int            -- ^ Stop after this many steps
   , optSelInst     :: [String]       -- ^ Instances to be excluded
   , optLuxi        :: Maybe FilePath -- ^ Collect data from Luxi
   , optMachineReadable :: Bool       -- ^ Output machine-readable format
   , optMaster      :: String         -- ^ Collect data from RAPI
   , optMaxLength   :: Int            -- ^ Stop after this many steps

-  , optMcpu        :: Double         -- ^ Max cpu ratio for nodes
+  , optMcpu        :: Maybe Double   -- ^ Override max cpu ratio for nodes

   , optMdsk        :: Double         -- ^ Max disk usage ratio for nodes
   , optMinGain     :: Score          -- ^ Min gain we aim for in a step
   , optMinGainLim  :: Score          -- ^ Limit below which we apply mingain
   , optMinScore    :: Score          -- ^ The minimum score we aim for
   , optNoHeaders   :: Bool           -- ^ Do not show a header line
   , optMdsk        :: Double         -- ^ Max disk usage ratio for nodes
   , optMinGain     :: Score          -- ^ Min gain we aim for in a step
   , optMinGainLim  :: Score          -- ^ Limit below which we apply mingain
   , optMinScore    :: Score          -- ^ The minimum score we aim for
   , optNoHeaders   :: Bool           -- ^ Do not show a header line

+  , optNoSimulation :: Bool          -- ^ Skip the rebalancing dry-run

   , optNodeSim     :: [String]       -- ^ Cluster simulation mode
   , optOffline     :: [String]       -- ^ Names of offline nodes
   , optOutPath     :: FilePath       -- ^ Path to the output directory
   , optNodeSim     :: [String]       -- ^ Cluster simulation mode
   , optOffline     :: [String]       -- ^ Names of offline nodes
   , optOutPath     :: FilePath       -- ^ Path to the output directory

@@ -135,6 +148,7 @@ data Options = Options
   , optShowNodes   :: Maybe [String] -- ^ Whether to show node status
   , optShowVer     :: Bool           -- ^ Just show the program version
   , optStdSpec     :: Maybe RSpec    -- ^ Requested standard specs
   , optShowNodes   :: Maybe [String] -- ^ Whether to show node status
   , optShowVer     :: Bool           -- ^ Just show the program version
   , optStdSpec     :: Maybe RSpec    -- ^ Requested standard specs

+  , optTestCount   :: Maybe Int      -- ^ Optional test count override

   , optTieredSpec  :: Maybe RSpec    -- ^ Requested specs for tiered mode
   , optReplay      :: Maybe String   -- ^ Unittests: RNG state
   , optVerbose     :: Int            -- ^ Verbosity level
   , optTieredSpec  :: Maybe RSpec    -- ^ Requested specs for tiered mode
   , optReplay      :: Maybe String   -- ^ Unittests: RNG state
   , optVerbose     :: Int            -- ^ Verbosity level

@@ -146,24 +160,27 @@ defaultOptions  = Options
   { optDataFile    = Nothing
   , optDiskMoves   = True
   , optInstMoves   = True
   { optDataFile    = Nothing
   , optDiskMoves   = True
   , optInstMoves   = True

-  , optDiskTemplate = DTDrbd8
+  , optDiskTemplate = Nothing
+  , optSpindleUse  = Nothing

   , optDynuFile    = Nothing
   , optEvacMode    = False
   , optExInst      = []
   , optExTags      = Nothing
   , optExecJobs    = False
   , optGroup       = Nothing
   , optDynuFile    = Nothing
   , optEvacMode    = False
   , optExInst      = []
   , optExTags      = Nothing
   , optExecJobs    = False
   , optGroup       = Nothing

+  , optIAllocSrc   = Nothing

   , optSelInst     = []
   , optLuxi        = Nothing
   , optMachineReadable = False
   , optMaster      = ""
   , optMaxLength   = -1
   , optSelInst     = []
   , optLuxi        = Nothing
   , optMachineReadable = False
   , optMaster      = ""
   , optMaxLength   = -1

-  , optMcpu        = defVcpuRatio
+  , optMcpu        = Nothing

   , optMdsk        = defReservedDiskRatio
   , optMinGain     = 1e-2
   , optMinGainLim  = 1e-1
   , optMinScore    = 1e-9
   , optNoHeaders   = False
   , optMdsk        = defReservedDiskRatio
   , optMinGain     = 1e-2
   , optMinGainLim  = 1e-1
   , optMinScore    = 1e-9
   , optNoHeaders   = False

+  , optNoSimulation = False

   , optNodeSim     = []
   , optOffline     = []
   , optOutPath     = "."
   , optNodeSim     = []
   , optOffline     = []
   , optOutPath     = "."

@@ -174,6 +191,7 @@ defaultOptions  = Options
   , optShowNodes   = Nothing
   , optShowVer     = False
   , optStdSpec     = Nothing
   , optShowNodes   = Nothing
   , optShowVer     = False
   , optStdSpec     = Nothing

+  , optTestCount   = Nothing

   , optTieredSpec  = Nothing
   , optReplay      = Nothing
   , optVerbose     = 1
   , optTieredSpec  = Nothing
   , optReplay      = Nothing
   , optVerbose     = 1

@@ -187,15 +205,17 @@ type OptType = OptDescr (Options -> Result Options)
 parseISpecString :: String -> String -> Result RSpec
 parseISpecString descr inp = do
   let sp = sepSplit ',' inp
 parseISpecString :: String -> String -> Result RSpec
 parseISpecString descr inp = do
   let sp = sepSplit ',' inp

+      err = Bad ("Invalid " ++ descr ++ " specification: '" ++ inp ++
+                 "', expected disk,ram,cpu")
+  when (length sp /= 3) err

   prs <- mapM (\(fn, val) -> fn val) $
   prs <- mapM (\(fn, val) -> fn val) $

-         zip [ annotateResult (descr ++ " specs memory") . parseUnit
-             , annotateResult (descr ++ " specs disk") . parseUnit
+         zip [ annotateResult (descr ++ " specs disk") . parseUnit
+             , annotateResult (descr ++ " specs memory") . parseUnit

              , tryRead (descr ++ " specs cpus")
              ] sp
   case prs of
     [dsk, ram, cpu] -> return $ RSpec cpu ram dsk
              , tryRead (descr ++ " specs cpus")
              ] sp
   case prs of
     [dsk, ram, cpu] -> return $ RSpec cpu ram dsk

-    _ -> Bad $ "Invalid " ++ descr ++ " specification: '" ++ inp ++
-         "', expected disk,ram,cpu"
+    _ -> err

 
 -- * Command line options
 
 
 -- * Command line options
 

@@ -214,8 +234,19 @@ oDiskTemplate :: OptType
 oDiskTemplate = Option "" ["disk-template"]
                 (ReqArg (\ t opts -> do
                            dt <- diskTemplateFromRaw t
 oDiskTemplate = Option "" ["disk-template"]
                 (ReqArg (\ t opts -> do
                            dt <- diskTemplateFromRaw t

-                           return $ opts { optDiskTemplate = dt }) "TEMPLATE")
-                "select the desired disk template"
+                           return $ opts { optDiskTemplate = Just dt })
+                 "TEMPLATE") "select the desired disk template"
+
+oSpindleUse :: OptType
+oSpindleUse = Option "" ["spindle-use"]
+              (ReqArg (\ n opts -> do
+                         su <- tryRead "parsing spindle-use" n
+                         when (su < 0) $
+                              fail "Invalid value of the spindle-use\
+                                   \ (expected >= 0)"
+                         return $ opts { optSpindleUse = Just su })
+               "SPINDLES") "select how many virtual spindle instances use\
+                           \ [default read from cluster]"

 
 oSelInst :: OptType
 oSelInst = Option "" ["select-instances"]
 
 oSelInst :: OptType
 oSelInst = Option "" ["select-instances"]

@@ -261,6 +292,11 @@ oGroup = Option "G" ["group"]
             (ReqArg (\ f o -> Ok o { optGroup = Just f }) "ID")
             "the ID of the group to balance"
 
             (ReqArg (\ f o -> Ok o { optGroup = Just f }) "ID")
             "the ID of the group to balance"
 

+oIAllocSrc :: OptType
+oIAllocSrc = Option "I" ["ialloc-src"]
+             (ReqArg (\ f opts -> Ok opts { optIAllocSrc = Just f }) "FILE")
+             "Specify an iallocator spec as the cluster data source"
+

 oLuxiSocket :: OptType
 oLuxiSocket = Option "L" ["luxi"]
               (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) .
 oLuxiSocket :: OptType
 oLuxiSocket = Option "L" ["luxi"]
               (OptArg ((\ f opts -> Ok opts { optLuxi = Just f }) .

@@ -278,9 +314,14 @@ oMachineReadable = Option "" ["machine-readable"]
 
 oMaxCpu :: OptType
 oMaxCpu = Option "" ["max-cpu"]
 
 oMaxCpu :: OptType
 oMaxCpu = Option "" ["max-cpu"]

-          (ReqArg (\ n opts -> Ok opts { optMcpu = read n }) "RATIO")
-          "maximum virtual-to-physical cpu ratio for nodes (from 1\
-          \ upwards) [64]"
+          (ReqArg (\ n opts -> do
+                     mcpu <- tryRead "parsing max-cpu" n
+                     when (mcpu <= 0) $
+                          fail "Invalid value of the max-cpu ratio,\
+                               \ expected >0"
+                     return $ opts { optMcpu = Just mcpu }) "RATIO")
+          "maximum virtual-to-physical cpu ratio for nodes (from 0\
+          \ upwards) [default read from cluster]"

 
 oMaxSolLength :: OptType
 oMaxSolLength = Option "l" ["max-length"]
 
 oMaxSolLength :: OptType
 oMaxSolLength = Option "l" ["max-length"]

@@ -314,6 +355,11 @@ oNoHeaders = Option "" ["no-headers"]
              (NoArg (\ opts -> Ok opts { optNoHeaders = True }))
              "do not show a header line"
 
              (NoArg (\ opts -> Ok opts { optNoHeaders = True }))
              "do not show a header line"
 

+oNoSimulation :: OptType
+oNoSimulation = Option "" ["no-simulation"]
+                (NoArg (\opts -> Ok opts {optNoSimulation = True}))
+                "do not perform rebalancing simulation"
+

 oNodeSim :: OptType
 oNodeSim = Option "" ["simulate"]
             (ReqArg (\ f o -> Ok o { optNodeSim = f:optNodeSim o }) "SPEC")
 oNodeSim :: OptType
 oNodeSim = Option "" ["simulate"]
             (ReqArg (\ f o -> Ok o { optNodeSim = f:optNodeSim o }) "SPEC")

@@ -387,6 +433,14 @@ oStdSpec = Option "" ["standard-alloc"]
               "STDSPEC")
              "enable standard specs allocation, given as 'disk,ram,cpu'"
 
               "STDSPEC")
              "enable standard specs allocation, given as 'disk,ram,cpu'"
 

+oTestCount :: OptType
+oTestCount = Option "" ["test-count"]
+             (ReqArg (\ inp opts -> do
+                        tcount <- tryRead "parsing test count" inp
+                        return $ opts { optTestCount = Just tcount } )
+              "COUNT")
+             "override the target test count"
+

 oTieredSpec :: OptType
 oTieredSpec = Option "" ["tiered-alloc"]
              (ReqArg (\ inp opts -> do
 oTieredSpec :: OptType
 oTieredSpec = Option "" ["tiered-alloc"]
              (ReqArg (\ inp opts -> do

@@ -408,14 +462,14 @@ oVerbose = Option "v" ["verbose"]
 -- * Functions
 
 -- | Helper for parsing a yes\/no command line flag.
 -- * Functions
 
 -- | Helper for parsing a yes\/no command line flag.

-parseYesNo :: Bool         -- ^ Default whalue (when we get a @Nothing@)
+parseYesNo :: Bool         -- ^ Default value (when we get a @Nothing@)

            -> Maybe String -- ^ Parameter value
            -> Result Bool  -- ^ Resulting boolean value
 parseYesNo v Nothing      = return v
 parseYesNo _ (Just "yes") = return True
 parseYesNo _ (Just "no")  = return False
            -> Maybe String -- ^ Parameter value
            -> Result Bool  -- ^ Resulting boolean value
 parseYesNo v Nothing      = return v
 parseYesNo _ (Just "yes") = return True
 parseYesNo _ (Just "no")  = return False

-parseYesNo _ (Just s)     = fail $ "Invalid choice '" ++ s ++
-                            "', pass one of 'yes' or 'no'"
+parseYesNo _ (Just s)     = fail ("Invalid choice '" ++ s ++
+                                  "', pass one of 'yes' or 'no'")

 
 -- | Usage info.
 usageHelp :: String -> [OptType] -> String
 
 -- | Usage info.
 usageHelp :: String -> [OptType] -> String

@@ -423,6 +477,14 @@ usageHelp progname =
   usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
              progname Version.version progname)
 
   usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
              progname Version.version progname)
 

+-- | Show the program version info.
+versionInfo :: String -> String
+versionInfo progname =
+  printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
+         progname Version.version compilerName
+         (Data.Version.showVersion compilerVersion)
+         os arch
+

 -- | Command line parser, using the 'Options' structure.
 parseOpts :: [String]               -- ^ The command line arguments
           -> String                 -- ^ The program name
 -- | Command line parser, using the 'Options' structure.
 parseOpts :: [String]               -- ^ The command line arguments
           -> String                 -- ^ The program name

@@ -430,31 +492,33 @@ parseOpts :: [String]               -- ^ The command line arguments
           -> IO (Options, [String]) -- ^ The resulting options and leftover
                                     -- arguments
 parseOpts argv progname options =
           -> IO (Options, [String]) -- ^ The resulting options and leftover
                                     -- arguments
 parseOpts argv progname options =

+  case parseOptsInner argv progname options of
+    Left (code, msg) -> do
+      hPutStr (if code == 0 then stdout else stderr) msg
+      exitWith (if code == 0 then ExitSuccess else ExitFailure code)
+    Right result ->
+      return result
+
+-- | Inner parse options. The arguments are similar to 'parseOpts',
+-- but it returns either a 'Left' composed of exit code and message,
+-- or a 'Right' for the success case.
+parseOptsInner :: [String] -> String -> [OptType]
+               -> Either (Int, String) (Options, [String])
+parseOptsInner argv progname options =

   case getOpt Permute options argv of
     (o, n, []) ->
   case getOpt Permute options argv of
     (o, n, []) ->

-      do
-        let (pr, args) = (foldM (flip id) defaultOptions o, n)
-        po <- case pr of
-                Bad msg -> do
-                  hPutStrLn stderr "Error while parsing command\
-                                   \line arguments:"
-                  hPutStrLn stderr msg
-                  exitWith $ ExitFailure 1
-                Ok val -> return val
-        when (optShowHelp po) $ do
-          putStr $ usageHelp progname options
-          exitWith ExitSuccess
-        when (optShowVer po) $ do
-          printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
-                 progname Version.version
-                 compilerName (Data.Version.showVersion compilerVersion)
-                 os arch :: IO ()
-          exitWith ExitSuccess
-        return (po, args)
-    (_, _, errs) -> do
-      hPutStrLn stderr $ "Command line error: "  ++ concat errs
-      hPutStrLn stderr $ usageHelp progname options
-      exitWith $ ExitFailure 2
+      let (pr, args) = (foldM (flip id) defaultOptions o, n)
+      in case pr of
+           Bad msg -> Left (1, "Error while parsing command\
+                               \line arguments:\n" ++ msg ++ "\n")
+           Ok po ->
+             select (Right (po, args))
+                 [ (optShowHelp po, Left (0, usageHelp progname options))
+                 , (optShowVer po,  Left (0, versionInfo progname))
+                 ]
+    (_, _, errs) ->
+      Left (2, "Command line error: "  ++ concat errs ++ "\n" ++
+            usageHelp progname options)

 
 -- | A shell script template for autogenerated scripts.
 shTemplate :: String
 
 -- | A shell script template for autogenerated scripts.
 shTemplate :: String

@@ -502,6 +566,31 @@ maybeShowWarnings fix_msgs =
     hPutStrLn stderr "Warning: cluster has inconsistent data:"
     hPutStrLn stderr . unlines . map (printf "  - %s") $ fix_msgs
 
     hPutStrLn stderr "Warning: cluster has inconsistent data:"
     hPutStrLn stderr . unlines . map (printf "  - %s") $ fix_msgs
 

+-- | Format a list of key, value as a shell fragment.
+printKeys :: String              -- ^ Prefix to printed variables
+          -> [(String, String)]  -- ^ List of (key, value) pairs to be printed
+          -> IO ()
+printKeys prefix = mapM_ (\(k, v) ->
+                       printf "%s_%s=%s\n" prefix (map toUpper k) (ensureQuoted v))
+
+-- | Prints the final @OK@ marker in machine readable output.
+printFinal :: String    -- ^ Prefix to printed variable
+           -> Bool      -- ^ Whether output should be machine readable
+                        -- Note: if not, there is nothing to print
+           -> IO ()
+printFinal prefix True =
+  -- this should be the final entry
+  printKeys prefix [("OK", "1")]
+
+printFinal _ False = return ()
+
+-- | Potentially set the node as offline based on passed offline list.
+setNodeOffline :: [Ndx] -> Node.Node -> Node.Node
+setNodeOffline offline_indices n =
+  if Node.idx n `elem` offline_indices
+    then Node.setOffline n True
+    else n
+

 -- | Set node properties based on command line options.
 setNodeStatus :: Options -> Node.List -> IO Node.List
 setNodeStatus opts fixed_nl = do
 -- | Set node properties based on command line options.
 setNodeStatus :: Options -> Node.List -> IO Node.List
 setNodeStatus opts fixed_nl = do

@@ -517,13 +606,12 @@ setNodeStatus opts fixed_nl = do
       m_dsk = optMdsk opts
 
   unless (null offline_wrong) $ do
       m_dsk = optMdsk opts
 
   unless (null offline_wrong) $ do

-         hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n"
-                     (commaJoin (map lrContent offline_wrong)) :: IO ()
-         exitWith $ ExitFailure 1
-
-  let nm = Container.map (\n -> if Node.idx n `elem` offline_indices
-                                then Node.setOffline n True
-                                else n) fixed_nl
-      nlf = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
-            nm
-  return nlf
+         exitErr $ printf "wrong node name(s) set as offline: %s\n"
+                   (commaJoin (map lrContent offline_wrong))
+  let setMCpuFn = case m_cpu of
+                    Nothing -> id
+                    Just new_mcpu -> flip Node.setMcpu new_mcpu
+  let nm = Container.map (setNodeOffline offline_indices .
+                          flip Node.setMdsk m_dsk .
+                          setMCpuFn) fixed_nl
+  return nm