Revision dbba5246
| b/Ganeti/HTools/Cluster.hs | ||
|---|---|---|
| 33 | 33 |
-- * IAllocator functions |
| 34 | 34 |
, allocateOnSingle |
| 35 | 35 |
, allocateOnPair |
| 36 |
, tryAlloc |
|
| 37 |
, tryReloc |
|
| 36 | 38 |
) where |
| 37 | 39 |
|
| 38 | 40 |
import Data.List |
| ... | ... | |
| 109 | 111 |
computeBadItems :: Node.List -> Instance.List -> |
| 110 | 112 |
([Node.Node], [Instance.Instance]) |
| 111 | 113 |
computeBadItems nl il = |
| 112 |
let bad_nodes = verifyN1 $ filter (not . Node.offline) $ Container.elems nl
|
|
| 114 |
let bad_nodes = verifyN1 $ getOnline nl
|
|
| 113 | 115 |
bad_instances = map (\idx -> Container.find idx il) $ |
| 114 | 116 |
sort $ nub $ concat $ |
| 115 | 117 |
map (\ n -> (Node.slist n) ++ (Node.plist n)) bad_nodes |
| ... | ... | |
| 152 | 154 |
let (mem_cv, dsk_cv, n1_score, res_cv, off_score) = compDetailedCV nl |
| 153 | 155 |
in mem_cv + dsk_cv + n1_score + res_cv + off_score |
| 154 | 156 |
|
| 157 |
-- | Compute online nodes from a Node.List |
|
| 158 |
getOnline :: Node.List -> [Node.Node] |
|
| 159 |
getOnline = filter (not . Node.offline) . Container.elems |
|
| 160 |
|
|
| 155 | 161 |
-- * hn1 functions |
| 156 | 162 |
|
| 157 | 163 |
-- | Add an instance and return the new node and instance maps. |
| ... | ... | |
| 589 | 595 |
else |
| 590 | 596 |
best_tbl |
| 591 | 597 |
|
| 598 |
-- * Alocation functions |
|
| 599 |
|
|
| 600 |
-- | Try to allocate an instance on the cluster. |
|
| 601 |
tryAlloc :: (Monad m) => |
|
| 602 |
Node.List -- ^ The node list |
|
| 603 |
-> Instance.List -- ^ The instance list |
|
| 604 |
-> Instance.Instance -- ^ The instance to allocate |
|
| 605 |
-> Int -- ^ Required number of nodes |
|
| 606 |
-> m [(Maybe Node.List, [Node.Node])] -- ^ Possible solution list |
|
| 607 |
tryAlloc nl _ inst 2 = |
|
| 608 |
let all_nodes = getOnline nl |
|
| 609 |
all_pairs = liftM2 (,) all_nodes all_nodes |
|
| 610 |
ok_pairs = filter (\(x, y) -> Node.idx x /= Node.idx y) all_pairs |
|
| 611 |
sols = map (\(p, s) -> |
|
| 612 |
(fst $ allocateOnPair nl inst p s, [p, s])) |
|
| 613 |
ok_pairs |
|
| 614 |
in return sols |
|
| 615 |
|
|
| 616 |
tryAlloc nl _ inst 1 = |
|
| 617 |
let all_nodes = getOnline nl |
|
| 618 |
sols = map (\p -> (fst $ allocateOnSingle nl inst p, [p])) |
|
| 619 |
all_nodes |
|
| 620 |
in return sols |
|
| 621 |
|
|
| 622 |
tryAlloc _ _ _ reqn = fail $ "Unsupported number of alllocation \ |
|
| 623 |
\destinations required (" ++ (show reqn) ++
|
|
| 624 |
"), only two supported" |
|
| 625 |
|
|
| 626 |
-- | Try to allocate an instance on the cluster. |
|
| 627 |
tryReloc :: (Monad m) => |
|
| 628 |
Node.List -- ^ The node list |
|
| 629 |
-> Instance.List -- ^ The instance list |
|
| 630 |
-> Idx -- ^ The index of the instance to move |
|
| 631 |
-> Int -- ^ The numver of nodes required |
|
| 632 |
-> [Ndx] -- ^ Nodes which should not be used |
|
| 633 |
-> m [(Maybe Node.List, [Node.Node])] -- ^ Solution list |
|
| 634 |
tryReloc nl il xid 1 ex_idx = |
|
| 635 |
let all_nodes = getOnline nl |
|
| 636 |
inst = Container.find xid il |
|
| 637 |
ex_idx' = (Instance.pnode inst):ex_idx |
|
| 638 |
valid_nodes = filter (not . flip elem ex_idx' . Node.idx) all_nodes |
|
| 639 |
valid_idxes = map Node.idx valid_nodes |
|
| 640 |
sols1 = map (\x -> let (mnl, _, _, _) = |
|
| 641 |
applyMove nl inst (ReplaceSecondary x) |
|
| 642 |
in (mnl, [Container.find x nl]) |
|
| 643 |
) valid_idxes |
|
| 644 |
in return sols1 |
|
| 645 |
|
|
| 646 |
tryReloc _ _ _ reqn _ = fail $ "Unsupported number of relocation \ |
|
| 647 |
\destinations required (" ++ (show reqn) ++
|
|
| 648 |
"), only one supported" |
|
| 592 | 649 |
|
| 593 | 650 |
-- * Formatting functions |
| 594 | 651 |
|
| b/hail.hs | ||
|---|---|---|
| 52 | 52 |
"show help" |
| 53 | 53 |
] |
| 54 | 54 |
|
| 55 |
-- | Compute online nodes from a Node.List |
|
| 56 |
getOnline :: Node.List -> [Node.Node] |
|
| 57 |
getOnline = filter (not . Node.offline) . Container.elems |
|
| 58 |
|
|
| 59 |
-- | Try to allocate an instance on the cluster |
|
| 60 |
tryAlloc :: (Monad m) => |
|
| 61 |
Node.List |
|
| 62 |
-> Instance.List |
|
| 63 |
-> Instance.Instance |
|
| 64 |
-> Int |
|
| 65 |
-> m [(Maybe Node.List, [Node.Node])] |
|
| 66 |
tryAlloc nl _ inst 2 = |
|
| 67 |
let all_nodes = getOnline nl |
|
| 68 |
all_pairs = liftM2 (,) all_nodes all_nodes |
|
| 69 |
ok_pairs = filter (\(x, y) -> Node.idx x /= Node.idx y) all_pairs |
|
| 70 |
sols = map (\(p, s) -> |
|
| 71 |
(fst $ Cluster.allocateOnPair nl inst p s, [p, s])) |
|
| 72 |
ok_pairs |
|
| 73 |
in return sols |
|
| 74 |
|
|
| 75 |
tryAlloc nl _ inst 1 = |
|
| 76 |
let all_nodes = getOnline nl |
|
| 77 |
sols = map (\p -> (fst $ Cluster.allocateOnSingle nl inst p, [p])) |
|
| 78 |
all_nodes |
|
| 79 |
in return sols |
|
| 80 |
|
|
| 81 |
tryAlloc _ _ _ reqn = fail $ "Unsupported number of alllocation \ |
|
| 82 |
\destinations required (" ++ (show reqn) ++
|
|
| 83 |
"), only two supported" |
|
| 84 |
|
|
| 85 |
-- | Try to allocate an instance on the cluster |
|
| 86 |
tryReloc :: (Monad m) => |
|
| 87 |
Node.List |
|
| 88 |
-> Instance.List |
|
| 89 |
-> Idx |
|
| 90 |
-> Int |
|
| 91 |
-> [Ndx] |
|
| 92 |
-> m [(Maybe Node.List, [Node.Node])] |
|
| 93 |
tryReloc nl il xid 1 ex_idx = |
|
| 94 |
let all_nodes = getOnline nl |
|
| 95 |
inst = Container.find xid il |
|
| 96 |
ex_idx' = (Instance.pnode inst):ex_idx |
|
| 97 |
valid_nodes = filter (not . flip elem ex_idx' . Node.idx) all_nodes |
|
| 98 |
valid_idxes = map Node.idx valid_nodes |
|
| 99 |
sols1 = map (\x -> let (mnl, _, _, _) = |
|
| 100 |
Cluster.applyMove nl inst |
|
| 101 |
(Cluster.ReplaceSecondary x) |
|
| 102 |
in (mnl, [Container.find x nl]) |
|
| 103 |
) valid_idxes |
|
| 104 |
in return sols1 |
|
| 105 |
|
|
| 106 |
tryReloc _ _ _ reqn _ = fail $ "Unsupported number of relocation \ |
|
| 107 |
\destinations required (" ++ (show reqn) ++
|
|
| 108 |
"), only one supported" |
|
| 109 | 55 |
|
| 110 | 56 |
filterFails :: (Monad m) => [(Maybe Node.List, [Node.Node])] |
| 111 | 57 |
-> m [(Node.List, [Node.Node])] |
| ... | ... | |
| 151 | 97 |
|
| 152 | 98 |
let Request rqtype nl il csf = request |
| 153 | 99 |
new_nodes = case rqtype of |
| 154 |
Allocate xi reqn -> tryAlloc nl il xi reqn |
|
| 100 |
Allocate xi reqn -> Cluster.tryAlloc nl il xi reqn
|
|
| 155 | 101 |
Relocate idx reqn exnodes -> |
| 156 |
tryReloc nl il idx reqn exnodes |
|
| 102 |
Cluster.tryReloc nl il idx reqn exnodes
|
|
| 157 | 103 |
let sols = new_nodes >>= filterFails >>= processResults |
| 158 | 104 |
let (ok, info, rn) = case sols of |
| 159 | 105 |
Ok (info, sn) -> (True, "Request successful: " ++ info, |
Also available in: Unified diff