Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / HTools / ExtLoader.hs @ c62bec27

History | View | Annotate | Download (10.5 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
  ) where
38

    
39
import Control.Monad
40
import Control.Exception
41
import Data.Maybe (isJust, fromJust, catMaybes)
42
import Network.Curl
43
import System.FilePath
44
import System.IO
45
import System.Time (getClockTime)
46
import Text.Printf (hPrintf)
47

    
48
import qualified Text.JSON as J
49
import qualified Data.Map as Map
50
import qualified Data.List as L
51

    
52
import qualified Ganeti.Constants as C
53
import qualified Ganeti.DataCollectors.CPUload as CPUload
54
import qualified Ganeti.HTools.Container as Container
55
import qualified Ganeti.HTools.Backend.Luxi as Luxi
56
import qualified Ganeti.HTools.Backend.Rapi as Rapi
57
import qualified Ganeti.HTools.Backend.Simu as Simu
58
import qualified Ganeti.HTools.Backend.Text as Text
59
import qualified Ganeti.HTools.Backend.IAlloc as IAlloc
60
import qualified Ganeti.HTools.Node as Node
61
import qualified Ganeti.HTools.Instance as Instance
62
import Ganeti.HTools.Loader (mergeData, checkData, ClusterData(..)
63
                            , commonSuffix, clearDynU)
64

    
65
import Ganeti.BasicTypes
66
import Ganeti.Cpu.Types
67
import Ganeti.DataCollectors.Types
68
import Ganeti.HTools.Types
69
import Ganeti.HTools.CLI
70
import Ganeti.JSON
71
import Ganeti.Logging (logWarning)
72
import Ganeti.Utils (sepSplit, tryRead, exitIfBad, exitWhen)
73

    
74
-- | Error beautifier.
75
wrapIO :: IO (Result a) -> IO (Result a)
76
wrapIO = handle (\e -> return . Bad . show $ (e::IOException))
77

    
78
-- | Parses a user-supplied utilisation string.
79
parseUtilisation :: String -> Result (String, DynUtil)
80
parseUtilisation line =
81
  case sepSplit ' ' line of
82
    [name, cpu, mem, dsk, net] ->
83
      do
84
        rcpu <- tryRead name cpu
85
        rmem <- tryRead name mem
86
        rdsk <- tryRead name dsk
87
        rnet <- tryRead name net
88
        let du = DynUtil { cpuWeight = rcpu, memWeight = rmem
89
                         , dskWeight = rdsk, netWeight = rnet }
90
        return (name, du)
91
    _ -> Bad $ "Cannot parse line " ++ line
92

    
93
-- | External tool data loader from a variety of sources.
94
loadExternalData :: Options
95
                 -> IO ClusterData
96
loadExternalData opts = do
97
  let mhost = optMaster opts
98
      lsock = optLuxi opts
99
      tfile = optDataFile opts
100
      simdata = optNodeSim opts
101
      iallocsrc = optIAllocSrc opts
102
      setRapi = mhost /= ""
103
      setLuxi = isJust lsock
104
      setSim = (not . null) simdata
105
      setFile = isJust tfile
106
      setIAllocSrc = isJust iallocsrc
107
      allSet = filter id [setRapi, setLuxi, setFile]
108
      exTags = case optExTags opts of
109
                 Nothing -> []
110
                 Just etl -> map (++ ":") etl
111
      selInsts = optSelInst opts
112
      exInsts = optExInst opts
113

    
114
  exitWhen (length allSet > 1) "Only one of the rapi, luxi, and data\
115
                               \ files options should be given."
116

    
117
  util_contents <- maybe (return "") readFile (optDynuFile opts)
118
  util_data <- exitIfBad "can't parse utilisation data" .
119
               mapM parseUtilisation $ lines util_contents
120
  input_data <-
121
    case () of
122
      _ | setRapi -> wrapIO $ Rapi.loadData mhost
123
        | setLuxi -> wrapIO . Luxi.loadData $ fromJust lsock
124
        | setSim -> Simu.loadData simdata
125
        | setFile -> wrapIO . Text.loadData $ fromJust tfile
