Some documentation updates for the new parameters
[ganeti-local] / hscan.hs
index e9c2981..080d2c4 100644 (file)
--- a/hscan.hs
+++ b/hscan.hs
@@ -2,11 +2,31 @@
 
 -}
 
 
 -}
 
+{-
+
+Copyright (C) 2009 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
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+02110-1301, USA.
+
+-}
+
 module Main (main) where
 
 import Data.List
 import Data.Function
 module Main (main) where
 
 import Data.List
 import Data.Function
-import Data.Maybe(fromJust)
 import Monad
 import System
 import System.IO
 import Monad
 import System
 import System.IO
@@ -21,8 +41,9 @@ import qualified Ganeti.HTools.Cluster as Cluster
 import qualified Ganeti.HTools.Node as Node
 import qualified Ganeti.HTools.Instance as Instance
 import qualified Ganeti.HTools.CLI as CLI
 import qualified Ganeti.HTools.Node as Node
 import qualified Ganeti.HTools.Instance as Instance
 import qualified Ganeti.HTools.CLI as CLI
-import Ganeti.HTools.Rapi
-import Ganeti.HTools.Utils
+import qualified Ganeti.HTools.Rapi as Rapi
+import qualified Ganeti.HTools.Loader as Loader
+import Ganeti.HTools.Types
 
 -- | Command line options structure.
 data Options = Options
 
 -- | Command line options structure.
 data Options = Options
@@ -34,6 +55,10 @@ data Options = Options
     , optShowHelp  :: Bool     -- ^ Just show the help
     } deriving Show
 
     , optShowHelp  :: Bool     -- ^ Just show the help
     } deriving Show
 
+instance CLI.CLIOptions Options where
+    showVersion = optShowVer
+    showHelp    = optShowHelp
+
 -- | Default values for the command line options.
 defaultOptions :: Options
 defaultOptions  = Options
 -- | Default values for the command line options.
 defaultOptions :: Options
 defaultOptions  = Options
@@ -68,76 +93,73 @@ options =
       "show help"
     ]
 
       "show help"
     ]
 
+-- | Serialize a single node
+serializeNode :: String -> Node.Node -> String
+serializeNode csf node =
+    let name = Node.name node ++ csf
+        t_mem = (truncate $ Node.t_mem node)::Int
+        t_dsk = (truncate $ Node.t_dsk node)::Int
+    in
+      printf "%s|%d|%d|%d|%d|%d|%c" name
+             t_mem (Node.n_mem node) (Node.f_mem node)
+             t_dsk (Node.f_dsk node)
+             (if Node.offline node then 'Y' else 'N')
+
 -- | Generate node file data from node objects
 -- | 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)::Int
-                          t_dsk = (truncate $ Node.t_dsk node)::Int
-                      in
-                        printf "%s|%d|%d|%d|%d|%d" name
-                                   t_mem (Node.n_mem node) (Node.f_mem node)
-                                   t_dsk (Node.f_dsk node))
-                 nodes
-    in unlines nlines
+serializeNodes :: String -> Node.List -> String
+serializeNodes csf =
+    unlines . map (serializeNode csf) . Container.elems
+
+-- | Serialize a single instance
+serializeInstance :: String -> Node.List -> Instance.Instance -> String
+serializeInstance csf nl inst =
+    let
+        iname = Instance.name inst ++ csf
+        pnode = Container.nameOf nl $ Instance.pnode inst
+        snode = Container.nameOf nl $ Instance.snode inst
+    in
+      printf "%s|%d|%d|%s|%s|%s"
+             iname (Instance.mem inst) (Instance.dsk inst)
+             (Instance.run_st inst)
+             pnode snode
 
 -- | Generate instance file data from instance objects
 
 -- | 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|%s"
-                               iname (Instance.mem inst) (Instance.dsk inst)
-                               (Instance.run_st inst)
-                               pnode snode
-                 )
-                 instances
-    in unlines nlines
+serializeInstances :: String -> Node.List -> Instance.List -> String
+serializeInstances csf nl =
+    unlines . map (serializeInstance csf nl) . Container.elems
 
 -- | Return a one-line summary of cluster state
 
 -- | Return a one-line summary of cluster state
