Remove hn1 and related code
[ganeti-local] / hscan.hs
index 2289987..6a30fec 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,65 +93,58 @@ options =
       "show help"
     ]
 
       "show help"
     ]
 
+-- | Serialize a single node
+serializeNode :: String -> Node.Node -> String
+serializeNode csf node =
+    printf "%s|%.0f|%d|%d|%.0f|%d|%.0f|%c" (Node.name node ++ csf)
+               (Node.t_mem node) (Node.n_mem node) (Node.f_mem node)
+               (Node.t_dsk node) (Node.f_dsk node) (Node.t_cpu 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|%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')
-                 )
-                 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) ++ csf
+        sidx = Instance.snode inst
+        snode = (if sidx == Node.noSecondary
+                    then ""
+                    else (Container.nameOf nl sidx) ++ csf)
+    in
+      printf "%s|%d|%d|%d|%s|%s|%s"
+             iname (Instance.mem inst) (Instance.dsk inst)
+             (Instance.vcpus 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
 
 
@@ -140,11 +158,7 @@ main :: IO ()
 main = do
   cmd_args <- System.getArgs
   (opts, clusters) <- CLI.parseOpts cmd_args "hscan" options
 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
@@ -154,29 +168,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
-              (case node_data of
-                 Bad err -> putStrLn err
-                 Ok ndata ->
-                     case inst_data of
-                       Bad err -> putStrLn err
-                       Ok idata ->
-                           do
-                             let  (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 </> (fixSlash 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