root / src / Ganeti / HTools / Loader.hs @ 9d049fb4
History | View | Annotate | Download (13.5 kB)
1 |
{-| Generic data loader. |
---|---|
2 |
|
3 |
This module holds the common code for parsing the input data after it |
4 |
has been loaded from external sources. |
5 |
|
6 |
-} |
7 |
|
8 |
{- |
9 |
|
10 |
Copyright (C) 2009, 2010, 2011, 2012 Google Inc. |
11 |
|
12 |
This program is free software; you can redistribute it and/or modify |
13 |
it under the terms of the GNU General Public License as published by |
14 |
the Free Software Foundation; either version 2 of the License, or |
15 |
(at your option) any later version. |
16 |
|
17 |
This program is distributed in the hope that it will be useful, but |
18 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
19 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
20 |
General Public License for more details. |
21 |
|
22 |
You should have received a copy of the GNU General Public License |
23 |
along with this program; if not, write to the Free Software |
24 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
25 |
02110-1301, USA. |
26 |
|
27 |
-} |
28 |
|
29 |
module Ganeti.HTools.Loader |
30 |
( mergeData |
31 |
, clearDynU |
32 |
, checkData |
33 |
, assignIndices |
34 |
, setMaster |
35 |
, lookupNode |
36 |
, lookupInstance |
37 |
, lookupGroup |
38 |
, eitherLive |
39 |
, commonSuffix |
40 |
, RqType(..) |
41 |
, Request(..) |
42 |
, ClusterData(..) |
43 |
, emptyCluster |
44 |
) where |
45 |
|
46 |
import Control.Monad |
47 |
import Data.List |
48 |
import qualified Data.Map as M |
49 |
import Data.Maybe |
50 |
import Text.Printf (printf) |
51 |
import System.Time (ClockTime(..)) |
52 |
|
53 |
import qualified Ganeti.HTools.Container as Container |
54 |
import qualified Ganeti.HTools.Instance as Instance |
55 |
import qualified Ganeti.HTools.Node as Node |
56 |
import qualified Ganeti.HTools.Group as Group |
57 |
import qualified Ganeti.HTools.Cluster as Cluster |
58 |
|
59 |
import Ganeti.BasicTypes |
60 |
import qualified Ganeti.Constants as C |
61 |
import Ganeti.HTools.Types |
62 |
import Ganeti.Utils |
63 |
import Ganeti.Types (EvacMode) |
64 |
|
65 |
-- * Constants |
66 |
|
67 |
-- | The exclusion tag prefix. |
68 |
exTagsPrefix :: String |
69 |
exTagsPrefix = "htools:iextags:" |
70 |
|
71 |
-- * Types |
72 |
|
73 |
{-| The iallocator request type. |
74 |
|
75 |
This type denotes what request we got from Ganeti and also holds |
76 |
request-specific fields. |
77 |
|
78 |
-} |
79 |
data RqType |
80 |
= Allocate Instance.Instance Int -- ^ A new instance allocation |
81 |
| Relocate Idx Int [Ndx] -- ^ Choose a new secondary node |
82 |
| NodeEvacuate [Idx] EvacMode -- ^ node-evacuate mode |
83 |
| ChangeGroup [Gdx] [Idx] -- ^ Multi-relocate mode |
84 |
| MultiAllocate [(Instance.Instance, Int)] -- ^ Multi-allocate mode |
85 |
deriving (Show) |
86 |
|
87 |
-- | A complete request, as received from Ganeti. |
88 |
data Request = Request RqType ClusterData |
89 |
deriving (Show) |
90 |
|
91 |
-- | The cluster state. |
92 |
data ClusterData = ClusterData |
93 |
{ cdGroups :: Group.List -- ^ The node group list |
94 |
, cdNodes :: Node.List -- ^ The node list |
95 |
, cdInstances :: Instance.List -- ^ The instance list |
96 |
, cdTags :: [String] -- ^ The cluster tags |
97 |
, cdIPolicy :: IPolicy -- ^ The cluster instance policy |
98 |
} deriving (Show, Eq) |
99 |
|
100 |
-- | An empty cluster. |
101 |
emptyCluster :: ClusterData |
102 |
emptyCluster = ClusterData Container.empty Container.empty Container.empty [] |
103 |
defIPolicy |
104 |
|
105 |
-- * Functions |
106 |
|
107 |
-- | Lookups a node into an assoc list. |
108 |
lookupNode :: (Monad m) => NameAssoc -> String -> String -> m Ndx |
109 |
lookupNode ktn inst node = |
110 |
maybe (fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst) return $ |
111 |
M.lookup node ktn |
112 |
|
113 |
-- | Lookups an instance into an assoc list. |
114 |
lookupInstance :: (Monad m) => NameAssoc -> String -> m Idx |
115 |
lookupInstance kti inst = |
116 |
maybe (fail $ "Unknown instance '" ++ inst ++ "'") return $ M.lookup inst kti |
117 |
|
118 |
-- | Lookups a group into an assoc list. |
119 |
lookupGroup :: (Monad m) => NameAssoc -> String -> String -> m Gdx |
120 |
lookupGroup ktg nname gname = |
121 |
maybe (fail $ "Unknown group '" ++ gname ++ "' for node " ++ nname) return $ |
122 |
M.lookup gname ktg |
123 |
|
124 |
-- | Given a list of elements (and their names), assign indices to them. |
125 |
assignIndices :: (Element a) => |
126 |
[(String, a)] |
127 |
-> (NameAssoc, Container.Container a) |
128 |
assignIndices name_element = |
129 |
let (name_idx, idx_element) = |
130 |
unzip . map (\ (idx, (k, v)) -> ((k, idx), (idx, setIdx v idx))) |
131 |
. zip [0..] $ name_element |
132 |
in (M.fromList name_idx, Container.fromList idx_element) |
133 |
|
134 |
-- | Given am indexed node list, and the name of the master, mark it as such. |
135 |
setMaster :: (Monad m) => NameAssoc -> Node.List -> String -> m Node.List |
136 |
setMaster node_names node_idx master = do |
137 |
kmaster <- maybe (fail $ "Master node " ++ master ++ " unknown") return $ |
138 |
M.lookup master node_names |
139 |
let mnode = Container.find kmaster node_idx |
140 |
return $ Container.add kmaster (Node.setMaster mnode True) node_idx |
141 |
|
142 |
-- | For each instance, add its index to its primary and secondary nodes. |
143 |
fixNodes :: Node.List |
144 |
-> Instance.Instance |
145 |
-> Node.List |
146 |
fixNodes accu inst = |
147 |
let pdx = Instance.pNode inst |
148 |
sdx = Instance.sNode inst |
149 |
pold = Container.find pdx accu |
150 |
pnew = Node.setPri pold inst |
151 |
ac2 = Container.add pdx pnew accu |
152 |
in if sdx /= Node.noSecondary |
153 |
then let sold = Container.find sdx accu |
154 |
snew = Node.setSec sold inst |
155 |
in Container.add sdx snew ac2 |
156 |
else ac2 |
157 |
|
158 |
-- | Set the node's policy to its group one. Note that this requires |
159 |
-- the group to exist (should have been checked before), otherwise it |
160 |
-- will abort with a runtime error. |
161 |
setNodePolicy :: Group.List -> Node.Node -> Node.Node |
162 |
setNodePolicy gl node = |
163 |
let grp = Container.find (Node.group node) gl |
164 |
gpol = Group.iPolicy grp |
165 |
in Node.setPolicy gpol node |
166 |
|
167 |
-- | Update instance with exclusion tags list. |
168 |
updateExclTags :: [String] -> Instance.Instance -> Instance.Instance |
169 |
updateExclTags tl inst = |
170 |
let allTags = Instance.allTags inst |
171 |
exclTags = filter (\tag -> any (`isPrefixOf` tag) tl) allTags |
172 |
in inst { Instance.exclTags = exclTags } |
173 |
|
174 |
-- | Update the movable attribute. |
175 |
updateMovable :: [String] -- ^ Selected instances (if not empty) |
176 |
-> [String] -- ^ Excluded instances |
177 |
-> Instance.Instance -- ^ Target Instance |
178 |
-> Instance.Instance -- ^ Target Instance with updated attribute |
179 |
updateMovable selinsts exinsts inst = |
180 |
if Instance.name inst `elem` exinsts || |
181 |
not (null selinsts || Instance.name inst `elem` selinsts) |
182 |
then Instance.setMovable inst False |
183 |
else inst |
184 |
|
185 |
-- | Disables moves for instances with a split group. |
186 |
disableSplitMoves :: Node.List -> Instance.Instance -> Instance.Instance |
187 |
disableSplitMoves nl inst = |
188 |
if not . isOk . Cluster.instanceGroup nl $ inst |
189 |
then Instance.setMovable inst False |
190 |
else inst |
191 |
|
192 |
-- | Set the auto-repair policy for an instance. |
193 |
setArPolicy :: [String] -- ^ Cluster tags |
194 |
-> Group.List -- ^ List of node groups |
195 |
-> Node.List -- ^ List of nodes |
196 |
-> Instance.List -- ^ List of instances |
197 |
-> ClockTime -- ^ Current timestamp, to evaluate ArSuspended |
198 |
-> Instance.List -- ^ Updated list of instances |
199 |
setArPolicy ctags gl nl il time = |
200 |
let getArPolicy' = flip getArPolicy time |
201 |
cpol = fromMaybe ArNotEnabled $ getArPolicy' ctags |
202 |
gpols = Container.map (fromMaybe cpol . getArPolicy' . Group.allTags) gl |
203 |
ipolfn = getArPolicy' . Instance.allTags |
204 |
nlookup = flip Container.find nl . Instance.pNode |
205 |
glookup = flip Container.find gpols . Node.group . nlookup |
206 |
updateInstance inst = inst { |
207 |
Instance.arPolicy = fromMaybe (glookup inst) $ ipolfn inst } |
208 |
in |
209 |
Container.map updateInstance il |
210 |
|
211 |
-- | Get the auto-repair policy from a list of tags. |
212 |
-- |
213 |
-- This examines the ganeti:watcher:autorepair and |
214 |
-- ganeti:watcher:autorepair:suspend tags to determine the policy. If none of |
215 |
-- these tags are present, Nothing (and not ArNotEnabled) is returned. |
216 |
getArPolicy :: [String] -> ClockTime -> Maybe AutoRepairPolicy |
217 |
getArPolicy tags time = |
218 |
let enabled = mapMaybe (autoRepairTypeFromRaw <=< |
219 |
chompPrefix C.autoRepairTagEnabled) tags |
220 |
suspended = mapMaybe (chompPrefix C.autoRepairTagSuspended) tags |
221 |
futureTs = filter (> time) . map (flip TOD 0) $ |
222 |
mapMaybe (tryRead "auto-repair suspend time") suspended |
223 |
in |
224 |
case () of |
225 |
-- Note how we must return ArSuspended even if "enabled" is empty, so that |
226 |
-- node groups or instances can suspend repairs that were enabled at an |
227 |
-- upper scope (cluster or node group). |
228 |
_ | "" `elem` suspended -> Just $ ArSuspended Forever |
229 |
| not $ null futureTs -> Just . ArSuspended . Until . maximum $ futureTs |
230 |
| not $ null enabled -> Just $ ArEnabled (minimum enabled) |
231 |
| otherwise -> Nothing |
232 |
|
233 |
-- | Compute the longest common suffix of a list of strings that |
234 |
-- starts with a dot. |
235 |
longestDomain :: [String] -> String |
236 |
longestDomain [] = "" |
237 |
longestDomain (x:xs) = |
238 |
foldr (\ suffix accu -> if all (isSuffixOf suffix) xs |
239 |
then suffix |
240 |
else accu) |
241 |
"" $ filter (isPrefixOf ".") (tails x) |
242 |
|
243 |
-- | Extracts the exclusion tags from the cluster configuration. |
244 |
extractExTags :: [String] -> [String] |
245 |
extractExTags = filter (not . null) . mapMaybe (chompPrefix exTagsPrefix) |
246 |
|
247 |
-- | Extracts the common suffix from node\/instance names. |
248 |
commonSuffix :: Node.List -> Instance.List -> String |
249 |
commonSuffix nl il = |
250 |
let node_names = map Node.name $ Container.elems nl |
251 |
inst_names = map Instance.name $ Container.elems il |
252 |
in longestDomain (node_names ++ inst_names) |
253 |
|
254 |
-- | Initializer function that loads the data from a node and instance |
255 |
-- list and massages it into the correct format. |
256 |
mergeData :: [(String, DynUtil)] -- ^ Instance utilisation data |
257 |
-> [String] -- ^ Exclusion tags |
258 |
-> [String] -- ^ Selected instances (if not empty) |
259 |
-> [String] -- ^ Excluded instances |
260 |
-> ClockTime -- ^ The current timestamp |
261 |
-> ClusterData -- ^ Data from backends |
262 |
-> Result ClusterData -- ^ Fixed cluster data |
263 |
mergeData um extags selinsts exinsts time cdata@(ClusterData gl nl il ctags _) = |
264 |
let il2 = setArPolicy ctags gl nl il time |
265 |
il3 = foldl' (\im (name, n_util) -> |
266 |
case Container.findByName im name of |
267 |
Nothing -> im -- skipping unknown instance |
268 |
Just inst -> |
269 |
let new_i = inst { Instance.util = n_util } |
270 |
in Container.add (Instance.idx inst) new_i im |
271 |
) il2 um |
272 |
allextags = extags ++ extractExTags ctags |
273 |
inst_names = map Instance.name $ Container.elems il3 |
274 |
selinst_lkp = map (lookupName inst_names) selinsts |
275 |
exinst_lkp = map (lookupName inst_names) exinsts |
276 |
lkp_unknown = filter (not . goodLookupResult) (selinst_lkp ++ exinst_lkp) |
277 |
selinst_names = map lrContent selinst_lkp |
278 |
exinst_names = map lrContent exinst_lkp |
279 |
node_names = map Node.name (Container.elems nl) |
280 |
common_suffix = longestDomain (node_names ++ inst_names) |
281 |
il4 = Container.map (computeAlias common_suffix . |
282 |
updateExclTags allextags . |
283 |
updateMovable selinst_names exinst_names) il3 |
284 |
nl2 = foldl' fixNodes nl (Container.elems il4) |
285 |
nl3 = Container.map (setNodePolicy gl . |
286 |
computeAlias common_suffix . |
287 |
(`Node.buildPeers` il4)) nl2 |
288 |
il5 = Container.map (disableSplitMoves nl3) il4 |
289 |
in if' (null lkp_unknown) |
290 |
(Ok cdata { cdNodes = nl3, cdInstances = il5 }) |
291 |
(Bad $ "Unknown instance(s): " ++ show(map lrContent lkp_unknown)) |
292 |
|
293 |
-- | In a cluster description, clear dynamic utilisation information. |
294 |
clearDynU :: ClusterData -> Result ClusterData |
295 |
clearDynU cdata@(ClusterData _ _ il _ _) = |
296 |
let il2 = Container.map (\ inst -> inst {Instance.util = zeroUtil }) il |
297 |
in Ok cdata { cdInstances = il2 } |
298 |
|
299 |
-- | Checks the cluster data for consistency. |
300 |
checkData :: Node.List -> Instance.List |
301 |
-> ([String], Node.List) |
302 |
checkData nl il = |
303 |
Container.mapAccum |
304 |
(\ msgs node -> |
305 |
let nname = Node.name node |
306 |
nilst = map (`Container.find` il) (Node.pList node) |
307 |
dilst = filter Instance.instanceDown nilst |
308 |
adj_mem = sum . map Instance.mem $ dilst |
309 |
delta_mem = truncate (Node.tMem node) |
310 |
- Node.nMem node |
311 |
- Node.fMem node |
312 |
- nodeImem node il |
313 |
+ adj_mem |
314 |
delta_dsk = truncate (Node.tDsk node) |
315 |
- Node.fDsk node |
316 |
- nodeIdsk node il |
317 |
newn = Node.setFmem (Node.setXmem node delta_mem) |
318 |
(Node.fMem node - adj_mem) |
319 |
umsg1 = |
320 |
if delta_mem > 512 || delta_dsk > 1024 |
321 |
then printf "node %s is missing %d MB ram \ |
322 |
\and %d GB disk" |
323 |
nname delta_mem (delta_dsk `div` 1024):msgs |
324 |
else msgs |
325 |
in (umsg1, newn) |
326 |
) [] nl |
327 |
|
328 |
-- | Compute the amount of memory used by primary instances on a node. |
329 |
nodeImem :: Node.Node -> Instance.List -> Int |
330 |
nodeImem node il = |
331 |
let rfind = flip Container.find il |
332 |
il' = map rfind $ Node.pList node |
333 |
oil' = filter Instance.notOffline il' |
334 |
in sum . map Instance.mem $ oil' |
335 |
|
336 |
|
337 |
-- | Compute the amount of disk used by instances on a node (either primary |
338 |
-- or secondary). |
339 |
nodeIdsk :: Node.Node -> Instance.List -> Int |
340 |
nodeIdsk node il = |
341 |
let rfind = flip Container.find il |
342 |
in sum . map (Instance.dsk . rfind) |
343 |
$ Node.pList node ++ Node.sList node |
344 |
|
345 |
-- | Get live information or a default value |
346 |
eitherLive :: (Monad m) => Bool -> a -> m a -> m a |
347 |
eitherLive True _ live_data = live_data |
348 |
eitherLive False def_data _ = return def_data |