126
        | setIAllocSrc -> wrapIO . IAlloc.loadData $ fromJust iallocsrc
127
        | otherwise -> return $ Bad "No backend selected! Exiting."
128
  now <- getClockTime
129

    
130
  let ignoreDynU = optIgnoreDynu opts
131
      eff_u = if ignoreDynU then [] else util_data
132
      ldresult = input_data >>= (if ignoreDynU then clearDynU else return)
133
                            >>= mergeData eff_u exTags selInsts exInsts now
134
  cdata <- exitIfBad "failed to load data, aborting" ldresult
135
  cdata' <- if optMonD opts then queryAllMonDDCs cdata opts else return cdata
136
  let (fix_msgs, nl) = checkData (cdNodes cdata') (cdInstances cdata')
137

    
138
  unless (optVerbose opts == 0) $ maybeShowWarnings fix_msgs
139

    
140
  return cdata' {cdNodes = nl}
141

    
142
-- | Function to save the cluster data to a file.
143
maybeSaveData :: Maybe FilePath -- ^ The file prefix to save to
144
              -> String         -- ^ The suffix (extension) to add
145
              -> String         -- ^ Informational message
146
              -> ClusterData    -- ^ The cluster data
147
              -> IO ()
148
maybeSaveData Nothing _ _ _ = return ()
149
maybeSaveData (Just path) ext msg cdata = do
150
  let adata = Text.serializeCluster cdata
151
      out_path = path <.> ext
152
  writeFile out_path adata
153
  hPrintf stderr "The cluster state %s has been written to file '%s'\n"
154
          msg out_path
155

    
156
-- | Type describing a data collector basic information.
157
data DataCollector = DataCollector
158
  { dName     :: String           -- ^ Name of the data collector
159
  , dCategory :: Maybe DCCategory -- ^ The name of the category
160
  }
161

    
162
-- | The actual data types for MonD's Data Collectors.
163
data Report = CPUavgloadReport CPUavgload
164

    
165
-- | The list of Data Collectors used by hail and hbal.
166
collectors :: Options -> [DataCollector]
167
collectors opts =
168
  if optIgnoreDynu opts
169
    then []
170
    else [ DataCollector CPUload.dcName CPUload.dcCategory ]
171

    
172
-- | MonDs Data parsed by a mock file. Representing (node name, list of reports
173
-- produced by MonDs Data Collectors).
174
type MonDData = (String, [DCReport])
175

    
176
-- | A map storing MonDs data.
177
type MapMonDData = Map.Map String [DCReport]
178

    
179
-- | Parse MonD data file contents.
180
pMonDData :: String -> Result [MonDData]
181
pMonDData input =
182
  loadJSArray "Parsing MonD's answer" input >>=
183
  mapM (pMonDN . J.fromJSObject)
184

    
185
-- | Parse a node's JSON record.
186
pMonDN :: JSRecord -> Result MonDData
187
pMonDN a = do
188
  node <- tryFromObj "Parsing node's name" a "node"
189
  reports <- tryFromObj "Parsing node's reports" a "reports"
190
  return (node, reports)
191

    
192
-- | Query all MonDs for all Data Collector.
193
queryAllMonDDCs :: ClusterData -> Options -> IO ClusterData
194
queryAllMonDDCs cdata opts = do
195
  map_mDD <-
196
    case optMonDFile opts of
197
      Nothing -> return Nothing
198
      Just fp -> do
199
        monDData_contents <- readFile fp
200
        monDData <- exitIfBad "can't parse MonD data"
201
                    . pMonDData $ monDData_contents
202
        return . Just $ Map.fromList monDData
203
  let (ClusterData _ nl il _ _) = cdata
204
  (nl', il') <- foldM (queryAllMonDs map_mDD) (nl, il) (collectors opts)
205
  return $ cdata {cdNodes = nl', cdInstances = il'}
206

    
207
-- | Query all MonDs for a single Data Collector.
208
queryAllMonDs :: Maybe MapMonDData -> (Node.List, Instance.List)
209
                 -> DataCollector -> IO (Node.List, Instance.List)
