root / src / Ganeti / HTools / ExtLoader.hs @ 33ce4d2d
History | View | Annotate | Download (10.6 kB)
1 |
{-# LANGUAGE BangPatterns #-} |
---|---|
2 |
|
3 |
{-| External data loader. |
4 |
|
5 |
This module holds the external data loading, and thus is the only one |
6 |
depending (via the specialized Text\/Rapi\/Luxi modules) on the actual |
7 |
libraries implementing the low-level protocols. |
8 |
|
9 |
-} |
10 |
|
11 |
{- |
12 |
|
13 |
Copyright (C) 2009, 2010, 2011, 2012 Google Inc. |
14 |
|
15 |
This program is free software; you can redistribute it and/or modify |
16 |
it under the terms of the GNU General Public License as published by |
17 |
the Free Software Foundation; either version 2 of the License, or |
18 |
(at your option) any later version. |
19 |
|
20 |
This program is distributed in the hope that it will be useful, but |
21 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
22 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
23 |
General Public License for more details. |
24 |
|
25 |
You should have received a copy of the GNU General Public License |
26 |
along with this program; if not, write to the Free Software |
27 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
28 |
02110-1301, USA. |
29 |
|
30 |
-} |
31 |
|
32 |
module Ganeti.HTools.ExtLoader |
33 |
( loadExternalData |
34 |
, commonSuffix |
35 |
, maybeSaveData |
36 |
, queryAllMonDDCs |
37 |
, pMonDData |
38 |
) where |
39 |
|
40 |
import Control.Monad |
41 |
import Control.Exception |
42 |
import Data.Maybe (isJust, fromJust, catMaybes) |
43 |
import Network.Curl |
44 |
import System.FilePath |
45 |
import System.IO |
46 |
import System.Time (getClockTime) |
47 |
import Text.Printf (hPrintf) |
48 |
|
49 |
import qualified Text.JSON as J |
50 |
import qualified Data.Map as Map |
51 |
import qualified Data.List as L |
52 |
|
53 |
import qualified Ganeti.Constants as C |
54 |
import qualified Ganeti.DataCollectors.CPUload as CPUload |
55 |
import qualified Ganeti.HTools.Container as Container |
56 |
import qualified Ganeti.HTools.Backend.Luxi as Luxi |
57 |
import qualified Ganeti.HTools.Backend.Rapi as Rapi |
58 |
import qualified Ganeti.HTools.Backend.Simu as Simu |
59 |
import qualified Ganeti.HTools.Backend.Text as Text |
60 |
import qualified Ganeti.HTools.Backend.IAlloc as IAlloc |
61 |
import qualified Ganeti.HTools.Node as Node |
62 |
import qualified Ganeti.HTools.Instance as Instance |
63 |
import Ganeti.HTools.Loader (mergeData, checkData, ClusterData(..) |
64 |
, commonSuffix, clearDynU) |
65 |
|
66 |
import Ganeti.BasicTypes |
67 |
import Ganeti.Cpu.Types |
68 |
import Ganeti.DataCollectors.Types |
69 |
import Ganeti.HTools.Types |
70 |
import Ganeti.HTools.CLI |
71 |
import Ganeti.JSON |
72 |
import Ganeti.Logging (logWarning) |
73 |
import Ganeti.Utils (sepSplit, tryRead, exitIfBad, exitWhen) |
74 |
|
75 |
-- | Error beautifier. |
76 |
wrapIO :: IO (Result a) -> IO (Result a) |
77 |
wrapIO = handle (\e -> return . Bad . show $ (e::IOException)) |
78 |
|
79 |
-- | Parses a user-supplied utilisation string. |
80 |
parseUtilisation :: String -> Result (String, DynUtil) |
81 |
parseUtilisation line = |
82 |
case sepSplit ' ' line of |
83 |
[name, cpu, mem, dsk, net] -> |
84 |
do |
85 |
rcpu <- tryRead name cpu |
86 |
rmem <- tryRead name mem |
87 |
rdsk <- tryRead name dsk |
88 |
rnet <- tryRead name net |
89 |
let du = DynUtil { cpuWeight = rcpu, memWeight = rmem |
90 |
, dskWeight = rdsk, netWeight = rnet } |
91 |
return (name, du) |
92 |
_ -> Bad $ "Cannot parse line " ++ line |
93 |
|
94 |
-- | External tool data loader from a variety of sources. |
95 |
loadExternalData :: Options |
96 |
-> IO ClusterData |
97 |
loadExternalData opts = do |
98 |
let mhost = optMaster opts |
99 |
lsock = optLuxi opts |
100 |
tfile = optDataFile opts |
101 |
simdata = optNodeSim opts |
102 |
iallocsrc = optIAllocSrc opts |
103 |
setRapi = mhost /= "" |
104 |
setLuxi = isJust lsock |
105 |
setSim = (not . null) simdata |
106 |
setFile = isJust tfile |
107 |
setIAllocSrc = isJust iallocsrc |
108 |
allSet = filter id [setRapi, setLuxi, setFile] |
109 |
exTags = case optExTags opts of |
110 |
Nothing -> [] |
111 |
Just etl -> map (++ ":") etl |
112 |
selInsts = optSelInst opts |
113 |
exInsts = optExInst opts |
114 |
|
115 |
exitWhen (length allSet > 1) "Only one of the rapi, luxi, and data\ |
116 |
\ files options should be given." |
117 |
|
118 |
util_contents <- maybe (return "") readFile (optDynuFile opts) |
119 |
util_data <- exitIfBad "can't parse utilisation data" . |
120 |
mapM parseUtilisation $ lines util_contents |
121 |
input_data <- |
122 |
case () of |
123 |
_ | setRapi -> wrapIO $ Rapi.loadData mhost |
124 |
| setLuxi -> wrapIO . Luxi.loadData $ fromJust lsock |
125 |
| setSim -> Simu.loadData simdata |
126 |
| setFile -> wrapIO . Text.loadData $ fromJust tfile |
127 |
| setIAllocSrc -> wrapIO . IAlloc.loadData $ fromJust iallocsrc |
128 |
| otherwise -> return $ Bad "No backend selected! Exiting." |
129 |
now <- getClockTime |
130 |
|
131 |
let ignoreDynU = optIgnoreDynu opts |
132 |
eff_u = if ignoreDynU then [] else util_data |
133 |
ldresult = input_data >>= (if ignoreDynU then clearDynU else return) |
134 |
>>= mergeData eff_u exTags selInsts exInsts now |
135 |
cdata <- exitIfBad "failed to load data, aborting" ldresult |
136 |
cdata' <- if optMonD opts then queryAllMonDDCs cdata opts else return cdata |
137 |
let (fix_msgs, nl) = checkData (cdNodes cdata') (cdInstances cdata') |
138 |
|
139 |
unless (optVerbose opts == 0) $ maybeShowWarnings fix_msgs |
140 |
|
141 |
return cdata' {cdNodes = nl} |
142 |
|
143 |
-- | Function to save the cluster data to a file. |
144 |
maybeSaveData :: Maybe FilePath -- ^ The file prefix to save to |
145 |
-> String -- ^ The suffix (extension) to add |
146 |
-> String -- ^ Informational message |
147 |
-> ClusterData -- ^ The cluster data |
148 |
-> IO () |
149 |
maybeSaveData Nothing _ _ _ = return () |
150 |
maybeSaveData (Just path) ext msg cdata = do |
151 |
let adata = Text.serializeCluster cdata |
152 |
out_path = path <.> ext |
153 |
writeFile out_path adata |
154 |
hPrintf stderr "The cluster state %s has been written to file '%s'\n" |
155 |
msg out_path |
156 |
|
157 |
-- | Type describing a data collector basic information. |
158 |
data DataCollector = DataCollector |
159 |
{ dName :: String -- ^ Name of the data collector |
160 |
, dCategory :: Maybe DCCategory -- ^ The name of the category |
161 |
} |
162 |
|
163 |
-- | The actual data types for MonD's Data Collectors. |
164 |
data Report = CPUavgloadReport CPUavgload |
165 |
|
166 |
-- | The list of Data Collectors used by hail and hbal. |
167 |
collectors :: Options -> [DataCollector] |
168 |
collectors opts = |
169 |
if optIgnoreDynu opts |
170 |
then [] |
171 |
else [ DataCollector CPUload.dcName CPUload.dcCategory ] |
172 |
|
173 |
-- | MonDs Data parsed by a mock file. Representing (node name, list of reports |
174 |
-- produced by MonDs Data Collectors). |
175 |
type MonDData = (String, [DCReport]) |
176 |
|
177 |
-- | A map storing MonDs data. |
178 |
type MapMonDData = Map.Map String [DCReport] |
179 |
|
180 |
-- | Parse MonD data file contents. |
181 |
pMonDData :: String -> Result [MonDData] |
182 |
pMonDData input = |
183 |
loadJSArray "Parsing MonD's answer" input >>= |
184 |
mapM (pMonDN . J.fromJSObject) |
185 |
|
186 |
-- | Parse a node's JSON record. |
187 |
pMonDN :: JSRecord -> Result MonDData |
188 |
pMonDN a = do |
189 |
node <- tryFromObj "Parsing node's name" a "node" |
190 |
reports <- tryFromObj "Parsing node's reports" a "reports" |
191 |
return (node, reports) |
192 |
|
193 |
-- | Query all MonDs for all Data Collector. |
194 |
queryAllMonDDCs :: ClusterData -> Options -> IO ClusterData |
195 |
queryAllMonDDCs cdata opts = do |
196 |
map_mDD <- |
197 |
case optMonDFile opts of |
198 |
Nothing -> return Nothing |
199 |
Just fp -> do |
200 |
monDData_contents <- readFile fp |
201 |
monDData <- exitIfBad "can't parse MonD data" |
202 |
. pMonDData $ monDData_contents |
203 |
return . Just $ Map.fromList monDData |
204 |
let (ClusterData _ nl il _ _) = cdata |
205 |
(nl', il') <- foldM (queryAllMonDs map_mDD) (nl, il) (collectors opts) |
206 |
return $ cdata {cdNodes = nl', cdInstances = il'} |
207 |
|
208 |
-- | Query all MonDs for a single Data Collector. |
209 |
queryAllMonDs :: Maybe MapMonDData -> (Node.List, Instance.List) |
210 |
-> DataCollector -> IO (Node.List, Instance.List) |
211 |
queryAllMonDs m (nl, il) dc = do |
212 |
elems <- mapM (queryAMonD m dc) (Container.elems nl) |
213 |
let elems' = catMaybes elems |
214 |
if length elems == length elems' |
215 |
then |
216 |
let il' = foldl updateUtilData il elems' |
217 |
nl' = zip (Container.keys nl) elems' |
218 |
in return (Container.fromList nl', il') |
219 |
else do |
220 |
logWarning $ "Didn't receive an answer by all MonDs, " ++ dName dc |
221 |
++ "'s data will be ignored." |
222 |
return (nl,il) |
223 |
|
224 |
-- | Query a specified MonD for a Data Collector. |
225 |
fromCurl :: DataCollector -> Node.Node -> IO (Maybe DCReport) |
226 |
fromCurl dc node = do |
227 |
(code, !body) <- curlGetString (prepareUrl dc node) [] |
228 |
case code of |
229 |
CurlOK -> |
230 |
case J.decodeStrict body :: J.Result DCReport of |
231 |
J.Ok r -> return $ Just r |
232 |
J.Error _ -> return Nothing |
233 |
_ -> do |
234 |
logWarning $ "Failed to contact node's " ++ Node.name node |
235 |
++ " MonD for DC " ++ dName dc |
236 |
return Nothing |
237 |
|
238 |
-- | Return the data from correct combination of a Data Collector |
239 |
-- and a DCReport. |
240 |
mkReport :: DataCollector -> Maybe DCReport -> Maybe Report |
241 |
mkReport dc dcr = |
242 |
case dcr of |
243 |
Nothing -> Nothing |
244 |
Just dcr' -> |
245 |
case () of |
246 |
_ | CPUload.dcName == dName dc -> |
247 |
case fromJVal (dcReportData dcr') :: Result CPUavgload of |
248 |
Ok cav -> Just $ CPUavgloadReport cav |
249 |
Bad _ -> Nothing |
250 |
| otherwise -> Nothing |
251 |
|
252 |
-- | Get data report for the specified Data Collector and Node from the map. |
253 |
fromFile :: DataCollector -> Node.Node -> MapMonDData -> Maybe DCReport |
254 |
fromFile dc node m = |
255 |
let matchDCName dcr = dName dc == dcReportName dcr |
256 |
in maybe Nothing (L.find matchDCName) $ Map.lookup (Node.name node) m |
257 |
|
258 |
-- | Query a MonD for a single Data Collector. |
259 |
queryAMonD :: Maybe MapMonDData -> DataCollector -> Node.Node |
260 |
-> IO (Maybe Node.Node) |
261 |
queryAMonD m dc node = do |
262 |
dcReport <- |
263 |
case m of |
264 |
Nothing -> fromCurl dc node |
265 |
Just m' -> return $ fromFile dc node m' |
266 |
case mkReport dc dcReport of |
267 |
Nothing -> return Nothing |
268 |
Just report -> |
269 |
case report of |
270 |
CPUavgloadReport cav -> |
271 |
let ct = cavCpuTotal cav |
272 |
du = Node.utilLoad node |
273 |
du' = du {cpuWeight = ct} |
274 |
in return $ Just node {Node.utilLoad = du'} |
275 |
|
276 |
-- | Update utilization data. |
277 |
updateUtilData :: Instance.List -> Node.Node -> Instance.List |
278 |
updateUtilData il node = |
279 |
let ct = cpuWeight (Node.utilLoad node) |
280 |
n_uCpu = Node.uCpu node |
281 |
upd inst = |
282 |
if Node.idx node == Instance.pNode inst |
283 |
then |
284 |
let i_vcpus = Instance.vcpus inst |
285 |
i_util = ct / fromIntegral n_uCpu * fromIntegral i_vcpus |
286 |
i_du = Instance.util inst |
287 |
i_du' = i_du {cpuWeight = i_util} |
288 |
in inst {Instance.util = i_du'} |
289 |
else inst |
290 |
in Container.map upd il |
291 |
|
292 |
-- | Prepare url to query a single collector. |
293 |
prepareUrl :: DataCollector -> Node.Node -> URLString |
294 |
prepareUrl dc node = |
295 |
Node.name node ++ ":" ++ show C.defaultMondPort ++ "/" |
296 |
++ show C.mondLatestApiVersion ++ "/report/" ++ |
297 |
getDCCName (dCategory dc) ++ "/" ++ dName dc |
298 |
|
299 |
-- | Get Category Name. |
300 |
getDCCName :: Maybe DCCategory -> String |
301 |
getDCCName dcc = |
302 |
case dcc of |
303 |
Nothing -> "default" |
304 |
Just c -> getCategoryName c |