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