Simulation backend: allow multiple node groups
[ganeti-local] / hspace.hs
index 8b8405c..2678c9d 100644 (file)
--- a/hspace.hs
+++ b/hspace.hs
@@ -27,7 +27,6 @@ module Main (main) where
 
 import Data.Char (toUpper, isAlphaNum)
 import Data.List
-import Data.Function
 import Data.Maybe (isJust, fromJust)
 import Data.Ord (comparing)
 import Monad
@@ -154,21 +153,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
@@ -206,7 +206,7 @@ main = do
       ispec = optISpec opts
       shownodes = optShowNodes opts
 
-  (fixed_nl, il, _) <- loadExternalData opts
+  (gl, fixed_nl, il, ctags) <- loadExternalData opts
 
   printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData
   printKeys [ ("SPEC_RQN", printf "%d" (optINodes opts)) ]
@@ -288,19 +288,12 @@ main = do
            then return result_noalloc
            else exitifbad (Cluster.tieredAlloc nl il (iofspec tspec)
                                   req_nodes [])
-       let fin_trl_ixes = reverse trl_ixes
-           ix_byspec = groupBy ((==) `on` Instance.specOf) fin_trl_ixes
-           spec_map = map (\ixs -> (Instance.specOf $ head ixs, length ixs))
-                      ix_byspec::[(RSpec, Int)]
-           spec_map' = map (\(spec, cnt) ->
-                                printf "%d,%d,%d=%d" (rspecMem spec)
-                                       (rspecDsk spec) (rspecCpu spec) cnt)
-                       spec_map::[String]
+       let spec_map' = Cluster.tieredSpecMap trl_ixes
 
        when (verbose > 1) $ do
          hPutStrLn stderr "Tiered allocation map"
          hPutStr stderr . unlines . map ((:) ' ' .  intercalate " ") $
-                 formatTable (map (printInstance trl_nl) fin_trl_ixes)
+                 formatTable (map (printInstance trl_nl) (reverse trl_ixes))
                                  [False, False, False, True, True, True]
 
        when (isJust shownodes) $ do
@@ -311,14 +304,14 @@ main = do
        when (isJust $ optSaveCluster opts) $
             do
               let out_path = (fromJust $ optSaveCluster opts) <.> "tiered"
-                  adata = serializeCluster trl_nl trl_il
+                  adata = serializeCluster gl trl_nl trl_il ctags
               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
 
@@ -345,7 +338,7 @@ main = do
   when (isJust $ optSaveCluster opts) $
        do
          let out_path = (fromJust $ optSaveCluster opts) <.> "alloc"
-             adata = serializeCluster fin_nl fin_il
+             adata = serializeCluster gl fin_nl fin_il ctags
          writeFile out_path adata
          hPrintf stderr "The cluster state after standard allocation\
                         \ has been written to file '%s'\n"