hail: remove the custom info message generation

[ganeti-local] / hspace.hs

diff --git a/hspace.hs b/hspace.hs
index 23b8acf..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
 
 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 +25,15 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 
 module Main (main) where
 
 
 module Main (main) where
 

-import Data.Char (toUpper)
+import Data.Char (toUpper, isAlphaNum)

 import Data.List
 import Data.Function
 import Data.List
 import Data.Function

+import Data.Maybe (isJust, fromJust)
+import Data.Ord (comparing)

 import Monad
 import Monad

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

 import System.IO
 import System.IO

-import System.Console.GetOpt

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

@@ -40,214 +42,84 @@ 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

 
 import Ganeti.HTools.Utils
 import Ganeti.HTools.Types
 
 import Ganeti.HTools.Utils
 import Ganeti.HTools.Types

-
--- | Command line options structure.
-data Options = Options
-    { optShowNodes :: Bool           -- ^ Whether to show node status
-    , optNodef     :: FilePath       -- ^ Path to the nodes file
-    , optNodeSet   :: Bool           -- ^ The nodes have been set by options
-    , optInstf     :: FilePath       -- ^ Path to the instances file
-    , optInstSet   :: Bool           -- ^ The insts have been set by options
-    , optMaster    :: String         -- ^ Collect data from RAPI
-    , optVerbose   :: Int            -- ^ Verbosity level
-    , optOffline   :: [String]       -- ^ Names of offline nodes
-    , optIMem      :: Int            -- ^ Instance memory
-    , optIDsk      :: Int            -- ^ Instance disk
-    , optIVCPUs    :: Int            -- ^ Instance VCPUs
-    , optINodes    :: Int            -- ^ Nodes required for an instance
-    , optMcpu      :: Double         -- ^ Max cpu ratio for nodes
-    , optMdsk      :: Double         -- ^ Max disk usage ratio for nodes
-    , optShowVer   :: Bool           -- ^ Just show the program version
-    , optShowHelp  :: Bool           -- ^ Just show the help
-    } deriving Show
-
-instance CLI.CLIOptions Options where
-    showVersion = optShowVer
-    showHelp    = optShowHelp
-
-instance CLI.EToolOptions Options where
-    nodeFile   = optNodef
-    nodeSet    = optNodeSet
-    instFile   = optInstf
-    instSet    = optInstSet
-    masterName = optMaster
-    silent a   = optVerbose a == 0
-
--- | Default values for the command line options.
-defaultOptions :: Options
-defaultOptions  = Options
- { optShowNodes = False
- , optNodef     = "nodes"
- , optNodeSet   = False
- , optInstf     = "instances"
- , optInstSet   = False
- , optMaster    = ""
- , optVerbose   = 1
- , optOffline   = []
- , optIMem      = 4096
- , optIDsk      = 102400
- , optIVCPUs    = 1
- , optINodes    = 2
- , optMcpu      = -1
- , optMdsk      = -1
- , optShowVer   = False
- , optShowHelp  = False
- }
+import Ganeti.HTools.CLI
+import Ganeti.HTools.ExtLoader
+import Ganeti.HTools.Text (serializeCluster)

 
 -- | 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 ['n']     ["nodes"]