210
queryAllMonDs m (nl, il) dc = do
211
  elems <- mapM (queryAMonD m dc) (Container.elems nl)
212
  let elems' = catMaybes elems
213
  if length elems == length elems'
214
    then
215
      let il' = foldl updateUtilData il elems'
216
          nl' = zip (Container.keys nl) elems'
217
      in return (Container.fromList nl', il')
218
    else do
219
      logWarning $ "Didn't receive an answer by all MonDs, " ++ dName dc
220
                   ++ "'s data will be ignored."
221
      return (nl,il)
222

    
223
-- | Query a specified MonD for a Data Collector.
224
fromCurl :: DataCollector -> Node.Node -> IO (Maybe DCReport)
225
fromCurl dc node = do
226
  (code, !body) <-  curlGetString (prepareUrl dc node) []
227
  case code of
228
    CurlOK ->
229
      case J.decodeStrict body :: J.Result DCReport of
230
        J.Ok r -> return $ Just r
231
        J.Error _ -> return Nothing
232
    _ -> do
233
      logWarning $ "Failed to contact node's " ++ Node.name node
234
                   ++ " MonD for DC " ++ dName dc
235
      return Nothing
236

    
237
-- | Return the data from correct combination of a Data Collector
238
-- and a DCReport.
239
mkReport :: DataCollector -> Maybe DCReport -> Maybe Report
240
mkReport dc dcr =
241
  case dcr of
242
    Nothing -> Nothing
243
    Just dcr' ->
244
      case () of
245
           _ | CPUload.dcName == dName dc ->
246
                 case fromJVal (dcReportData dcr') :: Result CPUavgload of
247
                   Ok cav -> Just $ CPUavgloadReport cav
248
                   Bad _ -> Nothing
249
             | otherwise -> Nothing
250

    
251
-- | Get data report for the specified Data Collector and Node from the map.
252
fromFile :: DataCollector -> Node.Node -> MapMonDData -> Maybe DCReport
253
fromFile dc node m =
254
  let matchDCName dcr = dName dc == dcReportName dcr
255
  in maybe Nothing (L.find matchDCName) $ Map.lookup (Node.name node) m
256

    
257
-- | Query a MonD for a single Data Collector.
258
queryAMonD :: Maybe MapMonDData -> DataCollector -> Node.Node
259
              -> IO (Maybe Node.Node)
260
queryAMonD m dc node = do
261
  dcReport <-
262
    case m of
263
      Nothing -> fromCurl dc node
264
      Just m' -> return $ fromFile dc node m'
265
  case mkReport dc dcReport of
266
    Nothing -> return Nothing
267
    Just report ->
268
      case report of
269
        CPUavgloadReport cav ->
270
          let ct = cavCpuTotal cav
271
              du = Node.utilLoad node
272
              du' = du {cpuWeight = ct}
273
          in return $ Just node {Node.utilLoad = du'}
274

    
275
-- | Update utilization data.
276
updateUtilData :: Instance.List -> Node.Node -> Instance.List
277
updateUtilData il node =
278
  let ct = cpuWeight (Node.utilLoad node)
279
      n_uCpu = Node.uCpu node
280
      upd inst =
281
        if Node.idx node == Instance.pNode inst
282
          then
283
            let i_vcpus = Instance.vcpus inst
284
                i_util = ct / fromIntegral n_uCpu * fromIntegral i_vcpus
285
                i_du = Instance.util inst
286
                i_du' = i_du {cpuWeight = i_util}
287
            in inst {Instance.util = i_du'}
288
          else inst
289
  in Container.map upd il
290

    
291
-- | Prepare url to query a single collector.
292
prepareUrl :: DataCollector -> Node.Node -> URLString
293
prepareUrl dc node =
294
  Node.name node ++ ":" ++ show C.defaultMondPort ++ "/"
295
  ++ show C.mondLatestApiVersion ++ "/report/" ++
296
  getDCCName (dCategory dc) ++ "/" ++ dName dc
297

    
298
-- | Get Category Name.
299
getDCCName :: Maybe DCCategory -> String
300
getDCCName dcc =
301
  case dcc of
302
    Nothing -> "default"
303
    Just c -> getCategoryName c