Force UTF-8 locale for pandoc invocation

[ganeti-local] / hscan.hs

diff --git a/hscan.hs b/hscan.hs
index f36758b..06def66 100644 (file)
--- a/hscan.hs
+++ b/hscan.hs
@@ -6,7 +6,7 @@
 
 {-
 
-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
@@ -27,11 +27,9 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 
 module Main (main) where
 
-import Data.List
-import Data.Function
-import Data.Maybe (isJust, fromJust)
+import Data.Maybe (isJust, fromJust, fromMaybe)
 import Monad
-import System
+import System (exitWith, ExitCode(..))
 import System.IO
 import System.FilePath
 import qualified System
@@ -47,6 +45,7 @@ import qualified Ganeti.HTools.Rapi as Rapi
 #endif
 import qualified Ganeti.HTools.Luxi as Luxi
 import qualified Ganeti.HTools.Loader as Loader
+import Ganeti.HTools.Text (serializeCluster)
 
 import Ganeti.HTools.CLI
 import Ganeti.HTools.Types
@@ -63,40 +62,6 @@ options =
     , oShowHelp
     ]
 
--- | 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.tMem node) (Node.nMem node) (Node.fMem node)
-               (Node.tDsk node) (Node.fDsk node) (Node.tCpu 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) ++ 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|%s"
-             iname (Instance.mem inst) (Instance.dsk inst)
-             (Instance.vcpus inst) (Instance.runSt inst)
-             pnode snode (intercalate "," (Instance.tags inst))
-
--- | 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
@@ -127,11 +92,9 @@ fixSlash = map (\x -> if x == '/' then '_' else x)
 processData :: Result (Node.AssocList, Instance.AssocList, [String])
             -> Result (Node.List, Instance.List, String)
 processData input_data = do
-  (nl, il, _, csf) <- input_data >>= Loader.mergeData [] [] []
+  (nl, il, _) <- input_data >>= Loader.mergeData [] [] []
   let (_, fix_nl) = Loader.checkData nl il
-  let ndata = serializeNodes csf nl
-      idata = serializeInstances csf nl il
-      adata = ndata ++ ['\n'] ++ idata
+      adata = serializeCluster nl il
   return (fix_nl, il, adata)
 
 -- | Writes cluster data out
@@ -139,12 +102,13 @@ writeData :: Int
           -> String
           -> Options
           -> Result (Node.List, Instance.List, String)
-          -> IO ()
+          -> IO Bool
 writeData _ name _ (Bad err) =
-    printf "\nError for %s: failed to load data. Details:\n%s\n" name 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
+  printf "%-*s " nlen name :: IO ()
   hFlush stdout
   let shownodes = optShowNodes opts
       odir = optOutPath opts
@@ -154,7 +118,7 @@ writeData nlen name opts (Ok (nl, il, adata)) = do
   when (isJust shownodes) $
        putStr $ Cluster.printNodes nl (fromJust shownodes)
   writeFile (oname <.> "data") adata
-
+  return True
 
 -- | Main function.
 main :: IO ()
@@ -173,19 +137,19 @@ main = do
                 "t_disk" "f_disk" "Score"
 
   when (null clusters) $ do
-         let lsock = case optLuxi opts of
-                       Just s -> s
-                       Nothing -> defaultLuxiSocket
+         let lsock = fromMaybe defaultLuxiSocket (optLuxi opts)
          let name = local
          input_data <- Luxi.loadData lsock
-         writeData nlen name opts (processData input_data)
+         result <- writeData nlen name opts (processData input_data)
+         when (not result) $ exitWith $ ExitFailure 2
 
 #ifndef NO_CURL
-  mapM_ (\ name ->
-            do
-              input_data <- Rapi.loadData name
-              writeData nlen name opts (processData input_data)
-        ) clusters
+  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"