root / Ganeti / HTools / Loader.hs @ 6b20875c
History | View | Annotate | Download (6.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 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 |
, checkData |
32 |
, assignIndices |
33 |
, lookupNode |
34 |
, lookupInstance |
35 |
, stripSuffix |
36 |
, RqType(..) |
37 |
, Request(..) |
38 |
) where |
39 |
|
40 |
import Data.Function (on) |
41 |
import Data.List |
42 |
import Data.Maybe (fromJust) |
43 |
import Text.Printf (printf) |
44 |
|
45 |
import qualified Ganeti.HTools.Container as Container |
46 |
import qualified Ganeti.HTools.Instance as Instance |
47 |
import qualified Ganeti.HTools.Node as Node |
48 |
|
49 |
import Ganeti.HTools.Types |
50 |
|
51 |
-- * Types |
52 |
|
53 |
{-| The request type. |
54 |
|
55 |
This type denotes what request we got from Ganeti and also holds |
56 |
request-specific fields. |
57 |
|
58 |
-} |
59 |
data RqType |
60 |
= Allocate Instance.Instance Int -- ^ A new instance allocation |
61 |
| Relocate Idx Int [Ndx] -- ^ Move an instance to a new |
62 |
-- secondary node |
63 |
deriving (Show) |
64 |
|
65 |
-- | A complete request, as received from Ganeti. |
66 |
data Request = Request RqType Node.List Instance.List String |
67 |
deriving (Show) |
68 |
|
69 |
-- * Functions |
70 |
|
71 |
-- | Lookups a node into an assoc list. |
72 |
lookupNode :: (Monad m) => [(String, Ndx)] -> String -> String -> m Ndx |
73 |
lookupNode ktn inst node = |
74 |
case lookup node ktn of |
75 |
Nothing -> fail $ "Unknown node '" ++ node ++ "' for instance " ++ inst |
76 |
Just idx -> return idx |
77 |
|
78 |
-- | Lookups an instance into an assoc list. |
79 |
lookupInstance :: (Monad m) => [(String, Idx)] -> String -> m Idx |
80 |
lookupInstance kti inst = |
81 |
case lookup inst kti of |
82 |
Nothing -> fail $ "Unknown instance '" ++ inst ++ "'" |
83 |
Just idx -> return idx |
84 |
|
85 |
-- | Given a list of elements (and their names), assign indices to them. |
86 |
assignIndices :: (Element a) => |
87 |
[(String, a)] |
88 |
-> (NameAssoc, [(Int, a)]) |
89 |
assignIndices = |
90 |
unzip . map (\ (idx, (k, v)) -> ((k, idx), (idx, setIdx v idx))) |
91 |
. zip [0..] |
92 |
|
93 |
-- | Assoc element comparator |
94 |
assocEqual :: (Eq a) => (a, b) -> (a, b) -> Bool |
95 |
assocEqual = (==) `on` fst |
96 |
|
97 |
-- | For each instance, add its index to its primary and secondary nodes. |
98 |
fixNodes :: [(Ndx, Node.Node)] |
99 |
-> (Idx, Instance.Instance) |
100 |
-> [(Ndx, Node.Node)] |
101 |
fixNodes accu (idx, inst) = |
102 |
let |
103 |
pdx = Instance.pnode inst |
104 |
sdx = Instance.snode inst |
105 |
pold = fromJust $ lookup pdx accu |
106 |
pnew = Node.setPri pold idx |
107 |
pnew' = Node.addCpus pnew (Instance.vcpus inst) |
108 |
ac1 = deleteBy assocEqual (pdx, pold) accu |
109 |
ac2 = (pdx, pnew'):ac1 |
110 |
in |
111 |
if sdx /= Node.noSecondary |
112 |
then let sold = fromJust $ lookup sdx accu |
113 |
snew = Node.setSec sold idx |
114 |
ac3 = deleteBy assocEqual (sdx, sold) ac2 |
115 |
in (sdx, snew):ac3 |
116 |
else ac2 |
117 |
|
118 |
-- | Compute the longest common suffix of a list of strings that |
119 |
-- | starts with a dot. |
120 |
longestDomain :: [String] -> String |
121 |
longestDomain [] = "" |
122 |
longestDomain (x:xs) = |
123 |
foldr (\ suffix accu -> if all (isSuffixOf suffix) xs |
124 |
then suffix |
125 |
else accu) |
126 |
"" $ filter (isPrefixOf ".") (tails x) |
127 |
|
128 |
-- | Remove tail suffix from a string. |
129 |
stripSuffix :: Int -> String -> String |
130 |
stripSuffix sflen name = take (length name - sflen) name |
131 |
|
132 |
-- | Initializer function that loads the data from a node and instance |
133 |
-- list and massages it into the correct format. |
134 |
mergeData :: (Node.AssocList, |
135 |
Instance.AssocList) -- ^ Data from either Text.loadData |
136 |
-- or Rapi.loadData |
137 |
-> Result (Node.List, Instance.List, String) |
138 |
mergeData (nl, il) = do |
139 |
let |
140 |
nl2 = foldl' fixNodes nl il |
141 |
il3 = Container.fromAssocList il |
142 |
nl3 = Container.fromAssocList |
143 |
(map (\ (k, v) -> (k, Node.buildPeers v il3)) nl2) |
144 |
node_names = map Node.name $ Container.elems nl3 |
145 |
inst_names = map Instance.name $ Container.elems il3 |
146 |
common_suffix = longestDomain (node_names ++ inst_names) |
147 |
csl = length common_suffix |
148 |
snl = Container.map (\n -> setName n (stripSuffix csl $ nameOf n)) nl3 |
149 |
sil = Container.map (\i -> setName i (stripSuffix csl $ nameOf i)) il3 |
150 |
return (snl, sil, common_suffix) |
151 |
|
152 |
-- | Checks the cluster data for consistency. |
153 |
checkData :: Node.List -> Instance.List |
154 |
-> ([String], Node.List) |
155 |
checkData nl il = |
156 |
Container.mapAccum |
157 |
(\ msgs node -> |
158 |
let nname = Node.name node |
159 |
nilst = map (flip Container.find il) (Node.plist node) |
160 |
dilst = filter (not . Instance.running) nilst |
161 |
adj_mem = sum . map Instance.mem $ dilst |
162 |
delta_mem = truncate (Node.t_mem node) |
163 |
- Node.n_mem node |
164 |
- Node.f_mem node |
165 |
- nodeImem node il |
166 |
+ adj_mem |
167 |
delta_dsk = truncate (Node.t_dsk node) |
168 |
- Node.f_dsk node |
169 |
- nodeIdsk node il |
170 |
newn = Node.setFmem (Node.setXmem node delta_mem) |
171 |
(Node.f_mem node - adj_mem) |
172 |
umsg1 = [printf "node %s is missing %d MB ram \ |
173 |
\and %d GB disk" |
174 |
nname delta_mem (delta_dsk `div` 1024) | |
175 |
delta_mem > 512 || delta_dsk > 1024]::[String] |
176 |
in (msgs ++ umsg1, newn) |
177 |
) [] nl |
178 |
|
179 |
-- | Compute the amount of memory used by primary instances on a node. |
180 |
nodeImem :: Node.Node -> Instance.List -> Int |
181 |
nodeImem node il = |
182 |
let rfind = flip Container.find il |
183 |
in sum . map (Instance.mem . rfind) |
184 |
$ Node.plist node |
185 |
|
186 |
-- | Compute the amount of disk used by instances on a node (either primary |
187 |
-- or secondary). |
188 |
nodeIdsk :: Node.Node -> Instance.List -> Int |
189 |
nodeIdsk node il = |
190 |
let rfind = flip Container.find il |
191 |
in sum . map (Instance.dsk . rfind) |
192 |
$ Node.plist node ++ Node.slist node |