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" name
  83                                    t_mem (Node.n_mem node) (Node.f_mem node)
  84                                    t_dsk (Node.f_dsk node))
  85                  nodes
  86     in unlines nlines
  87
  88 -- | Generate instance file data from instance objects
  89 serializeInstances :: Cluster.InstanceList -> String
  90                    -> Cluster.NameList -> Cluster.NameList -> String
  91 serializeInstances il csf ktn kti =
  92     let etn = map (\(idx, name) -> (idx, name ++ csf)) ktn
  93         eti = map (\(idx, name) -> (idx, name ++ csf)) kti
  94         instances = Container.elems il
  95         nlines = map
  96                  (\inst ->
  97                       let
  98                           iname = fromJust $ lookup (Instance.idx inst) eti
  99                           pnode = fromJust $ lookup (Instance.pnode inst) etn
 100                           snode = fromJust $ lookup (Instance.snode inst) etn
 101                       in
 102                         printf "%s|%d|%d|%s|%s|%s"
 103                                iname (Instance.mem inst) (Instance.dsk inst)
 104                                (Instance.run_st inst)
 105                                pnode snode
 106                  )
 107                  instances
 108     in unlines nlines
 109
 110 -- | Return a one-line summary of cluster state
 111 printCluster :: Cluster.NodeList -> Cluster.InstanceList
 112              -> Cluster.NameList -> Cluster.NameList
 113              -> String
 114 printCluster nl il ktn kti =
 115     let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
 116         ccv = Cluster.compCV nl
 117         nodes = Container.elems nl
 118         t_ram = truncate . sum . map Node.t_mem $ nodes
 119         t_dsk = truncate . sum . map Node.t_dsk $ nodes
 120         f_ram = sum . map Node.f_mem $ nodes
 121         f_dsk = sum . map Node.f_dsk $ nodes
 122     in
 123       printf "%5d %5d %5d %5d %6d %6d %6d %6d %.8f"
 124                  (length ktn) (length kti)
 125                  (length bad_nodes) (length bad_instances)
 126                  (t_ram::Integer) f_ram
 127                  ((t_dsk::Integer) `div` 1024) (f_dsk `div` 1024)
 128                  ccv
 129
 130
 131 -- | Main function.
 132 main :: IO ()
 133 main = do
 134   cmd_args <- System.getArgs
 135   (opts, clusters) <- CLI.parseOpts cmd_args "hscan" options
 136                       defaultOptions optShowHelp
 137
 138   when (optShowVer opts) $ do
 139          putStr $ CLI.showVersion "hscan"
 140          exitWith ExitSuccess
 141
 142   let odir = optOutPath opts
 143       nlen = maximum . map length $ clusters
 144
 145   unless (optNoHeader opts) $
 146          printf "%-*s %5s %5s %5s %5s %6s %6s %6s %6s %10s\n" nlen
 147                 "Name" "Nodes" "Inst" "BNode" "BInst" "t_mem" "f_mem"
 148                 "t_disk" "f_disk" "Score"
 149
 150   mapM (\ name ->
 151             do
 152               printf "%-*s " nlen name
 153               hFlush stdout
 154               node_data <- getNodes name
 155               inst_data <- getInstances name
 156               (if isLeft(node_data)
 157                then putStrLn $ fromLeft node_data
 158                else if isLeft(inst_data)
 159                     then putStrLn $ fromLeft inst_data
 160                     else do
 161                       let ndata = fromRight node_data
 162                           idata = fromRight inst_data
 163                           (nl, il, csf, ktn, kti) =
 164                               Cluster.loadData ndata idata
 165                           (_, fix_nl) = Cluster.checkData nl il ktn kti
 166                       putStrLn $ printCluster fix_nl il ktn kti
 167                       when (optShowNodes opts) $ do
 168                            putStr $ Cluster.printNodes ktn fix_nl
 169                       let ndata = serializeNodes nl csf ktn
 170                           idata = serializeInstances il csf ktn kti
 171                           oname = odir </> name
 172                       writeFile (oname <.> "nodes") ndata
 173                       writeFile (oname <.> "instances") idata)
 174        ) clusters
 175   exitWith ExitSuccess