Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Monitoring / Server.hs @ 690e509d

History | View | Annotate | Download (8.5 kB)

1
{-# LANGUAGE OverloadedStrings #-}
2

    
3
{-| Implementation of the Ganeti confd server functionality.
4

    
5
-}
6

    
7
{-
8

    
9
Copyright (C) 2013 Google Inc.
10

    
11
This program is free software; you can redistribute it and/or modify
12
it under the terms of the GNU General Public License as published by
13
the Free Software Foundation; either version 2 of the License, or
14
(at your option) any later version.
15

    
16
This program is distributed in the hope that it will be useful, but
17
WITHOUT ANY WARRANTY; without even the implied warranty of
18
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
19
General Public License for more details.
20

    
21
You should have received a copy of the GNU General Public License
22
along with this program; if not, write to the Free Software
23
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
24
02110-1301, USA.
25

    
26
-}
27

    
28
module Ganeti.Monitoring.Server
29
  ( main
30
  , checkMain
31
  , prepMain
32
  ) where
33

    
34
import Control.Applicative
35
import Control.Monad
36
import Control.Monad.IO.Class
37
import Data.ByteString.Char8 hiding (map, filter, find)
38
import Data.List
39
import qualified Data.Map as Map
40
import Snap.Core
41
import Snap.Http.Server
42
import qualified Text.JSON as J
43
import Control.Concurrent
44

    
45
import qualified Ganeti.BasicTypes as BT
46
import Ganeti.Daemon
47
import qualified Ganeti.DataCollectors.CPUload as CPUload
48
import qualified Ganeti.DataCollectors.Diskstats as Diskstats
49
import qualified Ganeti.DataCollectors.Drbd as Drbd
50
import qualified Ganeti.DataCollectors.InstStatus as InstStatus
51
import qualified Ganeti.DataCollectors.Lv as Lv
52
import Ganeti.DataCollectors.Types
53
import qualified Ganeti.Constants as C
54
import Ganeti.Runtime
55

    
56
-- * Types and constants definitions
57

    
58
-- | Type alias for checkMain results.
59
type CheckResult = ()
60

    
61
-- | Type alias for prepMain results.
62
type PrepResult = Config Snap ()
63

    
64
-- | Version of the latest supported http API.
65
latestAPIVersion :: Int
66
latestAPIVersion = C.mondLatestApiVersion
67

    
68
-- | A report of a data collector might be stateful or stateless.
69
data Report = StatelessR (IO DCReport)
70
            | StatefulR (Maybe CollectorData -> IO DCReport)
71

    
72
-- | Type describing a data collector basic information
73
data DataCollector = DataCollector
74
  { dName     :: String           -- ^ Name of the data collector
75
  , dCategory :: Maybe DCCategory -- ^ Category (storage, instance, ecc)
76
                                  --   of the collector
77
  , dKind     :: DCKind           -- ^ Kind (performance or status reporting) of
78
                                  --   the data collector
79
  , dReport   :: Report           -- ^ Report produced by the collector
80
  , dUpdate   :: Maybe (Maybe CollectorData -> IO CollectorData)
81
                                  -- ^ Update operation for stateful collectors.
82
  }
83

    
84

    
85
-- | The list of available builtin data collectors.
86
collectors :: [DataCollector]
87
collectors =
88
  [ DataCollector Diskstats.dcName Diskstats.dcCategory Diskstats.dcKind
89
      (StatelessR Diskstats.dcReport) Nothing
90
  , DataCollector Drbd.dcName Drbd.dcCategory Drbd.dcKind
91
      (StatelessR Drbd.dcReport) Nothing
92
  , DataCollector InstStatus.dcName InstStatus.dcCategory InstStatus.dcKind
93
      (StatelessR InstStatus.dcReport) Nothing
94
  , DataCollector Lv.dcName Lv.dcCategory Lv.dcKind
95
      (StatelessR Lv.dcReport) Nothing
96
  , DataCollector CPUload.dcName CPUload.dcCategory CPUload.dcKind
97
      (StatefulR CPUload.dcReport) (Just CPUload.dcUpdate)
98
  ]
99

    
100
-- * Configuration handling
101

    
102
-- | The default configuration for the HTTP server.
103
defaultHttpConf :: FilePath -> FilePath -> Config Snap ()
104
defaultHttpConf accessLog errorLog =
105
  setAccessLog (ConfigFileLog accessLog) .
106
  setCompression False .
107
  setErrorLog (ConfigFileLog errorLog) $
108
  setVerbose False
109
  emptyConfig
110

    
111
-- * Helper functions
112

    
113
-- | Check function for the monitoring agent.
114
checkMain :: CheckFn CheckResult
115
checkMain _ = return $ Right ()
116

    
117
-- | Prepare function for monitoring agent.
118
prepMain :: PrepFn CheckResult PrepResult
119
prepMain opts _ = do
120
  accessLog <- daemonsExtraLogFile GanetiMond AccessLog
121
  errorLog <- daemonsExtraLogFile GanetiMond ErrorLog
122
  return $
123
    setPort
124
      (maybe C.defaultMondPort fromIntegral (optPort opts))
125
      (defaultHttpConf accessLog errorLog)
126

    
127
-- * Query answers
128

    
129
-- | Reply to the supported API version numbers query.
130
versionQ :: Snap ()
131
versionQ = writeBS . pack $ J.encode [latestAPIVersion]
132

    
133
-- | Version 1 of the monitoring HTTP API.
134
version1Api :: MVar CollectorMap -> Snap ()
135
version1Api mvar =
136
  let returnNull = writeBS . pack $ J.encode J.JSNull :: Snap ()
137
  in ifTop returnNull <|>
138
     route
139
       [ ("list", listHandler)
140
       , ("report", reportHandler mvar)
141
       ]
142

    
143
-- | Get the JSON representation of a data collector to be used in the collector
144
-- list.
145
dcListItem :: DataCollector -> J.JSValue
146
dcListItem dc =
147
  J.JSArray
148
    [ J.showJSON $ dName dc
149
    , maybe J.JSNull J.showJSON $ dCategory dc
150
    , J.showJSON $ dKind dc
151
    ]
152

    
153
-- | Handler for returning lists.
154
listHandler :: Snap ()
155
listHandler =
156
  dir "collectors" . writeBS . pack . J.encode $ map dcListItem collectors
157

    
158
-- | Handler for returning data collector reports.
159
reportHandler :: MVar CollectorMap -> Snap ()
160
reportHandler mvar =
161
  route
162
    [ ("all", allReports mvar)
163
    , (":category/:collector", oneReport mvar)
164
    ] <|>
165
  errorReport
166

    
167
-- | Return the report of all the available collectors.
168
allReports :: MVar CollectorMap -> Snap ()
169
allReports mvar = do
170
  reports <- mapM (liftIO . getReport mvar) collectors
171
  writeBS . pack . J.encode $ reports
172

    
173
-- | Takes the CollectorMap and a DataCollector and returns the report for this
174
-- collector.
175
getReport :: MVar CollectorMap -> DataCollector -> IO DCReport
176
getReport mvar collector =
177
  case dReport collector of
178
    StatelessR r -> r
179
    StatefulR r -> do
180
      colData <- getColData (dName collector) mvar
181
      r colData
182

    
183
-- | Returns the data for the corresponding collector.
184
getColData :: String -> MVar CollectorMap -> IO (Maybe CollectorData)
185
getColData name mvar = do
186
  m <- readMVar mvar
187
  return $ Map.lookup name m
188

    
189
-- | Returns a category given its name.
190
-- If "collector" is given as the name, the collector has no category, and
191
-- Nothing will be returned.
192
catFromName :: String -> BT.Result (Maybe DCCategory)
193
catFromName "instance"   = BT.Ok $ Just DCInstance
194
catFromName "storage"    = BT.Ok $ Just DCStorage
195
catFromName "daemon"     = BT.Ok $ Just DCDaemon
196
catFromName "hypervisor" = BT.Ok $ Just DCHypervisor
197
catFromName "default"    = BT.Ok Nothing
198
catFromName _            = BT.Bad "No such category"
199

    
200
errorReport :: Snap ()
201
errorReport = do
202
  modifyResponse $ setResponseStatus 404 "Not found"
203
  writeBS "Unable to produce a report for the requested resource"
204

    
205
error404 :: Snap ()
206
error404 = do
207
  modifyResponse $ setResponseStatus 404 "Not found"
208
  writeBS "Resource not found"
209

    
210
-- | Return the report of one collector.
211
oneReport :: MVar CollectorMap -> Snap ()
212
oneReport mvar = do
213
  categoryName <- fmap (maybe mzero unpack) $ getParam "category"
214
  collectorName <- fmap (maybe mzero unpack) $ getParam "collector"
215
  category <-
216
    case catFromName categoryName of
217
      BT.Ok cat -> return cat
218
      BT.Bad msg -> fail msg
219
  collector <-
220
    case
221
      find (\col -> collectorName == dName col) $
222
        filter (\c -> category == dCategory c) collectors of
223
      Just col -> return col
224
      Nothing -> fail "Unable to find the requested collector"
225
  dcr <- liftIO $ getReport mvar collector
226
  writeBS . pack . J.encode $ dcr
227

    
228
-- | The function implementing the HTTP API of the monitoring agent.
229
monitoringApi :: MVar CollectorMap -> Snap ()
230
monitoringApi mvar =
231
  ifTop versionQ <|>
232
  dir "1" (version1Api mvar) <|>
233
  error404
234

    
235
-- | The function collecting data for each data collector providing a dcUpdate
236
-- function.
237
collect :: CollectorMap -> DataCollector -> IO CollectorMap
238
collect m collector =
239
  case dUpdate collector of
240
    Nothing -> return m
241
    Just update -> do
242
      let name = dName collector
243
          existing = Map.lookup name m
244
      new_data <- update existing
245
      return $ Map.insert name new_data m
246

    
247
-- | Invokes collect for each data collector.
248
collection :: CollectorMap -> IO CollectorMap
249
collection m = foldM collect m collectors
250

    
251
-- | The thread responsible for the periodical collection of data for each data
252
-- data collector.
253
collectord :: MVar CollectorMap -> IO ()
254
collectord mvar = do
255
  m <- takeMVar mvar
256
  m' <- collection m
257
  putMVar mvar m'
258
  threadDelay $ 10^(6 :: Int) * C.mondTimeInterval
259
  collectord mvar
260

    
261
-- | Main function.
262
main :: MainFn CheckResult PrepResult
263
main _ _ httpConf = do
264
  mvar <- newMVar Map.empty
265
  _ <- forkIO $ collectord mvar
266
  httpServe httpConf . method GET $ monitoringApi mvar