Revision 9dcec001
| b/Ganeti/HTools/Cluster.hs | ||
|---|---|---|
| 624 | 624 |
-> Instance.List -- ^ The instance list |
| 625 | 625 |
-> Instance.Instance -- ^ The instance to allocate |
| 626 | 626 |
-> Int -- ^ Required number of nodes |
| 627 |
-> m [(Maybe Node.List, [Node.Node])] -- ^ Possible solution list |
|
| 627 |
-> m [(Maybe Node.List, Instance.Instance, [Node.Node])] |
|
| 628 |
-- ^ Possible solution list |
|
| 628 | 629 |
tryAlloc nl _ inst 2 = |
| 629 | 630 |
let all_nodes = getOnline nl |
| 630 | 631 |
all_pairs = liftM2 (,) all_nodes all_nodes |
| 631 | 632 |
ok_pairs = filter (\(x, y) -> Node.idx x /= Node.idx y) all_pairs |
| 632 |
sols = map (\(p, s) -> |
|
| 633 |
(fst $ allocateOnPair nl inst p s, [p, s]))
|
|
| 633 |
sols = map (\(p, s) -> let (mnl, i) = allocateOnPair nl inst p s
|
|
| 634 |
in (mnl, i, [p, s]))
|
|
| 634 | 635 |
ok_pairs |
| 635 | 636 |
in return sols |
| 636 | 637 |
|
| 637 | 638 |
tryAlloc nl _ inst 1 = |
| 638 | 639 |
let all_nodes = getOnline nl |
| 639 |
sols = map (\p -> (fst $ allocateOnSingle nl inst p, [p])) |
|
| 640 |
sols = map (\p -> let (mnl, i) = allocateOnSingle nl inst p |
|
| 641 |
in (mnl, i, [p])) |
|
| 640 | 642 |
all_nodes |
| 641 | 643 |
in return sols |
| 642 | 644 |
|
| ... | ... | |
| 651 | 653 |
-> Idx -- ^ The index of the instance to move |
| 652 | 654 |
-> Int -- ^ The numver of nodes required |
| 653 | 655 |
-> [Ndx] -- ^ Nodes which should not be used |
| 654 |
-> m [(Maybe Node.List, [Node.Node])] -- ^ Solution list |
|
| 656 |
-> m [(Maybe Node.List, Instance.Instance, [Node.Node])] |
|
| 657 |
-- ^ Solution list |
|
| 655 | 658 |
tryReloc nl il xid 1 ex_idx = |
| 656 | 659 |
let all_nodes = getOnline nl |
| 657 | 660 |
inst = Container.find xid il |
| 658 | 661 |
ex_idx' = (Instance.pnode inst):ex_idx |
| 659 | 662 |
valid_nodes = filter (not . flip elem ex_idx' . Node.idx) all_nodes |
| 660 | 663 |
valid_idxes = map Node.idx valid_nodes |
| 661 |
sols1 = map (\x -> let (mnl, _, _, _) =
|
|
| 662 |
applyMove nl inst (ReplaceSecondary x)
|
|
| 663 |
in (mnl, [Container.find x nl]) |
|
| 664 |
sols1 = map (\x -> let (mnl, i, _, _) =
|
|
| 665 |
applyMove nl inst (ReplaceSecondary x) |
|
| 666 |
in (mnl, i, [Container.find x nl])
|
|
| 664 | 667 |
) valid_idxes |
| 665 | 668 |
in return sols1 |
| 666 | 669 |
|
| b/hail.hs | ||
|---|---|---|
| 44 | 44 |
import Ganeti.HTools.IAlloc |
| 45 | 45 |
import Ganeti.HTools.Types |
| 46 | 46 |
import Ganeti.HTools.Loader (RqType(..), Request(..)) |
| 47 |
import Ganeti.HTools.Utils |
|
| 47 | 48 |
|
| 48 | 49 |
-- | Command line options structure. |
| 49 | 50 |
data Options = Options |
| ... | ... | |
| 74 | 75 |
] |
| 75 | 76 |
|
| 76 | 77 |
|
| 77 |
filterFails :: (Monad m) => [(Maybe Node.List, [Node.Node])] |
|
| 78 |
filterFails :: (Monad m) => [(Maybe Node.List, Instance.Instance, [Node.Node])]
|
|
| 78 | 79 |
-> m [(Node.List, [Node.Node])] |
| 79 | 80 |
filterFails sols = |
| 80 | 81 |
if null sols then fail "No nodes onto which to allocate at all" |
| 81 |
else let sols' = filter (isJust . fst) sols |
|
| 82 |
else let sols' = filter (isJust . fst3) sols
|
|
| 82 | 83 |
in if null sols' then |
| 83 | 84 |
fail "No valid allocation solutions" |
| 84 | 85 |
else |
| 85 |
return $ map (\(x, y) -> (fromJust x, y)) sols' |
|
| 86 |
return $ map (\(x, _, y) -> (fromJust x, y)) sols'
|
|
| 86 | 87 |
|
| 87 | 88 |
processResults :: (Monad m) => [(Node.List, [Node.Node])] |
| 88 | 89 |
-> m (String, [Node.Node]) |
| b/hspace.hs | ||
|---|---|---|
| 132 | 132 |
"show help" |
| 133 | 133 |
] |
| 134 | 134 |
|
| 135 |
filterFails :: (Monad m) => [(Maybe Node.List, [Node.Node])] |
|
| 136 |
-> m [(Node.List, [Node.Node])] |
|
| 135 |
filterFails :: (Monad m) => [(Maybe Node.List, Instance.Instance, [Node.Node])]
|
|
| 136 |
-> m [(Node.List, Instance.Instance, [Node.Node])]
|
|
| 137 | 137 |
filterFails sols = |
| 138 | 138 |
if null sols then fail "No nodes onto which to allocate at all" |
| 139 |
else let sols' = filter (isJust . fst) sols |
|
| 139 |
else let sols' = filter (isJust . fst3) sols
|
|
| 140 | 140 |
in if null sols' then |
| 141 | 141 |
fail "No valid allocation solutions" |
| 142 | 142 |
else |
| 143 |
return $ map (\(x, y) -> (fromJust x, y)) sols'
|
|
| 143 |
return $ map (\(x, y, z) -> (fromJust x, y, z)) sols'
|
|
| 144 | 144 |
|
| 145 |
processResults :: (Monad m) => [(Node.List, [Node.Node])] |
|
| 146 |
-> m (Node.List, [Node.Node]) |
|
| 145 |
processResults :: (Monad m) => [(Node.List, Instance.Instance, [Node.Node])]
|
|
| 146 |
-> m (Node.List, Instance.Instance, [Node.Node])
|
|
| 147 | 147 |
processResults sols = |
| 148 |
let sols' = map (\(nl', ns) -> (Cluster.compCV nl', (nl', ns))) sols
|
|
| 148 |
let sols' = map (\e@(nl', _, _) -> (Cluster.compCV nl', e)) sols
|
|
| 149 | 149 |
sols'' = sortBy (compare `on` fst) sols' |
| 150 | 150 |
in return $ snd $ head sols'' |
| 151 | 151 |
|
| ... | ... | |
| 153 | 153 |
-> Instance.List |
| 154 | 154 |
-> Instance.Instance |
| 155 | 155 |
-> Int |
| 156 |
-> Int |
|
| 157 |
-> (Node.List, Int) |
|
| 158 |
iterateDepth nl il newinst nreq depth = |
|
| 159 |
let newname = printf "new-%d" depth |
|
| 156 |
-> [Instance.Instance] |
|
| 157 |
-> (Node.List, [Instance.Instance]) |
|
| 158 |
iterateDepth nl il newinst nreq ixes = |
|
| 159 |
let depth = length ixes |
|
| 160 |
newname = printf "new-%d" depth |
|
| 160 | 161 |
newidx = (length $ Container.elems il) + depth |
| 161 | 162 |
newi2 = Instance.setIdx (Instance.setName newinst newname) newidx |
| 162 | 163 |
sols = Cluster.tryAlloc nl il newi2 nreq |
| 163 |
orig = (nl, depth)
|
|
| 164 |
orig = (nl, ixes)
|
|
| 164 | 165 |
in |
| 165 | 166 |
if isNothing sols then orig |
| 166 | 167 |
else let sols' = fromJust sols |
| 167 | 168 |
sols'' = filterFails sols' |
| 168 | 169 |
in if isNothing sols'' then orig |
| 169 |
else let (xnl, _) = fromJust $ processResults $ fromJust sols'' |
|
| 170 |
in iterateDepth xnl il newinst nreq (depth+1) |
|
| 170 |
else let (xnl, xi, _) = fromJust $ processResults $ |
|
| 171 |
fromJust sols'' |
|
| 172 |
in iterateDepth xnl il newinst nreq (xi:ixes) |
|
| 171 | 173 |
|
| 172 | 174 |
|
| 173 | 175 |
-- | Main function. |
| ... | ... | |
| 183 | 185 |
let verbose = optVerbose opts |
| 184 | 186 |
|
| 185 | 187 |
(fixed_nl, il, csf) <- CLI.loadExternalData opts |
| 188 |
let num_instances = length $ Container.elems il |
|
| 186 | 189 |
|
| 187 | 190 |
let offline_names = optOffline opts |
| 188 | 191 |
all_nodes = Container.elems fixed_nl |
| ... | ... | |
| 193 | 196 |
all_nodes |
| 194 | 197 |
|
| 195 | 198 |
when (length offline_wrong > 0) $ do |
| 196 |
printf "Wrong node name(s) set as offline: %s\n" |
|
| 199 |
printf "Error: Wrong node name(s) set as offline: %s\n"
|
|
| 197 | 200 |
(commaJoin offline_wrong) |
| 198 | 201 |
exitWith $ ExitFailure 1 |
| 199 | 202 |
|
| ... | ... | |
| 206 | 209 |
|
| 207 | 210 |
let bad_nodes = fst $ Cluster.computeBadItems nl il |
| 208 | 211 |
when (length bad_nodes > 0) $ do |
| 209 |
putStrLn "Cluster not N+1, no space to allocate." |
|
| 212 |
putStrLn "Error: Cluster not N+1, no space to allocate."
|
|
| 210 | 213 |
exitWith $ ExitFailure 1 |
| 211 | 214 |
|
| 212 | 215 |
when (optShowNodes opts) $ |
| ... | ... | |
| 215 | 218 |
putStrLn $ Cluster.printNodes nl |
| 216 | 219 |
|
| 217 | 220 |
let ini_cv = Cluster.compCV nl |
| 221 |
(orig_mem, orig_disk) = Cluster.totalResources nl |
|
| 218 | 222 |
|
| 219 | 223 |
(if verbose > 2 then |
| 220 | 224 |
printf "Initial coefficients: overall %.8f, %s\n" |
| 221 | 225 |
ini_cv (Cluster.printStats nl) |
| 222 | 226 |
else |
| 223 | 227 |
printf "Initial score: %.8f\n" ini_cv) |
| 228 |
printf "Initial instances: %d\n" num_instances |
|
| 229 |
printf "Initial free RAM: %d\n" orig_mem |
|
| 230 |
printf "Initial free disk: %d\n" orig_disk |
|
| 224 | 231 |
|
| 225 |
let imlen = Container.maxNameLen il |
|
| 226 |
nmlen = Container.maxNameLen nl |
|
| 232 |
let nmlen = Container.maxNameLen nl |
|
| 227 | 233 |
newinst = Instance.create "new" (optIMem opts) (optIDsk opts) |
| 228 | 234 |
"ADMIN_down" (-1) (-1) |
| 229 | 235 |
|
| 230 |
let (fin_nl, fin_depth) = iterateDepth nl il newinst (optINodes opts) 0 |
|
| 231 |
|
|
| 232 |
unless (verbose == 0) $ |
|
| 233 |
printf "Solution length=%d\n" fin_depth |
|
| 236 |
let (fin_nl, ixes) = |
|
| 237 |
iterateDepth nl il newinst (optINodes opts) [] |
|
| 238 |
allocs = length ixes |
|
| 239 |
fin_instances = num_instances + allocs |
|
| 240 |
fin_ixes = reverse ixes |
|
| 241 |
ix_namelen = maximum . map (length . Instance.name) $ fin_ixes |
|
| 242 |
(final_mem, final_disk) = Cluster.totalResources fin_nl |
|
| 243 |
|
|
| 244 |
printf "Final score: %.8f\n" (Cluster.compCV fin_nl) |
|
| 245 |
printf "Final instances: %d\n" (num_instances + allocs) |
|
| 246 |
printf "Final free RAM: %d\n" final_mem |
|
| 247 |
printf "Final free disk: %d\n" final_disk |
|
| 248 |
printf "Usage: %.2f\n" (((fromIntegral num_instances)::Double) / |
|
| 249 |
(fromIntegral fin_instances)) |
|
| 250 |
printf "Allocations: %d\n" allocs |
|
| 251 |
when (verbose > 1) $ do |
|
| 252 |
putStr . unlines . map (\i -> printf "Inst: %*s %-*s %-*s" |
|
| 253 |
ix_namelen (Instance.name i) |
|
| 254 |
nmlen (Container.nameOf fin_nl $ Instance.pnode i) |
|
| 255 |
nmlen (Container.nameOf fin_nl $ Instance.snode i)) |
|
| 256 |
$ fin_ixes |
|
| 234 | 257 |
|
| 235 | 258 |
when (optShowNodes opts) $ |
| 236 | 259 |
do |
Also available in: Unified diff