Add an utility function for triples

[ganeti-local] / hscan.hs

diff --git a/hscan.hs b/hscan.hs
index 4ce9cc7..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,13 +94,12 @@ 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

@@ -88,18 +112,16 @@ serializeNodes nl csf ktn =
     in unlines nlines
 
 -- | Generate instance file data from instance objects
     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
                         printf "%s|%d|%d|%s|%s|%s"
                                iname (Instance.mem inst) (Instance.dsk inst)
                       in
                         printf "%s|%d|%d|%s|%s|%s"
                                iname (Instance.mem inst) (Instance.dsk inst)

@@ -110,36 +132,37 @@ serializeInstances il csf ktn kti =
     in unlines nlines
 
 -- | Return a one-line summary of cluster state
     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

@@ -149,29 +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
-              (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 </> 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