X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/317b10407c6ea3e602b5ba7a7a5198eba92a73f4..1a3cc8ad2d275fa59c4f0fffb372be0d156a7889:/hspace.hs

diff --git a/hspace.hs b/hspace.hs
index 2b106ef..8410f46 100644
--- 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
     ]
@@ -117,45 +120,6 @@ clusterData = [ ("MEM", printf "%.0f" . Cluster.csTmem)
               , ("VCPU", printf "%d" . Cluster.csVcpu)
               ]
 
--- | Recursively place instances on the cluster until we're out of space
-iterateDepth :: Node.List
-             -> Instance.List
-             -> Instance.Instance
-             -> Int
-             -> [Instance.Instance]
-             -> Result (FailStats, Node.List, [Instance.Instance])
-iterateDepth nl il newinst nreq ixes =
-      let depth = length ixes
-          newname = printf "new-%d" depth::String
-          newidx = length (Container.elems il) + depth
-          newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
-      in case Cluster.tryAlloc nl il newi2 nreq of
-           Bad s -> Bad s
-           Ok (errs, _, sols3) ->
-               case sols3 of
-                 [] -> Ok (Cluster.collapseFailures errs, nl, ixes)
-                 (_, (xnl, xi, _)):[] ->
-                     iterateDepth xnl il newinst nreq $! (xi:ixes)
-                 _ -> Bad "Internal error: multiple solutions for single\
-                          \ allocation"
-
-tieredAlloc :: Node.List
-            -> Instance.List
-            -> Instance.Instance
-            -> Int
-            -> [Instance.Instance]
-            -> Result (FailStats, Node.List, [Instance.Instance])
-tieredAlloc nl il newinst nreq ixes =
-    case iterateDepth nl il newinst nreq ixes of
-      Bad s -> Bad s
-      Ok (errs, nl', ixes') ->
-          case Instance.shrinkByType newinst . fst . last $
-               sortBy (comparing snd) errs of
-            Bad _ -> Ok (errs, nl', ixes')
-            Ok newinst' ->
-                tieredAlloc nl' il newinst' nreq ixes'
-
-
 -- | Function to print stats for a given phase
 printStats :: Phase -> Cluster.CStats -> [(String, String)]
 printStats ph cs =
@@ -190,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
@@ -212,7 +177,7 @@ ensureQuoted v = if not (all (\c -> (isAlphaNum c || c == '.')) v)
                  then '\'':v ++ "'"
                  else v
 
--- | Format a list of key/values as a shell fragment
+-- | Format a list of key\/values as a shell fragment
 printKeys :: [(String, String)] -> IO ()
 printKeys = mapM_ (\(k, v) ->
                    printf "HTS_%s=%s\n" (map toUpper k) (ensureQuoted v))
@@ -242,7 +207,7 @@ main = do
       ispec = optISpec opts
       shownodes = optShowNodes opts
 
-  (fixed_nl, il, _, csf) <- 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)) ]
@@ -254,7 +219,9 @@ main = do
       all_names = map Node.name all_nodes
       offline_wrong = filter (`notElem` all_names) offline_names
       offline_indices = map Node.idx $
-                        filter (\n -> Node.name n `elem` offline_names)
+                        filter (\n ->
+                                 Node.name n `elem` offline_names ||
+                                 Node.alias n `elem` offline_names)
                                all_nodes
       req_nodes = optINodes opts
       m_cpu = optMcpu opts
@@ -275,6 +242,7 @@ main = do
                                 else n) fixed_nl
       nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
            nm
+      csf = commonSuffix fixed_nl il
 
   when (length csf > 0 && verbose > 1) $
        hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf
@@ -297,11 +265,11 @@ main = do
 
   let bad_nodes = fst $ Cluster.computeBadItems nl il
       stop_allocation = length bad_nodes > 0
-      result_noalloc = ([(FailN1, 1)]::FailStats, nl, [])
+      result_noalloc = ([(FailN1, 1)]::FailStats, nl, il, [])
 
   -- 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 ()
@@ -316,10 +284,11 @@ 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 (tieredAlloc nl il (iofspec tspec) req_nodes [])
+           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))
@@ -340,16 +309,24 @@ 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 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
 
-  (ereason, fin_nl, ixes) <-
+  (ereason, fin_nl, fin_il, ixes) <-
       if stop_allocation
       then return result_noalloc
-      else exitifbad (iterateDepth nl il reqinst req_nodes [])
+      else exitifbad (Cluster.iterateAlloc nl il reqinst req_nodes [])
 
   let allocs = length ixes
       fin_ixes = reverse ixes
@@ -366,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 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"
+                 out_path
+
   printResults fin_nl num_instances allocs sreason