Revision 3792fa8e src/Ganeti/Monitoring/Server.hs
b/src/Ganeti/Monitoring/Server.hs | ||
---|---|---|
36 | 36 |
import Control.Monad.IO.Class |
37 | 37 |
import Data.ByteString.Char8 hiding (map, filter, find) |
38 | 38 |
import Data.List |
39 |
import qualified Data.Map as Map |
|
39 | 40 |
import Snap.Core |
40 | 41 |
import Snap.Http.Server |
41 | 42 |
import qualified Text.JSON as J |
43 |
import Control.Concurrent |
|
42 | 44 |
|
43 | 45 |
import qualified Ganeti.BasicTypes as BT |
44 | 46 |
import Ganeti.Daemon |
47 |
import qualified Ganeti.DataCollectors.CPUload as CPUload |
|
45 | 48 |
import qualified Ganeti.DataCollectors.Diskstats as Diskstats |
46 | 49 |
import qualified Ganeti.DataCollectors.Drbd as Drbd |
47 | 50 |
import qualified Ganeti.DataCollectors.InstStatus as InstStatus |
... | ... | |
61 | 64 |
latestAPIVersion :: Int |
62 | 65 |
latestAPIVersion = 1 |
63 | 66 |
|
67 |
-- | A report of a data collector might be stateful or stateless. |
|
68 |
data Report = StatelessR (IO DCReport) |
|
69 |
| StatefulR (Maybe CollectorData -> IO DCReport) |
|
70 |
|
|
64 | 71 |
-- | Type describing a data collector basic information |
65 | 72 |
data DataCollector = DataCollector |
66 | 73 |
{ dName :: String -- ^ Name of the data collector |
... | ... | |
68 | 75 |
-- of the collector |
69 | 76 |
, dKind :: DCKind -- ^ Kind (performance or status reporting) of |
70 | 77 |
-- the data collector |
71 |
, dReport :: IO DCReport -- ^ Report produced by the collector |
|
78 |
, dReport :: Report -- ^ Report produced by the collector |
|
79 |
, dUpdate :: Maybe (Maybe CollectorData -> IO CollectorData) |
|
80 |
-- ^ Update operation for stateful collectors. |
|
72 | 81 |
} |
73 | 82 |
|
83 |
|
|
74 | 84 |
-- | The list of available builtin data collectors. |
75 | 85 |
collectors :: [DataCollector] |
76 | 86 |
collectors = |
77 | 87 |
[ DataCollector Diskstats.dcName Diskstats.dcCategory Diskstats.dcKind |
78 |
Diskstats.dcReport |
|
79 |
, DataCollector Drbd.dcName Drbd.dcCategory Drbd.dcKind Drbd.dcReport |
|
88 |
(StatelessR Diskstats.dcReport) Nothing |
|
89 |
, DataCollector Drbd.dcName Drbd.dcCategory Drbd.dcKind |
|
90 |
(StatelessR Drbd.dcReport) Nothing |
|
80 | 91 |
, DataCollector InstStatus.dcName InstStatus.dcCategory InstStatus.dcKind |
81 |
InstStatus.dcReport |
|
82 |
, DataCollector Lv.dcName Lv.dcCategory Lv.dcKind Lv.dcReport |
|
92 |
(StatelessR InstStatus.dcReport) Nothing |
|
93 |
, DataCollector Lv.dcName Lv.dcCategory Lv.dcKind |
|
94 |
(StatelessR Lv.dcReport) Nothing |
|
95 |
, DataCollector CPUload.dcName CPUload.dcCategory CPUload.dcKind |
|
96 |
(StatefulR CPUload.dcReport) (Just CPUload.dcUpdate) |
|
83 | 97 |
] |
84 | 98 |
|
85 | 99 |
-- * Configuration handling |
... | ... | |
113 | 127 |
versionQ = writeBS . pack $ J.encode [latestAPIVersion] |
114 | 128 |
|
115 | 129 |
-- | Version 1 of the monitoring HTTP API. |
116 |
version1Api :: Snap () |
|
117 |
version1Api = |
|
130 |
version1Api :: MVar CollectorMap -> Snap ()
|
|
131 |
version1Api mvar =
|
|
118 | 132 |
let returnNull = writeBS . pack $ J.encode J.JSNull :: Snap () |
119 | 133 |
in ifTop returnNull <|> |
120 | 134 |
route |
121 | 135 |
[ ("list", listHandler) |
122 |
, ("report", reportHandler) |
|
136 |
, ("report", reportHandler mvar)
|
|
123 | 137 |
] |
124 | 138 |
|
125 | 139 |
-- | Get the JSON representation of a data collector to be used in the collector |
... | ... | |
138 | 152 |
dir "collectors" . writeBS . pack . J.encode $ map dcListItem collectors |
139 | 153 |
|
140 | 154 |
-- | Handler for returning data collector reports. |
141 |
reportHandler :: Snap () |
|
142 |
reportHandler = |
|
155 |
reportHandler :: MVar CollectorMap -> Snap ()
|
|
156 |
reportHandler mvar =
|
|
143 | 157 |
route |
144 |
[ ("all", allReports) |
|
145 |
, (":category/:collector", oneReport) |
|
158 |
[ ("all", allReports mvar)
|
|
159 |
, (":category/:collector", oneReport mvar)
|
|
146 | 160 |
] <|> |
147 | 161 |
errorReport |
148 | 162 |
|
149 | 163 |
-- | Return the report of all the available collectors. |
150 |
allReports :: Snap () |
|
151 |
allReports = do |
|
152 |
reports <- mapM (liftIO . dReport) collectors
|
|
164 |
allReports :: MVar CollectorMap -> Snap ()
|
|
165 |
allReports mvar = do
|
|
166 |
reports <- mapM (liftIO . getReport mvar) collectors
|
|
153 | 167 |
writeBS . pack . J.encode $ reports |
154 | 168 |
|
169 |
-- | Takes the CollectorMap and a DataCollector and returns the report for this |
|
170 |
-- collector. |
|
171 |
getReport :: MVar CollectorMap -> DataCollector -> IO DCReport |
|
172 |
getReport mvar collector = |
|
173 |
case dReport collector of |
|
174 |
StatelessR r -> r |
|
175 |
StatefulR r -> do |
|
176 |
colData <- getColData (dName collector) mvar |
|
177 |
r colData |
|
178 |
|
|
179 |
-- | Returns the data for the corresponding collector. |
|
180 |
getColData :: String -> MVar CollectorMap -> IO (Maybe CollectorData) |
|
181 |
getColData name mvar = do |
|
182 |
m <- readMVar mvar |
|
183 |
return $ Map.lookup name m |
|
184 |
|
|
155 | 185 |
-- | Returns a category given its name. |
156 | 186 |
-- If "collector" is given as the name, the collector has no category, and |
157 | 187 |
-- Nothing will be returned. |
... | ... | |
173 | 203 |
modifyResponse $ setResponseStatus 404 "Not found" |
174 | 204 |
writeBS "Resource not found" |
175 | 205 |
|
176 |
-- | Return the report of one collector |
|
177 |
oneReport :: Snap () |
|
178 |
oneReport = do |
|
206 |
-- | Return the report of one collector.
|
|
207 |
oneReport :: MVar CollectorMap -> Snap ()
|
|
208 |
oneReport mvar = do
|
|
179 | 209 |
categoryName <- fmap (maybe mzero unpack) $ getParam "category" |
180 | 210 |
collectorName <- fmap (maybe mzero unpack) $ getParam "collector" |
181 | 211 |
category <- |
... | ... | |
188 | 218 |
filter (\c -> category == dCategory c) collectors of |
189 | 219 |
Just col -> return col |
190 | 220 |
Nothing -> fail "Unable to find the requested collector" |
191 |
report <- liftIO $ dReport collector
|
|
192 |
writeBS . pack . J.encode $ report
|
|
221 |
dcr <- liftIO $ getReport mvar collector
|
|
222 |
writeBS . pack . J.encode $ dcr
|
|
193 | 223 |
|
194 | 224 |
-- | The function implementing the HTTP API of the monitoring agent. |
195 |
monitoringApi :: Snap () |
|
196 |
monitoringApi = |
|
225 |
monitoringApi :: MVar CollectorMap -> Snap ()
|
|
226 |
monitoringApi mvar =
|
|
197 | 227 |
ifTop versionQ <|> |
198 |
dir "1" version1Api <|>
|
|
228 |
dir "1" (version1Api mvar) <|>
|
|
199 | 229 |
error404 |
200 | 230 |
|
231 |
-- | The function collecting data for each data collector providing a dcUpdate |
|
232 |
-- function. |
|
233 |
collect :: CollectorMap -> DataCollector -> IO CollectorMap |
|
234 |
collect m collector = |
|
235 |
case dUpdate collector of |
|
236 |
Nothing -> return m |
|
237 |
Just update -> do |
|
238 |
let name = dName collector |
|
239 |
existing = Map.lookup name m |
|
240 |
new_data <- update existing |
|
241 |
return $ Map.insert name new_data m |
|
242 |
|
|
243 |
-- | Invokes collect for each data collector. |
|
244 |
collection :: CollectorMap -> IO CollectorMap |
|
245 |
collection m = foldM collect m collectors |
|
246 |
|
|
247 |
-- | The thread responsible for the periodical collection of data for each data |
|
248 |
-- data collector. |
|
249 |
collectord :: MVar CollectorMap -> IO () |
|
250 |
collectord mvar = do |
|
251 |
m <- takeMVar mvar |
|
252 |
m' <- collection m |
|
253 |
putMVar mvar m' |
|
254 |
threadDelay $ 10^(6 :: Int) * C.mondTimeInterval |
|
255 |
collectord mvar |
|
256 |
|
|
201 | 257 |
-- | Main function. |
202 | 258 |
main :: MainFn CheckResult PrepResult |
203 |
main _ _ httpConf = |
|
204 |
httpServe httpConf $ method GET monitoringApi |
|
259 |
main _ _ httpConf = do |
|
260 |
mvar <- newMVar Map.empty |
|
261 |
_ <- forkIO $ collectord mvar |
|
262 |
httpServe httpConf . method GET $ monitoringApi mvar |
Also available in: Unified diff