Revision ebf38064 htools/Ganeti/HTools/Loader.hs
| b/htools/Ganeti/HTools/Loader.hs | ||
|---|---|---|
| 27 | 27 |
-} |
| 28 | 28 |
|
| 29 | 29 |
module Ganeti.HTools.Loader |
| 30 |
( mergeData
|
|
| 31 |
, checkData
|
|
| 32 |
, assignIndices
|
|
| 33 |
, lookupName
|
|
| 34 |
, goodLookupResult
|
|
| 35 |
, lookupNode
|
|
| 36 |
, lookupInstance
|
|
| 37 |
, lookupGroup
|
|
| 38 |
, commonSuffix
|
|
| 39 |
, RqType(..)
|
|
| 40 |
, Request(..)
|
|
| 41 |
, ClusterData(..)
|
|
| 42 |
, emptyCluster
|
|
| 43 |
, compareNameComponent
|
|
| 44 |
, prefixMatch
|
|
| 45 |
, LookupResult(..)
|
|
| 46 |
, MatchPriority(..)
|
|
| 47 |
) where
|
|
| 30 |
( mergeData |
|
| 31 |
, checkData |
|
| 32 |
, assignIndices |
|
| 33 |
, lookupName |
|
| 34 |
, goodLookupResult |
|
| 35 |
, lookupNode |
|
| 36 |
, lookupInstance |
|
| 37 |
, lookupGroup |
|
| 38 |
, commonSuffix |
|
| 39 |
, RqType(..) |
|
| 40 |
, Request(..) |
|
| 41 |
, ClusterData(..) |
|
| 42 |
, emptyCluster |
|
| 43 |
, compareNameComponent |
|
| 44 |
, prefixMatch |
|
| 45 |
, LookupResult(..) |
|
| 46 |
, MatchPriority(..) |
|
| 47 |
) where |
|
| 48 | 48 |
|
| 49 | 49 |
import Data.List |
| 50 | 50 |
import Data.Function |
| ... | ... | |
| 74 | 74 |
|
| 75 | 75 |
-} |
| 76 | 76 |
data RqType |
| 77 |
= Allocate Instance.Instance Int -- ^ A new instance allocation
|
|
| 78 |
| Relocate Idx Int [Ndx] -- ^ Choose a new secondary node
|
|
| 79 |
| NodeEvacuate [Idx] EvacMode -- ^ node-evacuate mode
|
|
| 80 |
| ChangeGroup [Gdx] [Idx] -- ^ Multi-relocate mode
|
|
| 77 |
= Allocate Instance.Instance Int -- ^ A new instance allocation |
|
| 78 |
| Relocate Idx Int [Ndx] -- ^ Choose a new secondary node |
|
| 79 |
| NodeEvacuate [Idx] EvacMode -- ^ node-evacuate mode |
|
| 80 |
| ChangeGroup [Gdx] [Idx] -- ^ Multi-relocate mode |
|
| 81 | 81 |
deriving (Show, Read) |
| 82 | 82 |
|
| 83 | 83 |
-- | A complete request, as received from Ganeti. |
| 84 | 84 |
data Request = Request RqType ClusterData |
| 85 |
deriving (Show, Read) |
|
| 85 |
deriving (Show, Read)
|
|
| 86 | 86 |
|
| 87 | 87 |
-- | The cluster state. |
| 88 | 88 |
data ClusterData = ClusterData |
| 89 |
{ cdGroups :: Group.List -- ^ The node group list
|
|
| 90 |
, cdNodes :: Node.List -- ^ The node list
|
|
| 91 |
, cdInstances :: Instance.List -- ^ The instance list
|
|
| 92 |
, cdTags :: [String] -- ^ The cluster tags
|
|
| 93 |
} deriving (Show, Read)
|
|
| 89 |
{ cdGroups :: Group.List -- ^ The node group list
|
|
| 90 |
, cdNodes :: Node.List -- ^ The node list |
|
| 91 |
, cdInstances :: Instance.List -- ^ The instance list |
|
| 92 |
, cdTags :: [String] -- ^ The cluster tags |
|
| 93 |
} deriving (Show, Read) |
|
| 94 | 94 |
|
| 95 | 95 |
-- | The priority of a match in a lookup result. |
| 96 | 96 |
data MatchPriority = ExactMatch |
| ... | ... | |
| 101 | 101 |
|
| 102 | 102 |
-- | The result of a name lookup in a list. |
| 103 | 103 |
data LookupResult = LookupResult |
| 104 |
{ lrMatchPriority :: MatchPriority -- ^ The result type
|
|
| 105 |
-- | Matching value (for ExactMatch, PartialMatch), Lookup string otherwise
|
|
| 106 |
, lrContent :: String
|
|
| 107 |
} deriving (Show, Read)
|
|
| 104 |
{ lrMatchPriority :: MatchPriority -- ^ The result type
|
|
| 105 |
-- | Matching value (for ExactMatch, PartialMatch), Lookup string otherwise |
|
| 106 |
, lrContent :: String |
|
| 107 |
} deriving (Show, Read) |
|
| 108 | 108 |
|
| 109 | 109 |
-- | Lookup results have an absolute preference ordering. |
| 110 | 110 |
instance Eq LookupResult where |
| ... | ... | |
| 122 | 122 |
-- | Lookups a node into an assoc list. |
| 123 | 123 |
lookupNode :: (Monad m) => NameAssoc -> String -> String -> m Ndx |
| 124 | 124 |
lookupNode ktn inst node = |
| 125 |
case M.lookup node ktn of
|
|
| 126 |
Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst
|
|
| 127 |
Just idx -> return idx
|
|
| 125 |
case M.lookup node ktn of |
|
| 126 |
Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst |
|
| 127 |
Just idx -> return idx |
|
| 128 | 128 |
|
| 129 | 129 |
-- | Lookups an instance into an assoc list. |
| 130 | 130 |
lookupInstance :: (Monad m) => NameAssoc -> String -> m Idx |
| 131 | 131 |
lookupInstance kti inst = |
| 132 |
case M.lookup inst kti of
|
|
| 133 |
Nothing -> fail $ "Unknown instance '" ++ inst ++ "'"
|
|
| 134 |
Just idx -> return idx
|
|
| 132 |
case M.lookup inst kti of |
|
| 133 |
Nothing -> fail $ "Unknown instance '" ++ inst ++ "'" |
|
| 134 |
Just idx -> return idx |
|
| 135 | 135 |
|
| 136 | 136 |
-- | Lookups a group into an assoc list. |
| 137 | 137 |
lookupGroup :: (Monad m) => NameAssoc -> String -> String -> m Gdx |
| 138 | 138 |
lookupGroup ktg nname gname = |
| 139 |
case M.lookup gname ktg of
|
|
| 140 |
Nothing -> fail $ "Unknown group '" ++ gname ++ "' for node " ++ nname
|
|
| 141 |
Just idx -> return idx
|
|
| 139 |
case M.lookup gname ktg of |
|
| 140 |
Nothing -> fail $ "Unknown group '" ++ gname ++ "' for node " ++ nname |
|
| 141 |
Just idx -> return idx |
|
| 142 | 142 |
|
| 143 | 143 |
-- | Check for prefix matches in names. |
| 144 | 144 |
-- Implemented in Ganeti core utils.text.MatchNameComponent |
| ... | ... | |
| 206 | 206 |
-> Instance.Instance |
| 207 | 207 |
-> Node.List |
| 208 | 208 |
fixNodes accu inst = |
| 209 |
let |
|
| 210 |
pdx = Instance.pNode inst |
|
| 211 |
sdx = Instance.sNode inst |
|
| 212 |
pold = Container.find pdx accu |
|
| 213 |
pnew = Node.setPri pold inst |
|
| 214 |
ac2 = Container.add pdx pnew accu |
|
| 215 |
in |
|
| 216 |
if sdx /= Node.noSecondary |
|
| 217 |
then let sold = Container.find sdx accu |
|
| 218 |
snew = Node.setSec sold inst |
|
| 219 |
in Container.add sdx snew ac2 |
|
| 220 |
else ac2 |
|
| 209 |
let pdx = Instance.pNode inst |
|
| 210 |
sdx = Instance.sNode inst |
|
| 211 |
pold = Container.find pdx accu |
|
| 212 |
pnew = Node.setPri pold inst |
|
| 213 |
ac2 = Container.add pdx pnew accu |
|
| 214 |
in if sdx /= Node.noSecondary |
|
| 215 |
then let sold = Container.find sdx accu |
|
| 216 |
snew = Node.setSec sold inst |
|
| 217 |
in Container.add sdx snew ac2 |
|
| 218 |
else ac2 |
|
| 221 | 219 |
|
| 222 | 220 |
-- | Remove non-selected tags from the exclusion list. |
| 223 | 221 |
filterExTags :: [String] -> Instance.Instance -> Instance.Instance |
| 224 | 222 |
filterExTags tl inst = |
| 225 |
let old_tags = Instance.tags inst |
|
| 226 |
new_tags = filter (\tag -> any (`isPrefixOf` tag) tl) |
|
| 227 |
old_tags |
|
| 228 |
in inst { Instance.tags = new_tags }
|
|
| 223 |
let old_tags = Instance.tags inst |
|
| 224 |
new_tags = filter (\tag -> any (`isPrefixOf` tag) tl) old_tags |
|
| 225 |
in inst { Instance.tags = new_tags }
|
|
| 229 | 226 |
|
| 230 | 227 |
-- | Update the movable attribute. |
| 231 | 228 |
updateMovable :: [String] -- ^ Selected instances (if not empty) |
| ... | ... | |
| 233 | 230 |
-> Instance.Instance -- ^ Target Instance |
| 234 | 231 |
-> Instance.Instance -- ^ Target Instance with updated attribute |
| 235 | 232 |
updateMovable selinsts exinsts inst = |
| 236 |
if Instance.sNode inst == Node.noSecondary ||
|
|
| 237 |
Instance.name inst `elem` exinsts ||
|
|
| 238 |
not (null selinsts || Instance.name inst `elem` selinsts)
|
|
| 233 |
if Instance.sNode inst == Node.noSecondary || |
|
| 234 |
Instance.name inst `elem` exinsts || |
|
| 235 |
not (null selinsts || Instance.name inst `elem` selinsts) |
|
| 239 | 236 |
then Instance.setMovable inst False |
| 240 | 237 |
else inst |
| 241 | 238 |
|
| ... | ... | |
| 244 | 241 |
longestDomain :: [String] -> String |
| 245 | 242 |
longestDomain [] = "" |
| 246 | 243 |
longestDomain (x:xs) = |
| 247 |
foldr (\ suffix accu -> if all (isSuffixOf suffix) xs
|
|
| 248 |
then suffix
|
|
| 249 |
else accu)
|
|
| 250 |
"" $ filter (isPrefixOf ".") (tails x) |
|
| 244 |
foldr (\ suffix accu -> if all (isSuffixOf suffix) xs |
|
| 245 |
then suffix |
|
| 246 |
else accu) |
|
| 247 |
"" $ filter (isPrefixOf ".") (tails x)
|
|
| 251 | 248 |
|
| 252 | 249 |
-- | Extracts the exclusion tags from the cluster configuration. |
| 253 | 250 |
extractExTags :: [String] -> [String] |
| 254 | 251 |
extractExTags = |
| 255 |
map (drop (length exTagsPrefix)) .
|
|
| 256 |
filter (isPrefixOf exTagsPrefix)
|
|
| 252 |
map (drop (length exTagsPrefix)) . |
|
| 253 |
filter (isPrefixOf exTagsPrefix) |
|
| 257 | 254 |
|
| 258 | 255 |
-- | Extracts the common suffix from node\/instance names. |
| 259 | 256 |
commonSuffix :: Node.List -> Instance.List -> String |
| 260 | 257 |
commonSuffix nl il = |
| 261 |
let node_names = map Node.name $ Container.elems nl
|
|
| 262 |
inst_names = map Instance.name $ Container.elems il
|
|
| 263 |
in longestDomain (node_names ++ inst_names)
|
|
| 258 |
let node_names = map Node.name $ Container.elems nl |
|
| 259 |
inst_names = map Instance.name $ Container.elems il |
|
| 260 |
in longestDomain (node_names ++ inst_names) |
|
| 264 | 261 |
|
| 265 | 262 |
-- | Initializer function that loads the data from a node and instance |
| 266 | 263 |
-- list and massages it into the correct format. |
| ... | ... | |
| 328 | 325 |
-- | Compute the amount of memory used by primary instances on a node. |
| 329 | 326 |
nodeImem :: Node.Node -> Instance.List -> Int |
| 330 | 327 |
nodeImem node il = |
| 331 |
let rfind = flip Container.find il
|
|
| 332 |
il' = map rfind $ Node.pList node
|
|
| 333 |
oil' = filter (not . Instance.instanceOffline) il'
|
|
| 334 |
in sum . map Instance.mem $ oil'
|
|
| 328 |
let rfind = flip Container.find il |
|
| 329 |
il' = map rfind $ Node.pList node |
|
| 330 |
oil' = filter (not . Instance.instanceOffline) il' |
|
| 331 |
in sum . map Instance.mem $ oil' |
|
| 335 | 332 |
|
| 336 | 333 |
|
| 337 | 334 |
-- | Compute the amount of disk used by instances on a node (either primary |
| 338 | 335 |
-- or secondary). |
| 339 | 336 |
nodeIdsk :: Node.Node -> Instance.List -> Int |
| 340 | 337 |
nodeIdsk node il = |
| 341 |
let rfind = flip Container.find il |
|
| 342 |
in sum . map (Instance.dsk . rfind) |
|
| 343 |
$ Node.pList node ++ Node.sList node |
|
| 338 |
let rfind = flip Container.find il |
|
| 339 |
in sum . map (Instance.dsk . rfind) |
|
| 340 |
$ Node.pList node ++ Node.sList node |
|
Also available in: Unified diff