hail: remove the custom info message generation

[ganeti-local] / hspace.hs

diff --git a/hspace.hs b/hspace.hs
index 87b6fd3..90986d9 100644 (file)
--- a/hspace.hs
+++ b/hspace.hs
@@ -4,7 +4,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
@@ -32,6 +32,7 @@ import Data.Maybe (isJust, fromJust)
 import Data.Ord (comparing)
 import Monad
 import System (exitWith, ExitCode(..))
+import System.FilePath
 import System.IO
 import qualified System
 
@@ -46,6 +47,7 @@ import Ganeti.HTools.Utils
 import Ganeti.HTools.Types
 import Ganeti.HTools.CLI
 import Ganeti.HTools.ExtLoader
+import Ganeti.HTools.Text (serializeCluster)
 
 -- | Options list and functions
 options :: [OptType]
@@ -65,6 +67,7 @@ options =
     , oMaxCpu
     , oMinDisk
     , oTieredSpec
+    , oSaveCluster
     , oShowVer
     , oShowHelp
     ]
@@ -151,21 +154,22 @@ printResults fin_nl num_instances allocs sreason = do
   -- this should be the final entry
   printKeys [("OK", "1")]
 
-formatRSpec :: String -> RSpec -> [(String, String)]
-formatRSpec s r =
+formatRSpec :: Double -> String -> RSpec -> [(String, String)]
+formatRSpec m_cpu s r =
     [ ("KM_" ++ s ++ "_CPU", show $ rspecCpu r)
+    , ("KM_" ++ s ++ "_NPU", show $ fromIntegral (rspecCpu r) / m_cpu)
     , ("KM_" ++ s ++ "_MEM", show $ rspecMem r)
     , ("KM_" ++ s ++ "_DSK", show $ rspecDsk r)
     ]
 
-printAllocationStats :: Node.List -> Node.List -> IO ()
-printAllocationStats ini_nl fin_nl = do
+printAllocationStats :: Double -> Node.List -> Node.List -> IO ()
+printAllocationStats m_cpu ini_nl fin_nl = do
   let ini_stats = Cluster.totalResources ini_nl
       fin_stats = Cluster.totalResources fin_nl
       (rini, ralo, runa) = Cluster.computeAllocationDelta ini_stats fin_stats
-  printKeys $ formatRSpec "USED" rini
-  printKeys $ formatRSpec "POOL" ralo
-  printKeys $ formatRSpec "UNAV" runa
+  printKeys $ formatRSpec m_cpu  "USED" rini
+  printKeys $ formatRSpec m_cpu "POOL"ralo
+  printKeys $ formatRSpec m_cpu "UNAV" runa
 
 -- | Ensure a value is quoted if needed
 ensureQuoted :: String -> String
@@ -265,7 +269,7 @@ main = do
 
   -- utility functions
   let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
-                    (rspecCpu spx) "ADMIN_down" [] (-1) (-1)
+                    (rspecCpu spx) "running" [] (-1) (-1)
       exitifbad val = (case val of
                          Bad s -> do
                            hPrintf stderr "Failure: %s\n" s :: IO ()
@@ -280,7 +284,7 @@ main = do
   (case optTieredSpec opts of
      Nothing -> return ()
      Just tspec -> do
-       (_, trl_nl, _, trl_ixes) <-
+       (_, trl_nl, trl_il, trl_ixes) <-
            if stop_allocation
            then return result_noalloc
            else exitifbad (Cluster.tieredAlloc nl il (iofspec tspec)
@@ -305,13 +309,21 @@ main = do
          hPutStrLn stderr "Tiered allocation status:"
          hPutStrLn stderr $ Cluster.printNodes trl_nl (fromJust shownodes)
 
+       when (isJust $ optSaveCluster opts) $
+            do
+              let out_path = (fromJust $ optSaveCluster opts) <.> "tiered"
+                  adata = serializeCluster trl_nl trl_il
+              writeFile out_path adata
+              hPrintf stderr "The cluster state after tiered allocation\
+                             \ has been written to file '%s'\n"
+                             out_path
        printKeys $ printStats PTiered (Cluster.totalResources trl_nl)
        printKeys [("TSPEC", intercalate " " spec_map')]
-       printAllocationStats nl trl_nl)
+       printAllocationStats m_cpu nl trl_nl)
 
   -- Run the standard (avg-mode) allocation
 
-  (ereason, fin_nl, _, ixes) <-
+  (ereason, fin_nl, fin_il, ixes) <-
       if stop_allocation
       then return result_noalloc
       else exitifbad (Cluster.iterateAlloc nl il reqinst req_nodes [])
@@ -331,4 +343,13 @@ main = do
          hPutStrLn stderr "Final cluster status:"
          hPutStrLn stderr $ Cluster.printNodes fin_nl (fromJust shownodes)
 
+  when (isJust $ optSaveCluster opts) $
+       do
+         let out_path = (fromJust $ optSaveCluster opts) <.> "alloc"
+             adata = serializeCluster fin_nl fin_il
+         writeFile out_path adata
+         hPrintf stderr "The cluster state after standard allocation\
+                        \ has been written to file '%s'\n"
+                 out_path
+
   printResults fin_nl num_instances allocs sreason