Revision 47eed3f4 htools/Ganeti/HTools/Cluster.hs
b/htools/Ganeti/HTools/Cluster.hs | ||
---|---|---|
30 | 30 |
( |
31 | 31 |
-- * Types |
32 | 32 |
AllocSolution(..) |
33 |
, EvacSolution(..) |
|
33 | 34 |
, Table(..) |
34 | 35 |
, CStats(..) |
35 | 36 |
, AllocStats |
... | ... | |
62 | 63 |
, tryMGReloc |
63 | 64 |
, tryEvac |
64 | 65 |
, tryMGEvac |
66 |
, tryNodeEvac |
|
65 | 67 |
, collapseFailures |
66 | 68 |
-- * Allocation functions |
67 | 69 |
, iterateAlloc |
... | ... | |
101 | 103 |
, asLog :: [String] -- ^ A list of informational messages |
102 | 104 |
} |
103 | 105 |
|
106 |
-- | Node evacuation/group change iallocator result type. This result |
|
107 |
-- type consists of actual opcodes (a restricted subset) that are |
|
108 |
-- transmitted back to Ganeti. |
|
109 |
data EvacSolution = EvacSolution |
|
110 |
{ esMoved :: [String] -- ^ Instance moved successfully |
|
111 |
, esFailed :: [String] -- ^ Instance which were not |
|
112 |
-- relocated |
|
113 |
, esOpCodes :: [[[OpCodes.OpCode]]] -- ^ List of lists of jobs |
|
114 |
} |
|
115 |
|
|
104 | 116 |
-- | Allocation results, as used in 'iterateAlloc' and 'tieredAlloc'. |
105 | 117 |
type AllocResult = (FailStats, Node.List, Instance.List, |
106 | 118 |
[Instance.Instance], [CStats]) |
107 | 119 |
|
108 |
|
|
109 | 120 |
-- | A type denoting the valid allocation mode/pairs. |
110 | 121 |
-- |
111 | 122 |
-- For a one-node allocation, this will be a @Left ['Node.Node']@, |
... | ... | |
118 | 129 |
emptyAllocSolution = AllocSolution { asFailures = [], asAllocs = 0 |
119 | 130 |
, asSolutions = [], asLog = [] } |
120 | 131 |
|
132 |
-- | The empty evac solution. |
|
133 |
emptyEvacSolution :: EvacSolution |
|
134 |
emptyEvacSolution = EvacSolution { esMoved = [] |
|
135 |
, esFailed = [] |
|
136 |
, esOpCodes = [] |
|
137 |
} |
|
138 |
|
|
121 | 139 |
-- | The complete state for the balancing solution. |
122 | 140 |
data Table = Table Node.List Instance.List Score [Placement] |
123 | 141 |
deriving (Show, Read) |
... | ... | |
635 | 653 |
annotateSolution :: AllocSolution -> AllocSolution |
636 | 654 |
annotateSolution as = as { asLog = describeSolution as : asLog as } |
637 | 655 |
|
656 |
-- | Reverses an evacuation solution. |
|
657 |
-- |
|
658 |
-- Rationale: we always concat the results to the top of the lists, so |
|
659 |
-- for proper jobset execution, we should reverse all lists. |
|
660 |
reverseEvacSolution :: EvacSolution -> EvacSolution |
|
661 |
reverseEvacSolution (EvacSolution f m o) = |
|
662 |
EvacSolution (reverse f) (reverse m) (reverse o) |
|
663 |
|
|
638 | 664 |
-- | Generate the valid node allocation singles or pairs for a new instance. |
639 | 665 |
genAllocNodes :: Group.List -- ^ Group list |
640 | 666 |
-> Node.List -- ^ The node map |
... | ... | |
840 | 866 |
let sol = foldl' sumAllocs emptyAllocSolution results |
841 | 867 |
return $ annotateSolution sol |
842 | 868 |
|
869 |
-- | Function which fails if the requested mode is change secondary. |
|
870 |
-- |
|
871 |
-- This is useful since except DRBD, no other disk template can |
|
872 |
-- execute change secondary; thus, we can just call this function |
|
873 |
-- instead of always checking for secondary mode. After the call to |
|
874 |
-- this function, whatever mode we have is just a primary change. |
|
875 |
failOnSecondaryChange :: (Monad m) => EvacMode -> DiskTemplate -> m () |
|
876 |
failOnSecondaryChange ChangeSecondary dt = |
|
877 |
fail $ "Instances with disk template '" ++ dtToString dt ++ |
|
878 |
"' can't execute change secondary" |
|
879 |
failOnSecondaryChange _ _ = return () |
|
880 |
|
|
881 |
-- | Run evacuation for a single instance. |
|
882 |
nodeEvacInstance :: Node.List -- ^ The node list (cluster-wide) |
|
883 |
-> Instance.List -- ^ Instance list (cluster-wide) |
|
884 |
-> EvacMode -- ^ The evacuation mode |
|
885 |
-> Instance.Instance -- ^ The instance to be evacuated |
|
886 |
-> [Ndx] -- ^ The list of available nodes |
|
887 |
-- for allocation |
|
888 |
-> Result (Node.List, Instance.List, [OpCodes.OpCode]) |
|
889 |
nodeEvacInstance _ _ mode (Instance.Instance |
|
890 |
{Instance.diskTemplate = dt@DTDiskless}) _ = |
|
891 |
failOnSecondaryChange mode dt >> |
|
892 |
fail "Diskless relocations not implemented yet" |
|
893 |
|
|
894 |
nodeEvacInstance _ _ _ (Instance.Instance |
|
895 |
{Instance.diskTemplate = DTPlain}) _ = |
|
896 |
fail "Instances of type plain cannot be relocated" |
|
897 |
|
|
898 |
nodeEvacInstance _ _ _ (Instance.Instance |
|
899 |
{Instance.diskTemplate = DTFile}) _ = |
|
900 |
fail "Instances of type file cannot be relocated" |
|
901 |
|
|
902 |
nodeEvacInstance _ _ mode (Instance.Instance |
|
903 |
{Instance.diskTemplate = dt@DTSharedFile}) _ = |
|
904 |
failOnSecondaryChange mode dt >> |
|
905 |
fail "Shared file relocations not implemented yet" |
|
906 |
|
|
907 |
nodeEvacInstance _ _ mode (Instance.Instance |
|
908 |
{Instance.diskTemplate = dt@DTBlock}) _ = |
|
909 |
failOnSecondaryChange mode dt >> |
|
910 |
fail "Block device relocations not implemented yet" |
|
911 |
|
|
912 |
nodeEvacInstance _ _ _ (Instance.Instance |
|
913 |
{Instance.diskTemplate = DTDrbd8}) _ = |
|
914 |
fail "DRBD relocations not implemented yet" |
|
915 |
|
|
916 |
-- | Computes the local nodes of a given instance which are available |
|
917 |
-- for allocation. |
|
918 |
availableLocalNodes :: Node.List |
|
919 |
-> [(Gdx, [Ndx])] |
|
920 |
-> IntSet.IntSet |
|
921 |
-> Instance.Instance |
|
922 |
-> Result [Ndx] |
|
923 |
availableLocalNodes nl group_nodes excl_ndx inst = do |
|
924 |
let gdx = instancePriGroup nl inst |
|
925 |
local_nodes <- maybe (Bad $ "Can't find group with index " ++ show gdx) |
|
926 |
Ok (lookup gdx group_nodes) |
|
927 |
let avail_nodes = filter (not . flip IntSet.member excl_ndx) local_nodes |
|
928 |
return avail_nodes |
|
929 |
|
|
930 |
-- | Updates the evac solution with the results of an instance |
|
931 |
-- evacuation. |
|
932 |
updateEvacSolution :: (Node.List, Instance.List, EvacSolution) |
|
933 |
-> Instance.Instance |
|
934 |
-> Result (Node.List, Instance.List, [OpCodes.OpCode]) |
|
935 |
-> (Node.List, Instance.List, EvacSolution) |
|
936 |
updateEvacSolution (nl, il, es) inst (Bad msg) = |
|
937 |
(nl, il, es { esFailed = (Instance.name inst ++ ": " ++ msg):esFailed es}) |
|
938 |
updateEvacSolution (_, _, es) inst (Ok (nl, il, opcodes)) = |
|
939 |
(nl, il, es { esMoved = Instance.name inst:esMoved es |
|
940 |
, esOpCodes = [opcodes]:esOpCodes es }) |
|
941 |
|
|
942 |
-- | Node-evacuation IAllocator mode main function. |
|
943 |
tryNodeEvac :: Group.List -- ^ The cluster groups |
|
944 |
-> Node.List -- ^ The node list (cluster-wide, not per group) |
|
945 |
-> Instance.List -- ^ Instance list (cluster-wide) |
|
946 |
-> EvacMode -- ^ The evacuation mode |
|
947 |
-> [Idx] -- ^ List of instance (indices) to be evacuated |
|
948 |
-> Result EvacSolution |
|
949 |
tryNodeEvac _ ini_nl ini_il mode idxs = |
|
950 |
let evac_ndx = nodesToEvacuate ini_il mode idxs |
|
951 |
offline = map Node.idx . filter Node.offline $ Container.elems ini_nl |
|
952 |
excl_ndx = foldl' (flip IntSet.insert) evac_ndx offline |
|
953 |
group_ndx = map (\(gdx, (nl, _)) -> (gdx, map Node.idx |
|
954 |
(Container.elems nl))) $ |
|
955 |
splitCluster ini_nl ini_il |
|
956 |
(_, _, esol) = |
|
957 |
foldl' (\state@(nl, il, _) inst -> |
|
958 |
updateEvacSolution state inst $ |
|
959 |
availableLocalNodes nl group_ndx excl_ndx inst >>= |
|
960 |
nodeEvacInstance nl il mode inst |
|
961 |
) |
|
962 |
(ini_nl, ini_il, emptyEvacSolution) |
|
963 |
(map (`Container.find` ini_il) idxs) |
|
964 |
in return $ reverseEvacSolution esol |
|
965 |
|
|
843 | 966 |
-- | Recursively place instances on the cluster until we're out of space. |
844 | 967 |
iterateAlloc :: Node.List |
845 | 968 |
-> Instance.List |
Also available in: Unified diff