root / Ganeti / HTools / Loader.hs @ 26b5d395
History | View | Annotate | Download (5.5 kB)
1 |
{-| Loading data from external sources |
---|---|
2 |
|
3 |
This module holds the common code for loading the cluster state from external sources. |
4 |
|
5 |
-} |
6 |
|
7 |
module Ganeti.HTools.Loader |
8 |
( mergeData |
9 |
, checkData |
10 |
, assignIndices |
11 |
, lookupNode |
12 |
) where |
13 |
|
14 |
import Data.List |
15 |
import Data.Maybe (fromJust) |
16 |
import Text.Printf (printf) |
17 |
|
18 |
import qualified Ganeti.HTools.Container as Container |
19 |
import qualified Ganeti.HTools.Instance as Instance |
20 |
import qualified Ganeti.HTools.Node as Node |
21 |
|
22 |
import Ganeti.HTools.Types |
23 |
|
24 |
|
25 |
-- | Swap a list of @(a, b)@ into @(b, a)@ |
26 |
swapPairs :: [(a, b)] -> [(b, a)] |
27 |
swapPairs = map (\ (a, b) -> (b, a)) |
28 |
|
29 |
-- | Lookups a node into an assoc list |
30 |
lookupNode :: (Monad m) => NameAssoc -> String -> String -> m Int |
31 |
lookupNode ktn inst node = |
32 |
case lookup node ktn of |
33 |
Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst |
34 |
Just idx -> return idx |
35 |
|
36 |
assignIndices :: (Element a) => |
37 |
[(String, a)] |
38 |
-> (NameAssoc, [(Int, a)]) |
39 |
assignIndices = |
40 |
unzip . map (\ (idx, (k, v)) -> ((k, idx), (idx, setIdx v idx))) |
41 |
. zip [0..] |
42 |
|
43 |
-- | For each instance, add its index to its primary and secondary nodes |
44 |
fixNodes :: [(Int, Node.Node)] |
45 |
-> [(Int, Instance.Instance)] |
46 |
-> [(Int, Node.Node)] |
47 |
fixNodes nl il = |
48 |
foldl' (\accu (idx, inst) -> |
49 |
let |
50 |
assocEqual = (\ (i, _) (j, _) -> i == j) |
51 |
pdx = Instance.pnode inst |
52 |
sdx = Instance.snode inst |
53 |
pold = fromJust $ lookup pdx accu |
54 |
pnew = Node.setPri pold idx |
55 |
ac1 = deleteBy assocEqual (pdx, pold) accu |
56 |
ac2 = (pdx, pnew):ac1 |
57 |
in |
58 |
if sdx /= Node.noSecondary then |
59 |
let |
60 |
sold = fromJust $ lookup sdx accu |
61 |
snew = Node.setSec sold idx |
62 |
ac3 = deleteBy assocEqual (sdx, sold) ac2 |
63 |
ac4 = (sdx, snew):ac3 |
64 |
in ac4 |
65 |
else |
66 |
ac2 |
67 |
) nl il |
68 |
|
69 |
-- | Compute the longest common suffix of a NameList list that |
70 |
-- | starts with a dot |
71 |
longestDomain :: NameList -> String |
72 |
longestDomain [] = "" |
73 |
longestDomain ((_,x):xs) = |
74 |
let |
75 |
onlyStrings = snd $ unzip xs |
76 |
in |
77 |
foldr (\ suffix accu -> if all (isSuffixOf suffix) onlyStrings |
78 |
then suffix |
79 |
else accu) |
80 |
"" $ filter (isPrefixOf ".") (tails x) |
81 |
|
82 |
-- | Remove tail suffix from a string |
83 |
stripSuffix :: Int -> String -> String |
84 |
stripSuffix sflen name = take ((length name) - sflen) name |
85 |
|
86 |
{-| Initializer function that loads the data from a node and list file |
87 |
and massages it into the correct format. -} |
88 |
mergeData :: ([(String, Int)], Node.AssocList, |
89 |
[(String, Int)], Instance.AssocList) -- ^ Data from either |
90 |
-- Text.loadData |
91 |
-- or Rapi.loadData |
92 |
-> Result (NodeList, InstanceList, String, NameList, NameList) |
93 |
mergeData (ktn, nl, kti, il) = do |
94 |
let |
95 |
nl2 = fixNodes nl il |
96 |
il3 = Container.fromAssocList il |
97 |
nl3 = Container.fromAssocList |
98 |
(map (\ (k, v) -> (k, Node.buildPeers v il3 (length nl2))) nl2) |
99 |
xtn = swapPairs ktn |
100 |
xti = swapPairs kti |
101 |
common_suffix = longestDomain (xti ++ xtn) |
102 |
csl = length common_suffix |
103 |
stn = map (\(x, y) -> (x, stripSuffix csl y)) xtn |
104 |
sti = map (\(x, y) -> (x, stripSuffix csl y)) xti |
105 |
snl = Container.map (\n -> setName n (stripSuffix csl $ name n)) nl3 |
106 |
sil = Container.map (\i -> setName i (stripSuffix csl $ name i)) il3 |
107 |
return (snl, sil, common_suffix, stn, sti) |
108 |
|
109 |
-- | Check cluster data for consistency |
110 |
checkData :: NodeList -> InstanceList -> NameList -> NameList |
111 |
-> ([String], NodeList) |
112 |
checkData nl il ktn _ = |
113 |
Container.mapAccum |
114 |
(\ msgs node -> |
115 |
let nname = fromJust $ lookup (Node.idx node) ktn |
116 |
nilst = map (flip Container.find $ il) (Node.plist node) |
117 |
dilst = filter (not . Instance.running) nilst |
118 |
adj_mem = sum . map Instance.mem $ dilst |
119 |
delta_mem = (truncate $ Node.t_mem node) |
120 |
- (Node.n_mem node) |
121 |
- (Node.f_mem node) |
122 |
- (nodeImem node il) |
123 |
+ adj_mem |
124 |
delta_dsk = (truncate $ Node.t_dsk node) |
125 |
- (Node.f_dsk node) |
126 |
- (nodeIdsk node il) |
127 |
newn = Node.setFmem (Node.setXmem node delta_mem) |
128 |
(Node.f_mem node - adj_mem) |
129 |
umsg1 = if delta_mem > 512 || delta_dsk > 1024 |
130 |
then [printf "node %s is missing %d MB ram \ |
131 |
\and %d GB disk" |
132 |
nname delta_mem (delta_dsk `div` 1024)] |
133 |
else [] |
134 |
in (msgs ++ umsg1, newn) |
135 |
) [] nl |
136 |
|
137 |
-- | Compute the amount of memory used by primary instances on a node. |
138 |
nodeImem :: Node.Node -> InstanceList -> Int |
139 |
nodeImem node il = |
140 |
let rfind = flip Container.find $ il |
141 |
in sum . map Instance.mem . |
142 |
map rfind $ Node.plist node |
143 |
|
144 |
-- | Compute the amount of disk used by instances on a node (either primary |
145 |
-- or secondary). |
146 |
nodeIdsk :: Node.Node -> InstanceList -> Int |
147 |
nodeIdsk node il = |
148 |
let rfind = flip Container.find $ il |
149 |
in sum . map Instance.dsk . |
150 |
map rfind $ (Node.plist node) ++ (Node.slist node) |