Add the hscan tool

This patch adds an hscan tool that loads data from clusters via RAPI and
writes it to files that can be later used offline.

hscan.hs

+{-| Scan clusters via RAPI and write instance/node data files.
+
+-}
+
+module Main (main) where
+
+import Data.List
+import Data.Function
+import Data.Maybe(fromJust)
+import Monad
+import System
+import System.IO
+import System.FilePath
+import System.Console.GetOpt
+import qualified System
+
+import Text.Printf (printf)
+
+import qualified Ganeti.HTools.Container as Container
+import qualified Ganeti.HTools.Cluster as Cluster
+import qualified Ganeti.HTools.Version as Version
+import qualified Ganeti.HTools.Node as Node
+import qualified Ganeti.HTools.Instance as Instance
+import Ganeti.HTools.Rapi
+import Ganeti.HTools.Utils
+
+-- | Command line options structure.
+data Options = Options
+    { optShowNodes :: Bool     -- ^ Whether to show node status
+    , optOutPath   :: FilePath -- ^ Path to the output directory
+    , optVerbose   :: Int      -- ^ Verbosity level
+    , optShowVer   :: Bool     -- ^ Just show the program version
+    , optNoHeader  :: Bool     -- ^ Do not show a header line
+    } deriving Show
+
+-- | Default values for the command line options.
+defaultOptions :: Options
+defaultOptions  = Options
+ { optShowNodes = False
+ , optOutPath   = "."
+ , optVerbose   = 0
+ , optShowVer   = False
+ , optNoHeader  = False
+ }
+
+-- | Options list and functions
+options :: [OptDescr (Options -> Options)]
+options =
+    [ Option ['p']     ["print-nodes"]
+      (NoArg (\ opts -> opts { optShowNodes = True }))
+      "print the final node list"
+    , Option ['d']     ["output-dir"]
+      (ReqArg (\ d opts -> opts { optOutPath = d }) "PATH")
+      "directory in which to write output files"
+    , Option ['v']     ["verbose"]
+      (NoArg (\ opts -> opts { optVerbose = (optVerbose opts) + 1 }))
+      "increase the verbosity level"
+    , Option ['V']     ["version"]
+      (NoArg (\ opts -> opts { optShowVer = True}))
+      "show the version of the program"
+    , Option []        ["no-headers"]
+      (NoArg (\ opts -> opts { optNoHeader = True }))
+      "do not show a header line"
+    ]
+
+-- | Command line parser, using the 'options' structure.
+parseOpts :: [String] -> IO (Options, [String])
+parseOpts argv =
+    case getOpt Permute options argv of
+      (o, n, []) ->
+          return (foldl (flip id) defaultOptions o, n)
+      (_, _, errs) ->
+          ioError (userError (concat errs ++ usageInfo header options))
+      where header = printf "hscan %s\nUsage: hscan [OPTION...] cluster..."
+                     Version.version
+
+-- | Generate node file data from node objects
+serializeNodes :: Cluster.NodeList -> String -> Cluster.NameList -> String
+serializeNodes nl csf ktn =
+    let etn = map (\(idx, name) -> (idx, name ++ csf)) ktn
+        nodes = Container.elems nl
+        nlines = map
+                 (\node ->
+                      let name = (fromJust $ lookup (Node.idx node) etn)
+                          t_mem = (truncate $ Node.t_mem node)::Integer
+                          t_dsk = (truncate $ Node.t_dsk node)::Integer
+                      in
+                        printf "%s|%d|%d|%d|%d" name
+                                   t_mem (Node.f_mem node)
+                                   t_dsk (Node.f_dsk node))
+                 nodes
+    in unlines nlines
+
+-- | Generate instance file data from instance objects
+serializeInstances :: Cluster.InstanceList -> String
+                   -> Cluster.NameList -> Cluster.NameList -> String
+serializeInstances il csf ktn kti =
+    let etn = map (\(idx, name) -> (idx, name ++ csf)) ktn
+        eti = map (\(idx, name) -> (idx, name ++ csf)) kti
+        instances = Container.elems il
+        nlines = map
+                 (\inst ->
+                      let
+                          iname = fromJust $ lookup (Instance.idx inst) eti
+                          pnode = fromJust $ lookup (Instance.pnode inst) etn
+                          snode = fromJust $ lookup (Instance.snode inst) etn
+                      in
+                        printf "%s|%d|%d|%s|%s"
+                               iname (Instance.mem inst) (Instance.dsk inst)
+                               pnode snode
+                 )
+                 instances
+    in unlines nlines
+
+-- | Return a one-line summary of cluster state
+printCluster :: Cluster.NodeList -> Cluster.InstanceList
+             -> Cluster.NameList -> Cluster.NameList
+             -> String
+printCluster nl il ktn kti =
+    let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
+        ccv = Cluster.compCV nl
+        nodes = Container.elems nl
+        t_ram = truncate . sum . map Node.t_mem $ nodes
+        t_dsk = truncate . sum . map Node.t_dsk $ nodes
+        f_ram = sum . map Node.f_mem $ nodes
+        f_dsk = sum . map Node.f_dsk $ nodes
+    in
+      printf "%5d %5d %5d %5d %6d %6d %6d %6d %.8f"
+                 (length ktn) (length kti)
+                 (length bad_nodes) (length bad_instances)
+                 (t_ram::Integer) f_ram
+                 ((t_dsk::Integer) `div` 1024) (f_dsk `div` 1024)
+                 ccv
+
+
+-- | Main function.
+main :: IO ()
+main = do
+  cmd_args <- System.getArgs
+  (opts, clusters) <- parseOpts cmd_args
+
+  when (optShowVer opts) $ do
+         putStr $ showVersion "hscan"
+         exitWith ExitSuccess
+
+  let odir = optOutPath opts
+      nlen = maximum . map length $ clusters
+
+  unless (optNoHeader opts) $
+         printf "%-*s %5s %5s %5s %5s %6s %6s %6s %6s %10s\n" nlen
+                "Name" "Nodes" "Inst" "BNode" "BInst" "t_mem" "f_mem"
+                "t_disk" "f_disk" "Score"
+
+  mapM (\ name ->
+            do
+              printf "%-*s " nlen name
+              hFlush stdout
+              node_data <- getNodes name
+              inst_data <- getInstances name
+              (if isLeft(node_data)
+               then putStrLn $ fromLeft node_data
+               else if isLeft(inst_data)
+                    then putStrLn $ fromLeft inst_data
+                    else do
+                      let ndata = fromRight node_data
+                          idata = fromRight inst_data
+                          (nl, il, csf, ktn, kti) =
+                              Cluster.loadData ndata idata
+                      putStrLn $ printCluster nl il ktn kti
+                      when (optShowNodes opts) $
+                           putStr $ Cluster.printNodes ktn nl
+                      let ndata = serializeNodes nl csf ktn
+                          idata = serializeInstances il csf ktn kti
+                          oname = odir </> name
+                      writeFile (oname <.> "nodes") ndata
+                      writeFile (oname <.> "instances") idata)
+       ) clusters
+  exitWith ExitSuccess