code.grnet.gr Git - ganeti-local/blob - hscan.hs

   1 {-| Scan clusters via RAPI and write instance/node data files.
   2
   3 -}
   4
   5 module Main (main) where
   6
   7 import Data.List
   8 import Data.Function
   9 import Data.Maybe(fromJust)
  10 import Monad
  11 import System
  12 import System.IO
  13 import System.FilePath
  14 import System.Console.GetOpt
  15 import qualified System
  16
  17 import Text.Printf (printf)
  18
  19 import qualified Ganeti.HTools.Container as Container
  20 import qualified Ganeti.HTools.Cluster as Cluster
  21 import qualified Ganeti.HTools.Version as Version
  22 import qualified Ganeti.HTools.Node as Node
  23 import qualified Ganeti.HTools.Instance as Instance
  24 import Ganeti.HTools.Rapi
  25 import Ganeti.HTools.Utils
  26
  27 -- | Command line options structure.
  28 data Options = Options
  29     { optShowNodes :: Bool     -- ^ Whether to show node status
  30     , optOutPath   :: FilePath -- ^ Path to the output directory
  31     , optVerbose   :: Int      -- ^ Verbosity level
  32     , optShowVer   :: Bool     -- ^ Just show the program version
  33     , optNoHeader  :: Bool     -- ^ Do not show a header line
  34     } deriving Show
  35
  36 -- | Default values for the command line options.
  37 defaultOptions :: Options
  38 defaultOptions  = Options
  39  { optShowNodes = False
  40  , optOutPath   = "."
  41  , optVerbose   = 0
  42  , optShowVer   = False
  43  , optNoHeader  = False
  44  }
  45
  46 -- | Options list and functions
  47 options :: [OptDescr (Options -> Options)]
  48 options =
  49     [ Option ['p']     ["print-nodes"]
  50       (NoArg (\ opts -> opts { optShowNodes = True }))
  51       "print the final node list"
  52     , Option ['d']     ["output-dir"]
  53       (ReqArg (\ d opts -> opts { optOutPath = d }) "PATH")
  54       "directory in which to write output files"
  55     , Option ['v']     ["verbose"]
  56       (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) + 1 }))
  57       "increase the verbosity level"
  58     , Option ['V']     ["version"]
  59       (NoArg (\ opts -> opts { optShowVer = True}))
  60       "show the version of the program"
  61     , Option []        ["no-headers"]
  62       (NoArg (\ opts -> opts { optNoHeader = True }))
  63       "do not show a header line"
  64     ]
  65
  66 -- | Command line parser, using the 'options' structure.
  67 parseOpts :: [String] -> IO (Options, [String])
  68 parseOpts argv =
  69     case getOpt Permute options argv of
  70       (o, n, []) ->
  71           return (foldl (flip id) defaultOptions o, n)
  72       (_, _, errs) ->
  73           ioError (userError (concat errs ++ usageInfo header options))
  74       where header = printf "hscan %s\nUsage: hscan [OPTION...] cluster..."
  75                      Version.version
  76
  77 -- | Generate node file data from node objects
  78 serializeNodes :: Cluster.NodeList -> String -> Cluster.NameList -> String
  79 serializeNodes nl csf ktn =
  80     let etn = map (\(idx, name) -> (idx, name ++ csf)) ktn
  81         nodes = Container.elems nl
  82         nlines = map
  83                  (\node ->
  84                       let name = (fromJust $ lookup (Node.idx node) etn)
  85                           t_mem = (truncate $ Node.t_mem node)::Integer
  86                           t_dsk = (truncate $ Node.t_dsk node)::Integer
  87                       in
  88                         printf "%s|%d|%d|%d|%d" name
  89                                    t_mem (Node.f_mem node)
  90                                    t_dsk (Node.f_dsk node))
  91                  nodes
  92     in unlines nlines
  93
  94 -- | Generate instance file data from instance objects
  95 serializeInstances :: Cluster.InstanceList -> String
  96                    -> Cluster.NameList -> Cluster.NameList -> String
  97 serializeInstances il csf ktn kti =
  98     let etn = map (\(idx, name) -> (idx, name ++ csf)) ktn
  99         eti = map (\(idx, name) -> (idx, name ++ csf)) kti
 100         instances = Container.elems il
 101         nlines = map
 102                  (\inst ->
 103                       let
 104                           iname = fromJust $ lookup (Instance.idx inst) eti
 105                           pnode = fromJust $ lookup (Instance.pnode inst) etn
 106                           snode = fromJust $ lookup (Instance.snode inst) etn
 107                       in
 108                         printf "%s|%d|%d|%s|%s"
 109                                iname (Instance.mem inst) (Instance.dsk inst)
 110                                pnode snode
 111                  )
 112                  instances
 113     in unlines nlines
 114
 115 -- | Return a one-line summary of cluster state
 116 printCluster :: Cluster.NodeList -> Cluster.InstanceList
 117              -> Cluster.NameList -> Cluster.NameList
 118              -> String
 119 printCluster nl il ktn kti =
 120     let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
 121         ccv = Cluster.compCV nl
 122         nodes = Container.elems nl
 123         t_ram = truncate . sum . map Node.t_mem $ nodes
 124         t_dsk = truncate . sum . map Node.t_dsk $ nodes
 125         f_ram = sum . map Node.f_mem $ nodes
 126         f_dsk = sum . map Node.f_dsk $ nodes
 127     in
 128       printf "%5d %5d %5d %5d %6d %6d %6d %6d %.8f"
 129                  (length ktn) (length kti)
 130                  (length bad_nodes) (length bad_instances)
 131                  (t_ram::Integer) f_ram
 132                  ((t_dsk::Integer) `div` 1024) (f_dsk `div` 1024)
 133                  ccv
 134
 135
 136 -- | Main function.
 137 main :: IO ()
 138 main = do
 139   cmd_args <- System.getArgs
 140   (opts, clusters) <- parseOpts cmd_args
 141
 142   when (optShowVer opts) $ do
 143          putStr $ showVersion "hscan"
 144          exitWith ExitSuccess
 145
 146   let odir = optOutPath opts
 147       nlen = maximum . map length $ clusters
 148
 149   unless (optNoHeader opts) $
 150          printf "%-*s %5s %5s %5s %5s %6s %6s %6s %6s %10s\n" nlen
 151                 "Name" "Nodes" "Inst" "BNode" "BInst" "t_mem" "f_mem"
 152                 "t_disk" "f_disk" "Score"
 153
 154   mapM (\ name ->
 155             do
 156               printf "%-*s " nlen name
 157               hFlush stdout
 158               node_data <- getNodes name
 159               inst_data <- getInstances name
 160               (if isLeft(node_data)
 161                then putStrLn $ fromLeft node_data
 162                else if isLeft(inst_data)
 163                     then putStrLn $ fromLeft inst_data
 164                     else do
 165                       let ndata = fromRight node_data
 166                           idata = fromRight inst_data
 167                           (nl, il, csf, ktn, kti) =
 168                               Cluster.loadData ndata idata
 169                       putStrLn $ printCluster nl il ktn kti
 170                       when (optShowNodes opts) $
 171                            putStr $ Cluster.printNodes ktn nl
 172                       let ndata = serializeNodes nl csf ktn
 173                           idata = serializeInstances il csf ktn kti
 174                           oname = odir </> name
 175                       writeFile (oname <.> "nodes") ndata
 176                       writeFile (oname <.> "instances") idata)
 177        ) clusters
 178   exitWith ExitSuccess