-printCluster :: Cluster.NodeList -> Cluster.InstanceList
-             -> Cluster.NameList -> Cluster.NameList
+printCluster :: Node.List -> Instance.List
              -> String
              -> String
-printCluster nl il ktn kti =
+printCluster nl il =
     let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
         ccv = Cluster.compCV nl
         nodes = Container.elems nl
     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
+        insts = Container.elems il
+        t_ram = sum . map Node.t_mem $ nodes
+        t_dsk = sum . map Node.t_dsk $ nodes
         f_ram = sum . map Node.f_mem $ nodes
         f_dsk = sum . map Node.f_dsk $ nodes
     in
         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)
+      printf "%5d %5d %5d %5d %6.0f %6d %6.0f %6d %.8f"
+                 (length nodes) (length insts)
                  (length bad_nodes) (length bad_instances)
                  (length bad_nodes) (length bad_instances)
-                 (t_ram::Integer) f_ram
-                 ((t_dsk::Integer) `div` 1024) (f_dsk `div` 1024)
+                 t_ram f_ram
+                 (t_dsk / 1024) (f_dsk `div` 1024)
                  ccv
 
 
                  ccv
 
 
+-- | Replace slashes with underscore for saving to filesystem
+
+fixSlash :: String -> String
+fixSlash = map (\x -> if x == '/' then '_' else x)
+
 -- | Main function.
 main :: IO ()
 main = do
   cmd_args <- System.getArgs
   (opts, clusters) <- CLI.parseOpts cmd_args "hscan" options
 -- | Main function.
 main :: IO ()
 main = do
   cmd_args <- System.getArgs
   (opts, clusters) <- CLI.parseOpts cmd_args "hscan" options
-                      defaultOptions optShowHelp
-
-  when (optShowVer opts) $ do
-         putStr $ CLI.showVersion "hscan"
-         exitWith ExitSuccess
+                      defaultOptions
 
   let odir = optOutPath opts
       nlen = maximum . map length $ clusters
 
   let odir = optOutPath opts
       nlen = maximum . map length $ clusters
@@ -147,29 +169,24 @@ main = do
                 "Name" "Nodes" "Inst" "BNode" "BInst" "t_mem" "f_mem"
                 "t_disk" "f_disk" "Score"
 
                 "Name" "Nodes" "Inst" "BNode" "BInst" "t_mem" "f_mem"
                 "t_disk" "f_disk" "Score"
 
-  mapM (\ name ->
+  mapM_ (\ name ->
             do
               printf "%-*s " nlen name
               hFlush stdout
             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
-                          (_, fix_nl) = Cluster.checkData nl il ktn kti
-                      putStrLn $ printCluster fix_nl il ktn kti
-                      when (optShowNodes opts) $ do
-                           putStr $ Cluster.printNodes ktn fix_nl
-                      let ndata = serializeNodes nl csf ktn
-                          idata = serializeInstances il csf ktn kti
-                          oname = odir </> name
-                      writeFile (oname <.> "nodes") ndata
-                      writeFile (oname <.> "instances") idata)
+              input_data <- Rapi.loadData name
+              let ldresult = input_data >>= Loader.mergeData
+              (case ldresult of
+                 Bad err -> printf "\nError: failed to load data. \
+                                   \Details:\n%s\n" err
+                 Ok x -> do
+                   let (nl, il, csf) = x
+                       (_, fix_nl) = Loader.checkData nl il
+                   putStrLn $ printCluster fix_nl il
+                   when (optShowNodes opts) $ do
+                           putStr $ Cluster.printNodes fix_nl
+                   let ndata = serializeNodes csf nl
+                       idata = serializeInstances csf nl il
+                       oname = odir </> (fixSlash name)
+                   writeFile (oname <.> "nodes") ndata
+                   writeFile (oname <.> "instances") idata)
        ) clusters
        ) clusters
-  exitWith ExitSuccess