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
|