-      (ReqArg (\ f opts -> opts { optNodef = f, optNodeSet = True }) "FILE")
-      "the node list FILE"
-    , Option ['i']     ["instances"]
-      (ReqArg (\ f opts -> opts { optInstf =  f, optInstSet = True }) "FILE")
-      "the instance list FILE"
-    , Option ['m']     ["master"]
-      (ReqArg (\ m opts -> opts { optMaster = m }) "ADDRESS")
-      "collect data via RAPI at the given ADDRESS"
-    , Option ['v']     ["verbose"]
-      (NoArg (\ opts -> opts { optVerbose = optVerbose opts + 1 }))
-      "increase the verbosity level"
-    , Option ['q']     ["quiet"]
-      (NoArg (\ opts -> opts { optVerbose = optVerbose opts - 1 }))
-      "decrease the verbosity level"
-    , Option ['O']     ["offline"]
-      (ReqArg (\ n opts -> opts { optOffline = n:optOffline opts }) "NODE")
-      "set node as offline"
-    , Option []        ["memory"]
-      (ReqArg (\ m opts -> opts { optIMem = read m }) "MEMORY")
-      "memory size for instances"
-    , Option []        ["disk"]
-      (ReqArg (\ d opts -> opts { optIDsk = read d }) "DISK")
-      "disk size for instances"
-    , Option []        ["vcpus"]
-      (ReqArg (\ p opts -> opts { optIVCPUs = read p }) "NUM")
-      "number of virtual cpus for instances"
-    , Option []        ["req-nodes"]
-      (ReqArg (\ n opts -> opts { optINodes = read n }) "NODES")
-      "number of nodes for the new instances (1=plain, 2=mirrored)"
-    , Option []        ["max-cpu"]
-      (ReqArg (\ n opts -> opts { optMcpu = read n }) "RATIO")
-      "maximum virtual-to-physical cpu ratio for nodes"
-    , Option []        ["min-disk"]
-      (ReqArg (\ n opts -> opts { optMdsk = read n }) "RATIO")
-      "minimum free disk space for nodes (between 0 and 1)"
-    , 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
+    , oDataFile
+    , oNodeSim
+    , oRapiMaster
+    , oLuxiSocket
+    , oVerbose
+    , oQuiet
+    , oOfflineNode
+    , oIMem
+    , oIDisk
+    , oIVcpus
+    , oINodes
+    , oMaxCpu
+    , oMinDisk
+    , oTieredSpec
+    , oSaveCluster
+    , oShowVer
+    , oShowHelp

     ]
 
     ]
 

-data Phase = PInitial | PFinal
+-- | The allocation phase we're in (initial, after tiered allocs, or
+-- after regular allocation).
+data Phase = PInitial
+           | PFinal
+           | PTiered

 
 statsData :: [(String, Cluster.CStats -> String)]
 
 statsData :: [(String, Cluster.CStats -> String)]

-statsData = [ ("SCORE", printf "%.8f" . Cluster.cs_score)
-            , ("INST_CNT", printf "%d" . Cluster.cs_ninst)
-            , ("MEM_FREE", printf "%d" . Cluster.cs_fmem)
-            , ("MEM_AVAIL", printf "%d" . Cluster.cs_amem)
+statsData = [ ("SCORE", printf "%.8f" . Cluster.csScore)
+            , ("INST_CNT", printf "%d" . Cluster.csNinst)
+            , ("MEM_FREE", printf "%d" . Cluster.csFmem)
+            , ("MEM_AVAIL", printf "%d" . Cluster.csAmem)

             , ("MEM_RESVD",
             , ("MEM_RESVD",

-               \cs -> printf "%d" (Cluster.cs_fmem cs - Cluster.cs_amem cs))
-            , ("MEM_INST", printf "%d" . Cluster.cs_imem)
+               \cs -> printf "%d" (Cluster.csFmem cs - Cluster.csAmem cs))
+            , ("MEM_INST", printf "%d" . Cluster.csImem)

             , ("MEM_OVERHEAD",
             , ("MEM_OVERHEAD",

-               \cs -> printf "%d" (Cluster.cs_xmem cs + Cluster.cs_nmem cs))
+               \cs -> printf "%d" (Cluster.csXmem cs + Cluster.csNmem cs))

             , ("MEM_EFF",
             , ("MEM_EFF",

-               \cs -> printf "%.8f" (fromIntegral (Cluster.cs_imem cs) /
-                                     Cluster.cs_tmem cs))
-            , ("DSK_FREE", printf "%d" . Cluster.cs_fdsk)
-            , ("DSK_AVAIL", printf "%d ". Cluster.cs_adsk)
+               \cs -> printf "%.8f" (fromIntegral (Cluster.csImem cs) /
+                                     Cluster.csTmem cs))
+            , ("DSK_FREE", printf "%d" . Cluster.csFdsk)
+            , ("DSK_AVAIL", printf "%d". Cluster.csAdsk)

             , ("DSK_RESVD",
             , ("DSK_RESVD",

-               \cs -> printf "%d" (Cluster.cs_fdsk cs - Cluster.cs_adsk cs))
-            , ("DSK_INST", printf "%d" . Cluster.cs_idsk)
+               \cs -> printf "%d" (Cluster.csFdsk cs - Cluster.csAdsk cs))
+            , ("DSK_INST", printf "%d" . Cluster.csIdsk)

             , ("DSK_EFF",
             , ("DSK_EFF",

-               \cs -> printf "%.8f" (fromIntegral (Cluster.cs_idsk cs) /
-                                    Cluster.cs_tdsk cs))
-            , ("CPU_INST", printf "%d" . Cluster.cs_icpu)
+               \cs -> printf "%.8f" (fromIntegral (Cluster.csIdsk cs) /
+                                    Cluster.csTdsk cs))
+            , ("CPU_INST", printf "%d" . Cluster.csIcpu)

             , ("CPU_EFF",
             , ("CPU_EFF",

-               \cs -> printf "%.8f" (fromIntegral (Cluster.cs_icpu cs) /
-                                     Cluster.cs_tcpu cs))
-            , ("MNODE_MEM_AVAIL", printf "%d" . Cluster.cs_mmem)
-            , ("MNODE_DSK_AVAIL", printf "%d" . Cluster.cs_mdsk)
+               \cs -> printf "%.8f" (fromIntegral (Cluster.csIcpu cs) /
+                                     Cluster.csTcpu cs))
+            , ("MNODE_MEM_AVAIL", printf "%d" . Cluster.csMmem)
+            , ("MNODE_DSK_AVAIL", printf "%d" . Cluster.csMdsk)

             ]
 
             ]
 

