Force UTF-8 locale for pandoc invocation

[ganeti-local] / hscan.hs

diff --git a/hscan.hs b/hscan.hs
index 080d2c4..06def66 100644 (file)
--- a/hscan.hs
+++ b/hscan.hs
@@ -1,10 +1,12 @@
-{-| Scan clusters via RAPI and write instance/node data files.
+{-# LANGUAGE CPP #-}
+
+{-| Scan clusters via RAPI or LUXI and write state data files.

 
 -}
 
 {-
 
 
 -}
 
 {-
 

-Copyright (C) 2009 Google Inc.
+Copyright (C) 2009, 2010 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
 
 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

@@ -25,13 +27,11 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 
 module Main (main) where
 
 
 module Main (main) where
 

-import Data.List
-import Data.Function
+import Data.Maybe (isJust, fromJust, fromMaybe)

 import Monad
 import Monad

-import System
+import System (exitWith, ExitCode(..))

 import System.IO
 import System.FilePath
 import System.IO
 import System.FilePath

-import System.Console.GetOpt

 import qualified System
 
 import Text.Printf (printf)
 import qualified System
 
 import Text.Printf (printf)

@@ -40,94 +40,28 @@ import qualified Ganeti.HTools.Container as Container
 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.Cluster as Cluster
 import qualified Ganeti.HTools.Node as Node
 import qualified Ganeti.HTools.Instance as Instance

-import qualified Ganeti.HTools.CLI as CLI
+#ifndef NO_CURL

 import qualified Ganeti.HTools.Rapi as Rapi
 import qualified Ganeti.HTools.Rapi as Rapi

+#endif
+import qualified Ganeti.HTools.Luxi as Luxi

 import qualified Ganeti.HTools.Loader as Loader
 import qualified Ganeti.HTools.Loader as Loader

-import Ganeti.HTools.Types
+import Ganeti.HTools.Text (serializeCluster)

 
 

--- | 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
-    , optNoHeader  :: Bool     -- ^ Do not show a header line
-    , optShowVer   :: Bool     -- ^ Just show the program version
-    , 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
- { optShowNodes = False
- , optOutPath   = "."
- , optVerbose   = 0
- , optNoHeader  = False
- , optShowVer   = False
- , optShowHelp  = False
- }
+import Ganeti.HTools.CLI
+import Ganeti.HTools.Types

 
 -- | Options list and functions
 
 -- | Options list and functions

-options :: [OptDescr (Options -> Options)]
+options :: [OptType]

 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 []        ["no-headers"]
-      (NoArg (\ opts -> opts { optNoHeader = True }))
-      "do not show a header line"
-    , Option ['V']     ["version"]
-      (NoArg (\ opts -> opts { optShowVer = True}))
-      "show the version of the program"
-    , Option ['h']     ["help"]
-      (NoArg (\ opts -> opts { optShowHelp = True}))
-      "show help"
+    [ oPrintNodes
+    , oOutputDir
+    , oLuxiSocket
+    , oVerbose
+    , oNoHeaders
+    , oShowVer
+    , oShowHelp

     ]
 
     ]
 

--- | 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
-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
-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
 printCluster :: Node.List -> Instance.List
              -> String
 -- | Return a one-line summary of cluster state
 printCluster :: Node.List -> Instance.List
              -> String

@@ -136,10 +70,10 @@ printCluster nl il =
         ccv = Cluster.compCV nl
         nodes = Container.elems nl
         insts = Container.elems il
         ccv = Cluster.compCV nl
         nodes = Container.elems nl
         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
+        t_ram = sum . map Node.tMem $ nodes
+        t_dsk = sum . map Node.tDsk $ nodes
+        f_ram = sum . map Node.fMem $ nodes
+        f_dsk = sum . map Node.fDsk $ nodes

     in
       printf "%5d %5d %5d %5d %6.0f %6d %6.0f %6d %.8f"
                  (length nodes) (length insts)
     in
       printf "%5d %5d %5d %5d %6.0f %6d %6.0f %6d %.8f"
                  (length nodes) (length insts)

@@ -150,43 +84,74 @@ printCluster nl il =
 
 
 -- | Replace slashes with underscore for saving to filesystem
 
 
 -- | Replace slashes with underscore for saving to filesystem

-

 fixSlash :: String -> String
 fixSlash = map (\x -> if x == '/' then '_' else x)
 
 fixSlash :: String -> String
 fixSlash = map (\x -> if x == '/' then '_' else x)
 

+
+-- | Generates serialized data from loader input
+processData :: Result (Node.AssocList, Instance.AssocList, [String])
+            -> Result (Node.List, Instance.List, String)
+processData input_data = do
+  (nl, il, _) <- input_data >>= Loader.mergeData [] [] []
+  let (_, fix_nl) = Loader.checkData nl il
+      adata = serializeCluster nl il
+  return (fix_nl, il, adata)
+
+-- | Writes cluster data out
+writeData :: Int
+          -> String
+          -> Options
+          -> Result (Node.List, Instance.List, String)
+          -> IO Bool
+writeData _ name _ (Bad err) =
+  printf "\nError for %s: failed to load data. Details:\n%s\n" name err >>
+  return False
+
+writeData nlen name opts (Ok (nl, il, adata)) = do
+  printf "%-*s " nlen name :: IO ()
+  hFlush stdout
+  let shownodes = optShowNodes opts
+      odir = optOutPath opts
+      oname = odir </> fixSlash name
+  putStrLn $ printCluster nl il
+  hFlush stdout
+  when (isJust shownodes) $
+       putStr $ Cluster.printNodes nl (fromJust shownodes)
+  writeFile (oname <.> "data") adata
+  return True
+

 -- | Main function.
 main :: IO ()
 main = do
   cmd_args <- System.getArgs
 -- | Main function.
 main :: IO ()
 main = do
   cmd_args <- System.getArgs

-  (opts, clusters) <- CLI.parseOpts cmd_args "hscan" options
-                      defaultOptions
+  (opts, clusters) <- parseOpts cmd_args "hscan" options
+  let local = "LOCAL"

 
 

-  let odir = optOutPath opts
-      nlen = maximum . map length $ clusters
+  let nlen = if null clusters
+             then length local
+             else maximum . map length $ clusters

 
 

-  unless (optNoHeader opts) $
+  unless (optNoHeaders 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"
 
          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
-              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
+  when (null clusters) $ do
+         let lsock = fromMaybe defaultLuxiSocket (optLuxi opts)
+         let name = local
+         input_data <- Luxi.loadData lsock
+         result <- writeData nlen name opts (processData input_data)
+         when (not result) $ exitWith $ ExitFailure 2
+
+#ifndef NO_CURL
+  results <- mapM (\ name ->
+                    do
+                      input_data <- Rapi.loadData name
+                      writeData nlen name opts (processData input_data)
+                  ) clusters
+  when (not $ all id results) $ exitWith (ExitFailure 2)
+#else
+  when (not $ null clusters) $ do
+    putStrLn "RAPI/curl backend disabled at compile time, cannot scan clusters"
+    exitWith $ ExitFailure 1
+#endif