diff --git a/Ganeti/HTools/Cluster.hs b/Ganeti/HTools/Cluster.hs
index e7910e9c83cf13316386ed3923fb4820bb72437c..60d4ddd3c9881e92203c2b61dccdab66b63a9152 100644
--- a/Ganeti/HTools/Cluster.hs
+++ b/Ganeti/HTools/Cluster.hs
@@ -624,19 +624,21 @@ tryAlloc :: (Monad m) =>
-> Instance.List -- ^ The instance list
-> Instance.Instance -- ^ The instance to allocate
-> Int -- ^ Required number of nodes
- -> m [(Maybe Node.List, [Node.Node])] -- ^ Possible solution list
+ -> m [(Maybe Node.List, Instance.Instance, [Node.Node])]
+ -- ^ Possible solution list
tryAlloc nl _ inst 2 =
let all_nodes = getOnline nl
all_pairs = liftM2 (,) all_nodes all_nodes
ok_pairs = filter (\(x, y) -> Node.idx x /= Node.idx y) all_pairs
- sols = map (\(p, s) ->
- (fst $ allocateOnPair nl inst p s, [p, s]))
+ sols = map (\(p, s) -> let (mnl, i) = allocateOnPair nl inst p s
+ in (mnl, i, [p, s]))
ok_pairs
in return sols
tryAlloc nl _ inst 1 =
let all_nodes = getOnline nl
- sols = map (\p -> (fst $ allocateOnSingle nl inst p, [p]))
+ sols = map (\p -> let (mnl, i) = allocateOnSingle nl inst p
+ in (mnl, i, [p]))
all_nodes
in return sols
@@ -651,16 +653,17 @@ tryReloc :: (Monad m) =>
-> Idx -- ^ The index of the instance to move
-> Int -- ^ The numver of nodes required
-> [Ndx] -- ^ Nodes which should not be used
- -> m [(Maybe Node.List, [Node.Node])] -- ^ Solution list
+ -> m [(Maybe Node.List, Instance.Instance, [Node.Node])]
+ -- ^ Solution list
tryReloc nl il xid 1 ex_idx =
let all_nodes = getOnline nl
inst = Container.find xid il
ex_idx' = (Instance.pnode inst):ex_idx
valid_nodes = filter (not . flip elem ex_idx' . Node.idx) all_nodes
valid_idxes = map Node.idx valid_nodes
- sols1 = map (\x -> let (mnl, _, _, _) =
- applyMove nl inst (ReplaceSecondary x)
- in (mnl, [Container.find x nl])
+ sols1 = map (\x -> let (mnl, i, _, _) =
+ applyMove nl inst (ReplaceSecondary x)
+ in (mnl, i, [Container.find x nl])
) valid_idxes
in return sols1
diff --git a/hail.hs b/hail.hs
index afc04887e03a3b8d474d130a5ed46ade76dcc611..5c7f71ec0f00347ab14402aa563b099652b47d57 100644
--- a/hail.hs
+++ b/hail.hs
@@ -44,6 +44,7 @@ import qualified Ganeti.HTools.CLI as CLI
import Ganeti.HTools.IAlloc
import Ganeti.HTools.Types
import Ganeti.HTools.Loader (RqType(..), Request(..))
+import Ganeti.HTools.Utils
-- | Command line options structure.
data Options = Options
@@ -74,15 +75,15 @@ options =
]
-filterFails :: (Monad m) => [(Maybe Node.List, [Node.Node])]
+filterFails :: (Monad m) => [(Maybe Node.List, Instance.Instance, [Node.Node])]
-> m [(Node.List, [Node.Node])]
filterFails sols =
if null sols then fail "No nodes onto which to allocate at all"
- else let sols' = filter (isJust . fst) sols
+ else let sols' = filter (isJust . fst3) sols
in if null sols' then
fail "No valid allocation solutions"
else
- return $ map (\(x, y) -> (fromJust x, y)) sols'
+ return $ map (\(x, _, y) -> (fromJust x, y)) sols'
processResults :: (Monad m) => [(Node.List, [Node.Node])]
-> m (String, [Node.Node])
diff --git a/hspace.hs b/hspace.hs
index 01aa28036f408eb91d1173d24086d62424a86f79..00d629c1735b0d24cfef3e3f46c343c74affc772 100644
--- a/hspace.hs
+++ b/hspace.hs
@@ -132,20 +132,20 @@ options =
"show help"
]
-filterFails :: (Monad m) => [(Maybe Node.List, [Node.Node])]
- -> m [(Node.List, [Node.Node])]
+filterFails :: (Monad m) => [(Maybe Node.List, Instance.Instance, [Node.Node])]
+ -> m [(Node.List, Instance.Instance, [Node.Node])]
filterFails sols =
if null sols then fail "No nodes onto which to allocate at all"
- else let sols' = filter (isJust . fst) sols
+ else let sols' = filter (isJust . fst3) sols
in if null sols' then
fail "No valid allocation solutions"
else
- return $ map (\(x, y) -> (fromJust x, y)) sols'
+ return $ map (\(x, y, z) -> (fromJust x, y, z)) sols'
-processResults :: (Monad m) => [(Node.List, [Node.Node])]
- -> m (Node.List, [Node.Node])
+processResults :: (Monad m) => [(Node.List, Instance.Instance, [Node.Node])]
+ -> m (Node.List, Instance.Instance, [Node.Node])
processResults sols =
- let sols' = map (\(nl', ns) -> (Cluster.compCV nl', (nl', ns))) sols
+ let sols' = map (\e@(nl', _, _) -> (Cluster.compCV nl', e)) sols
sols'' = sortBy (compare `on` fst) sols'
in return $ snd $ head sols''
@@ -153,21 +153,23 @@ iterateDepth :: Node.List
-> Instance.List
-> Instance.Instance
-> Int
- -> Int
- -> (Node.List, Int)
-iterateDepth nl il newinst nreq depth =
- let newname = printf "new-%d" depth
+ -> [Instance.Instance]
+ -> (Node.List, [Instance.Instance])
+iterateDepth nl il newinst nreq ixes =
+ let depth = length ixes
+ newname = printf "new-%d" depth
newidx = (length $ Container.elems il) + depth
newi2 = Instance.setIdx (Instance.setName newinst newname) newidx
sols = Cluster.tryAlloc nl il newi2 nreq
- orig = (nl, depth)
+ orig = (nl, ixes)
in
if isNothing sols then orig
else let sols' = fromJust sols
sols'' = filterFails sols'
in if isNothing sols'' then orig
- else let (xnl, _) = fromJust $ processResults $ fromJust sols''
- in iterateDepth xnl il newinst nreq (depth+1)
+ else let (xnl, xi, _) = fromJust $ processResults $
+ fromJust sols''
+ in iterateDepth xnl il newinst nreq (xi:ixes)
-- | Main function.
@@ -183,6 +185,7 @@ main = do
let verbose = optVerbose opts
(fixed_nl, il, csf) <- CLI.loadExternalData opts
+ let num_instances = length $ Container.elems il
let offline_names = optOffline opts
all_nodes = Container.elems fixed_nl
@@ -193,7 +196,7 @@ main = do
all_nodes
when (length offline_wrong > 0) $ do
- printf "Wrong node name(s) set as offline: %s\n"
+ printf "Error: Wrong node name(s) set as offline: %s\n"
(commaJoin offline_wrong)
exitWith $ ExitFailure 1
@@ -206,7 +209,7 @@ main = do
let bad_nodes = fst $ Cluster.computeBadItems nl il
when (length bad_nodes > 0) $ do
- putStrLn "Cluster not N+1, no space to allocate."
+ putStrLn "Error: Cluster not N+1, no space to allocate."
exitWith $ ExitFailure 1
when (optShowNodes opts) $
@@ -215,22 +218,42 @@ main = do
putStrLn $ Cluster.printNodes nl
let ini_cv = Cluster.compCV nl
+ (orig_mem, orig_disk) = Cluster.totalResources nl
(if verbose > 2 then
printf "Initial coefficients: overall %.8f, %s\n"
ini_cv (Cluster.printStats nl)
else
printf "Initial score: %.8f\n" ini_cv)
+ printf "Initial instances: %d\n" num_instances
+ printf "Initial free RAM: %d\n" orig_mem
+ printf "Initial free disk: %d\n" orig_disk
- let imlen = Container.maxNameLen il
- nmlen = Container.maxNameLen nl
+ let nmlen = Container.maxNameLen nl
newinst = Instance.create "new" (optIMem opts) (optIDsk opts)
"ADMIN_down" (-1) (-1)
- let (fin_nl, fin_depth) = iterateDepth nl il newinst (optINodes opts) 0
-
- unless (verbose == 0) $
- printf "Solution length=%d\n" fin_depth
+ let (fin_nl, ixes) =
+ iterateDepth nl il newinst (optINodes opts) []
+ allocs = length ixes
+ fin_instances = num_instances + allocs
+ fin_ixes = reverse ixes
+ ix_namelen = maximum . map (length . Instance.name) $ fin_ixes
+ (final_mem, final_disk) = Cluster.totalResources fin_nl
+
+ printf "Final score: %.8f\n" (Cluster.compCV fin_nl)
+ printf "Final instances: %d\n" (num_instances + allocs)
+ printf "Final free RAM: %d\n" final_mem
+ printf "Final free disk: %d\n" final_disk
+ printf "Usage: %.2f\n" (((fromIntegral num_instances)::Double) /
+ (fromIntegral fin_instances))
+ printf "Allocations: %d\n" allocs
+ when (verbose > 1) $ do
+ putStr . unlines . map (\i -> printf "Inst: %*s %-*s %-*s"
+ ix_namelen (Instance.name i)
+ nmlen (Container.nameOf fin_nl $ Instance.pnode i)
+ nmlen (Container.nameOf fin_nl $ Instance.snode i))
+ $ fin_ixes
when (optShowNodes opts) $
do