, oINodes
, oMaxCpu
, oMinDisk
+ , oTieredSpec
, 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 = [ ("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",
- \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",
- \cs -> printf "%d" (Cluster.cs_xmem cs + Cluster.cs_nmem cs))
+ \cs -> printf "%d" (Cluster.csXmem cs + Cluster.csNmem cs))
, ("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",
- \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",
- \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",
- \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 = [ ("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)
]
-- | Recursively place instances on the cluster until we're out of space
Just (_, (xnl, xi, _)) ->
iterateDepth xnl il newinst nreq $! (xi:ixes)
+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 (compare `on` 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 =
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 ()
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)
- (Cluster.cs_ninst fin_stats)
+ (Cluster.csNinst fin_stats)
exitWith $ ExitFailure 1
printKeys $ printStats PFinal fin_stats
printKeys :: [(String, String)] -> IO ()
printKeys = mapM_ (\(k, v) -> printf "HTS_%s=%s\n" (map toUpper k) 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
exitWith $ ExitFailure 1
let verbose = optVerbose opts
+ ispec = optISpec opts
(fixed_nl, il, csf) <- 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
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)
+ -- utility functions
+ let iofspec spx = Instance.create "new" (rspecMem spx) (rspecDsk spx)
+ (rspecCpu spx) "ADMIN_down" (-1) (-1)
+ exitifbad val = (case val of
+ Bad s -> do
+ hPrintf stderr "Failure: %s\n" s
+ 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
+ let tresu = tieredAlloc nl il (iofspec tspec) req_nodes []
+ (_, trl_nl, trl_ixes) <- exitifbad tresu
+ let fin_trl_ixes = reverse trl_ixes
+
+ 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 (optShowNodes opts) $ do
+ hPutStrLn stderr ""
+ hPutStrLn stderr "Tiered allocation status:"
+ hPutStrLn stderr $ Cluster.printNodes trl_nl
+
+ printKeys $ printStats PTiered (Cluster.totalResources trl_nl))
+
+ -- Run the standard (avg-mode) allocation
+
+ let result = iterateDepth nl il reqinst req_nodes []
+ (ereason, fin_nl, ixes) <- exitifbad result
- let result = iterateDepth nl il newinst req_nodes []
- (ereason, fin_nl, ixes) <- (case result of
- Bad s -> do
- hPrintf stderr "Failure: %s\n" s
- exitWith $ ExitFailure 1
- Ok x -> return x)
let allocs = length 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 (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 (optShowNodes opts) $
do
hPutStrLn stderr ""
projects / ganeti-local / blobdiff