-specData :: [(String, Options -> String)]
-specData = [ ("MEM", printf "%d" . optIMem)
-           , ("DSK", printf "%d" . optIDsk)
-           , ("CPU", printf "%d" . optIVCPUs)
-           , ("RQN", printf "%d" . optINodes)
+specData :: [(String, RSpec -> String)]
+specData = [ ("MEM", printf "%d" . rspecMem)
+           , ("DSK", printf "%d" . rspecDsk)
+           , ("CPU", printf "%d" . rspecCpu)

            ]
 
 clusterData :: [(String, Cluster.CStats -> String)]
            ]
 
 clusterData :: [(String, Cluster.CStats -> String)]

-clusterData = [ ("MEM", printf "%.0f" . Cluster.cs_tmem)
-              , ("DSK", printf "%.0f" . Cluster.cs_tdsk)
-              , ("CPU", printf "%.0f" . Cluster.cs_tcpu)
+clusterData = [ ("MEM", printf "%.0f" . Cluster.csTmem)
+              , ("DSK", printf "%.0f" . Cluster.csTdsk)
+              , ("CPU", printf "%.0f" . Cluster.csTcpu)
+              , ("VCPU", printf "%d" . Cluster.csVcpu)

               ]
 
               ]
 

--- | Build failure stats out of a list of failure reasons
-concatFailure :: [(FailMode, Int)] -> FailMode -> [(FailMode, Int)]
-concatFailure flst reason =
-    let cval = lookup reason flst
-    in case cval of
-         Nothing -> (reason, 1):flst
-         Just val -> let plain = filter (\(x, _) -> x /= reason) flst
-                     in (reason, val+1):plain
-
--- | Build list of failures and placements out of an list of possible
--- | allocations
-filterFails :: Cluster.AllocSolution
-            -> ([(FailMode, Int)],
-                [(Node.List, Instance.Instance, [Node.Node])])
-filterFails sols =
-    let (alst, blst) = unzip . map (\ e  ->
-                                        case e of
-                                          OpFail reason -> ([reason], [])
-                                          OpGood (gnl, i, nn) ->
-                                              ([], [(gnl, i, nn)])
-                                   ) $ sols
-        aval = concat alst
-        bval = concat blst
-    in (foldl' concatFailure [(x, 0) | x <- [minBound..maxBound]] aval, bval)
-
--- | Get the placement with best score out of a list of possible placements
-processResults :: [(Node.List, Instance.Instance, [Node.Node])]
-               -> (Node.List, Instance.Instance, [Node.Node])
-processResults sols =
-    let sols' = map (\e@(nl', _, _) -> (Cluster.compCV  nl', e)) sols
-        sols'' = sortBy (compare `on` fst) sols'
-    in snd $ head sols''
-
--- | Recursively place instances on the cluster until we're out of space
-iterateDepth :: Node.List
-             -> Instance.List
-             -> Instance.Instance
-             -> Int
-             -> [Instance.Instance]
-             -> ([(FailMode, Int)], 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
-          sols = Cluster.tryAlloc nl il newi2 nreq::
-                 OpResult Cluster.AllocSolution
-      in case sols of
-           OpFail _ -> ([], nl, ixes)
-           OpGood sols' ->
-               let (errs, sols3) = filterFails sols'
-               in if null sols3
-                  then (errs, nl, ixes)
-                  else let (xnl, xi, _) = processResults sols3
-                       in iterateDepth xnl il newinst nreq (xi:ixes)
-

 -- | Function to print stats for a given phase
 printStats :: Phase -> Cluster.CStats -> [(String, String)]
 printStats ph cs =
 -- | Function to print stats for a given phase
 printStats :: Phase -> Cluster.CStats -> [(String, String)]
 printStats ph cs =

@@ -255,6 +127,7 @@ printStats ph cs =
   where kind = case ph of
                  PInitial -> "INI"
                  PFinal -> "FIN"
   where kind = case ph of
                  PInitial -> "INI"
                  PFinal -> "FIN"

+                 PTiered -> "TRL"

 
 -- | Print final stats and related metrics
 printResults :: Node.List -> Int -> Int -> [(FailMode, Int)] -> IO ()
 
 -- | Print final stats and related metrics
 printResults :: Node.List -> Int -> Int -> [(FailMode, Int)] -> IO ()

@@ -262,18 +135,18 @@ printResults fin_nl num_instances allocs sreason = do
   let fin_stats = Cluster.totalResources fin_nl
       fin_instances = num_instances + allocs
 
   let fin_stats = Cluster.totalResources fin_nl
       fin_instances = num_instances + allocs
 

-  when (num_instances + allocs /= Cluster.cs_ninst fin_stats) $
+  when (num_instances + allocs /= Cluster.csNinst fin_stats) $

        do
          hPrintf stderr "ERROR: internal inconsistency, allocated (%d)\
                         \ != counted (%d)\n" (num_instances + allocs)
        do
          hPrintf stderr "ERROR: internal inconsistency, allocated (%d)\
                         \ != counted (%d)\n" (num_instances + allocs)

-                                 (Cluster.cs_ninst fin_stats)
+                                 (Cluster.csNinst fin_stats) :: IO ()

          exitWith $ ExitFailure 1
 
   printKeys $ printStats PFinal fin_stats
   printKeys [ ("ALLOC_USAGE", printf "%.8f"
                                 ((fromIntegral num_instances::Double) /
                                  fromIntegral fin_instances))
          exitWith $ ExitFailure 1
 
   printKeys $ printStats PFinal fin_stats
   printKeys [ ("ALLOC_USAGE", printf "%.8f"
                                 ((fromIntegral num_instances::Double) /
                                  fromIntegral fin_instances))

-            , ("ALLOC_COUNT", printf "%d" allocs)
+            , ("ALLOC_INSTANCES", printf "%d" allocs)

             , ("ALLOC_FAIL_REASON", map toUpper . show . fst $ head sreason)
             ]
   printKeys $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x),
             , ("ALLOC_FAIL_REASON", map toUpper . show . fst $ head sreason)
             ]
   printKeys $ map (\(x, y) -> (printf "ALLOC_%s_CNT" (show x),

@@ -281,34 +154,74 @@ printResults fin_nl num_instances allocs sreason = do
   -- this should be the final entry
   printKeys [("OK", "1")]
 
   -- this should be the final entry
   printKeys [("OK", "1")]
 

--- | Format a list of key/values as a shell fragment
+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 :: 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 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
+ensureQuoted v = if not (all (\c -> (isAlphaNum c || c == '.')) v)
+                 then '\'':v ++ "'"
+                 else v
+
+-- | Format a list of key\/values as a shell fragment

 printKeys :: [(String, String)] -> IO ()
 printKeys :: [(String, String)] -> IO ()

-printKeys = mapM_ (\(k, v) -> printf "HTS_%s=%s\n" (map toUpper k) v)
+printKeys = mapM_ (\(k, v) ->
+                   printf "HTS_%s=%s\n" (map toUpper k) (ensureQuoted v))
+
+printInstance :: Node.List -> Instance.Instance -> [String]
+printInstance nl i = [ Instance.name i
+                     , Container.nameOf nl $ Instance.pNode i
+                     , let sdx = Instance.sNode i
+                       in if sdx == Node.noSecondary then ""
+                          else Container.nameOf nl sdx
+                     , show (Instance.mem i)
+                     , show (Instance.dsk i)
+                     , show (Instance.vcpus i)
+                     ]

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

-  (opts, args) <- CLI.parseOpts cmd_args "hspace" options defaultOptions
+  (opts, args) <- parseOpts cmd_args "hspace" options

 
   unless (null args) $ do
          hPutStrLn stderr "Error: this program doesn't take any arguments."
          exitWith $ ExitFailure 1
 
   let verbose = optVerbose opts
 
   unless (null args) $ do
          hPutStrLn stderr "Error: this program doesn't take any arguments."
          exitWith $ ExitFailure 1
 
   let verbose = optVerbose opts

+      ispec = optISpec opts
+      shownodes = optShowNodes opts

 
 

-  (fixed_nl, il, csf) <- CLI.loadExternalData opts
+  (fixed_nl, il, _) <- loadExternalData opts

 
 

-  printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn opts)) specData
+  printKeys $ map (\(a, fn) -> ("SPEC_" ++ a, fn ispec)) specData
+  printKeys [ ("SPEC_RQN", printf "%d" (optINodes opts)) ]

 
   let num_instances = length $ Container.elems il
 
   let offline_names = optOffline opts
       all_nodes = Container.elems fixed_nl
       all_names = map Node.name all_nodes
 
   let num_instances = length $ Container.elems il
 
   let offline_names = optOffline opts
       all_nodes = Container.elems fixed_nl
       all_names = map Node.name all_nodes

-      offline_wrong = filter (flip notElem all_names) offline_names
+      offline_wrong = filter (`notElem` all_names) offline_names

       offline_indices = map Node.idx $
       offline_indices = map Node.idx $

-                        filter (\n -> elem (Node.name n) 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
                                all_nodes
       req_nodes = optINodes opts
       m_cpu = optMcpu opts

@@ -316,31 +229,33 @@ main = do
 
   when (length offline_wrong > 0) $ do
          hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n"
 
   when (length offline_wrong > 0) $ do
          hPrintf stderr "Error: Wrong node name(s) set as offline: %s\n"

-                     (commaJoin offline_wrong)
+                     (commaJoin offline_wrong) :: IO ()

          exitWith $ ExitFailure 1
 
   when (req_nodes /= 1 && req_nodes /= 2) $ do
          exitWith $ ExitFailure 1
 
   when (req_nodes /= 1 && req_nodes /= 2) $ do

-         hPrintf stderr "Error: Invalid required nodes (%d)\n" req_nodes
+         hPrintf stderr "Error: Invalid required nodes (%d)\n"
+                                            req_nodes :: IO ()

          exitWith $ ExitFailure 1
 
          exitWith $ ExitFailure 1
 

-  let nm = Container.map (\n -> if elem (Node.idx n) offline_indices
+  let nm = Container.map (\n -> if Node.idx n `elem` offline_indices

                                 then Node.setOffline n True
                                 else n) fixed_nl
       nl = Container.map (flip Node.setMdsk m_dsk . flip Node.setMcpu m_cpu)
            nm
                                 then Node.setOffline n True
                                 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
 
 
   when (length csf > 0 && verbose > 1) $
        hPrintf stderr "Note: Stripping common suffix of '%s' from names\n" csf
 

-  when (optShowNodes opts) $
+  when (isJust shownodes) $

        do
          hPutStrLn stderr "Initial cluster status:"
        do
          hPutStrLn stderr "Initial cluster status:"

-         hPutStrLn stderr $ Cluster.printNodes nl
+         hPutStrLn stderr $ Cluster.printNodes nl (fromJust shownodes)

 
   let ini_cv = Cluster.compCV nl
       ini_stats = Cluster.totalResources nl
 
 
   let ini_cv = Cluster.compCV nl
       ini_stats = Cluster.totalResources nl
 

-  when (verbose > 2) $ do
+  when (verbose > 2) $

          hPrintf stderr "Initial coefficients: overall %.8f, %s\n"
                  ini_cv (Cluster.printStats nl)
 
          hPrintf stderr "Initial coefficients: overall %.8f, %s\n"
                  ini_cv (Cluster.printStats nl)
 

@@ -349,36 +264,92 @@ main = do
   printKeys $ printStats PInitial ini_stats
 
   let bad_nodes = fst $ Cluster.computeBadItems nl il
   printKeys $ printStats PInitial ini_stats
 
   let bad_nodes = fst $ Cluster.computeBadItems nl il

-  when (length bad_nodes > 0) $ do
-         -- This is failn1 case, so we print the same final stats and
-         -- exit early
-         printResults nl num_instances 0 [(FailN1, 1)]
-         exitWith ExitSuccess
-
-  let nmlen = Container.maxNameLen nl
-      newinst = Instance.create "new" (optIMem opts) (optIDsk opts)
-                (optIVCPUs opts) "ADMIN_down" (-1) (-1)
-
-  let (ereason, fin_nl, ixes) = iterateDepth nl il newinst req_nodes []
-      allocs = length ixes
+      stop_allocation = length bad_nodes > 0
+      result_noalloc = ([(FailN1, 1)]::FailStats, nl, il, [])
+
+  -- utility functions
+  let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
+                    (rspecCpu spx) "running" [] (-1) (-1)
+      exitifbad val = (case val of
+                         Bad s -> do
+                           hPrintf stderr "Failure: %s\n" s :: IO ()
+                           exitWith $ ExitFailure 1
+                         Ok x -> return x)
+
+
+  let reqinst = iofspec ispec
+
+  -- Run the tiered allocation, if enabled
+
+  (case optTieredSpec opts of
+     Nothing -> return ()
+     Just tspec -> do
+       (_, trl_nl, trl_il, trl_ixes) <-
+           if stop_allocation
+           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]
+
+       when (verbose > 1) $ do
+         hPutStrLn stderr "Tiered allocation map"
+         hPutStr stderr . unlines . map ((:) ' ' .  intercalate " ") $
+                 formatTable (map (printInstance trl_nl) fin_trl_ixes)
+                                 [False, False, False, True, True, True]
+
+       when (isJust shownodes) $ do
+         hPutStrLn stderr ""
+         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 m_cpu nl trl_nl)
+
+  -- Run the standard (avg-mode) allocation
+
+  (ereason, fin_nl, fin_il, ixes) <-
+      if stop_allocation
+      then return result_noalloc
+      else exitifbad (Cluster.iterateAlloc nl il reqinst req_nodes [])
+
+  let allocs = length ixes

       fin_ixes = reverse ixes
       fin_ixes = reverse ixes

-      ix_namelen = maximum . map (length . Instance.name) $ fin_ixes
-      sreason = reverse $ sortBy (compare `on` snd) ereason
-
-  when (verbose > 1) $
-         hPutStr stderr . unlines $
-         map (\i -> printf "Inst: %*s %-*s %-*s"
-                    ix_namelen (Instance.name i)
-                    nmlen (Container.nameOf fin_nl $ Instance.pnode i)
-                    nmlen (let sdx = Instance.snode i
-                           in if sdx == Node.noSecondary then ""
-                              else Container.nameOf fin_nl sdx)
-             ) fin_ixes
-
-  when (optShowNodes opts) $
+      sreason = reverse $ sortBy (comparing snd) ereason
+
+  when (verbose > 1) $ do
+         hPutStrLn stderr "Instance map"
+         hPutStr stderr . unlines . map ((:) ' ' .  intercalate " ") $
+                 formatTable (map (printInstance fin_nl) fin_ixes)
+                                 [False, False, False, True, True, True]
+  when (isJust shownodes) $

        do
          hPutStrLn stderr ""
          hPutStrLn stderr "Final cluster status:"
        do
          hPutStrLn stderr ""
          hPutStrLn stderr "Final cluster status:"

-         hPutStrLn stderr $ Cluster.printNodes fin_nl
+         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
 
   printResults fin_nl num_instances allocs sreason