Add an utility function for triples

[ganeti-local] / hscan.hs

diff --git a/hscan.hs b/hscan.hs
index 8a3a64e..2a6981d 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

@@ -69,74 +94,75 @@ options =
     ]
 
 -- | 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
+serializeNodes :: Node.List -> String -> String
+serializeNodes nl csf =
+    let nodes = Container.elems nl

         nlines = map
                  (\node ->
         nlines = map
                  (\node ->

-                      let name = (fromJust $ lookup (Node.idx node) etn)
+                      let name = Node.name node ++ csf

                           t_mem = (truncate $ Node.t_mem node)::Int
                           t_dsk = (truncate $ Node.t_dsk node)::Int
                       in
                           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
+                        printf "%s|%d|%d|%d|%d|%d|%c" name

                                    t_mem (Node.n_mem node) (Node.f_mem node)
                                    t_mem (Node.n_mem node) (Node.f_mem node)

-                                   t_dsk (Node.f_dsk node))
+                                   t_dsk (Node.f_dsk node)
+                                   (if Node.offline node then 'Y' else 'N')
+                 )

                  nodes
     in unlines nlines
 
 -- | Generate instance file data from instance objects
                  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
+serializeInstances :: Node.List -> Instance.List
+                   -> String -> String
+serializeInstances nl il csf =
+    let instances = Container.elems il

         nlines = map
                  (\inst ->
                       let
         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
+                          iname = Instance.name inst ++ csf
+                          pnode = Container.nameOf nl $ Instance.pnode inst
+                          snode = Container.nameOf nl $ Instance.snode inst

                       in
                       in

-                        printf "%s|%d|%d|%s|%s"
+                        printf "%s|%d|%d|%s|%s|%s"

                                iname (Instance.mem inst) (Instance.dsk inst)
                                iname (Instance.mem inst) (Instance.dsk inst)

+                               (Instance.run_st inst)

                                pnode snode
                  )
                  instances
     in unlines nlines
 
 -- | Return a one-line summary of cluster state
                                pnode snode
                  )
                  instances
     in unlines nlines
 
 -- | 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

+        insts = Container.elems il

         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"
         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 nodes) (length insts)

                  (length bad_nodes) (length bad_instances)
                  (t_ram::Integer) f_ram
                  ((t_dsk::Integer) `div` 1024) (f_dsk `div` 1024)
                  ccv
 
 
                  (length bad_nodes) (length bad_instances)
                  (t_ram::Integer) f_ram
                  ((t_dsk::Integer) `div` 1024) (f_dsk `div` 1024)
                  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

@@ -146,28 +172,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
-                      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)
+              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 nl csf
+                       idata = serializeInstances nl il csf
+                       oname = odir </> (fixSlash name)
+                   writeFile (oname <.> "nodes") ndata
+                   writeFile (oname <.> "instances") idata)

        ) clusters
        ) clusters

-  exitWith ExitSuccess