Revision 218e3b0f src/Ganeti/Confd/Server.hs
b/src/Ganeti/Confd/Server.hs | ||
---|---|---|
1 |
{-# LANGUAGE BangPatterns #-} |
|
2 |
|
|
3 | 1 |
{-| Implementation of the Ganeti confd server functionality. |
4 | 2 |
|
5 | 3 |
-} |
... | ... | |
32 | 30 |
) where |
33 | 31 |
|
34 | 32 |
import Control.Concurrent |
35 |
import Control.Exception |
|
36 |
import Control.Monad (forever, liftM, unless) |
|
33 |
import Control.Monad (forever, liftM) |
|
37 | 34 |
import Data.IORef |
38 | 35 |
import Data.List |
39 | 36 |
import qualified Data.Map as M |
... | ... | |
41 | 38 |
import qualified Network.Socket as S |
42 | 39 |
import System.Exit |
43 | 40 |
import System.IO |
44 |
import System.Posix.Files |
|
45 |
import System.Posix.Types |
|
46 | 41 |
import qualified Text.JSON as J |
47 |
import System.INotify |
|
48 | 42 |
|
49 | 43 |
import Ganeti.BasicTypes |
50 | 44 |
import Ganeti.Errors |
... | ... | |
54 | 48 |
import Ganeti.Confd.Types |
55 | 49 |
import Ganeti.Confd.Utils |
56 | 50 |
import Ganeti.Config |
51 |
import Ganeti.ConfigReader |
|
57 | 52 |
import Ganeti.Hash |
58 | 53 |
import Ganeti.Logging |
59 | 54 |
import qualified Ganeti.Constants as C |
60 |
import qualified Ganeti.Path as Path |
|
61 | 55 |
import Ganeti.Query.Server (prepQueryD, runQueryD) |
62 | 56 |
import Ganeti.Utils |
63 | 57 |
|
... | ... | |
66 | 60 |
-- | What we store as configuration. |
67 | 61 |
type CRef = IORef (Result (ConfigData, LinkIpMap)) |
68 | 62 |
|
69 |
-- | File stat identifier. |
|
70 |
type FStat = (EpochTime, FileID, FileOffset) |
|
71 |
|
|
72 |
-- | Null 'FStat' value. |
|
73 |
nullFStat :: FStat |
|
74 |
nullFStat = (-1, -1, -1) |
|
75 |
|
|
76 | 63 |
-- | A small type alias for readability. |
77 | 64 |
type StatusAnswer = (ConfdReplyStatus, J.JSValue) |
78 | 65 |
|
79 |
-- | Reload model data type. |
|
80 |
data ReloadModel = ReloadNotify -- ^ We are using notifications |
|
81 |
| ReloadPoll Int -- ^ We are using polling |
|
82 |
deriving (Eq, Show) |
|
83 |
|
|
84 |
-- | Server state data type. |
|
85 |
data ServerState = ServerState |
|
86 |
{ reloadModel :: ReloadModel |
|
87 |
, reloadTime :: Integer -- ^ Reload time (epoch) in microseconds |
|
88 |
, reloadFStat :: FStat |
|
89 |
} |
|
90 |
|
|
91 |
-- | Maximum no-reload poll rounds before reverting to inotify. |
|
92 |
maxIdlePollRounds :: Int |
|
93 |
maxIdlePollRounds = 3 |
|
94 |
|
|
95 |
-- | Reload timeout in microseconds. |
|
96 |
watchInterval :: Int |
|
97 |
watchInterval = C.confdConfigReloadTimeout * 1000000 |
|
98 |
|
|
99 |
-- | Ratelimit timeout in microseconds. |
|
100 |
pollInterval :: Int |
|
101 |
pollInterval = C.confdConfigReloadRatelimit |
|
102 |
|
|
103 |
-- | Ratelimit timeout in microseconds, as an 'Integer'. |
|
104 |
reloadRatelimit :: Integer |
|
105 |
reloadRatelimit = fromIntegral C.confdConfigReloadRatelimit |
|
106 |
|
|
107 |
-- | Initial poll round. |
|
108 |
initialPoll :: ReloadModel |
|
109 |
initialPoll = ReloadPoll 0 |
|
110 |
|
|
111 |
-- | Reload status data type. |
|
112 |
data ConfigReload = ConfigToDate -- ^ No need to reload |
|
113 |
| ConfigReloaded -- ^ Configuration reloaded |
|
114 |
| ConfigIOError -- ^ Error during configuration reload |
|
115 |
deriving (Eq) |
|
116 |
|
|
117 | 66 |
-- | Unknown entry standard response. |
118 | 67 |
queryUnknownEntry :: StatusAnswer |
119 | 68 |
queryUnknownEntry = (ReplyStatusError, J.showJSON ConfdErrorUnknownEntry) |
... | ... | |
261 | 210 |
, confdReplyAnswer = result |
262 | 211 |
, confdReplySerial = 0 } |
263 | 212 |
|
264 |
-- * Configuration handling |
|
265 |
|
|
266 |
-- ** Helper functions |
|
267 |
|
|
268 |
-- | Helper function for logging transition into polling mode. |
|
269 |
moveToPolling :: String -> INotify -> FilePath -> CRef -> MVar ServerState |
|
270 |
-> IO ReloadModel |
|
271 |
moveToPolling msg inotify path cref mstate = do |
|
272 |
logInfo $ "Moving to polling mode: " ++ msg |
|
273 |
let inotiaction = addNotifier inotify path cref mstate |
|
274 |
_ <- forkIO $ onPollTimer inotiaction path cref mstate |
|
275 |
return initialPoll |
|
276 |
|
|
277 |
-- | Helper function for logging transition into inotify mode. |
|
278 |
moveToNotify :: IO ReloadModel |
|
279 |
moveToNotify = do |
|
280 |
logInfo "Moving to inotify mode" |
|
281 |
return ReloadNotify |
|
282 |
|
|
283 |
-- ** Configuration loading |
|
284 |
|
|
285 |
-- | (Re)loads the configuration. |
|
286 |
updateConfig :: FilePath -> CRef -> IO () |
|
287 |
updateConfig path r = do |
|
288 |
newcfg <- loadConfig path |
|
289 |
let !newdata = case newcfg of |
|
290 |
Ok !cfg -> Ok (cfg, buildLinkIpInstnameMap cfg) |
|
291 |
Bad _ -> Bad "Cannot load configuration" |
|
292 |
writeIORef r newdata |
|
293 |
case newcfg of |
|
294 |
Ok cfg -> logInfo ("Loaded new config, serial " ++ |
|
295 |
show (configSerial cfg)) |
|
296 |
Bad msg -> logError $ "Failed to load config: " ++ msg |
|
297 |
return () |
|
298 |
|
|
299 |
-- | Wrapper over 'updateConfig' that handles IO errors. |
|
300 |
safeUpdateConfig :: FilePath -> FStat -> CRef -> IO (FStat, ConfigReload) |
|
301 |
safeUpdateConfig path oldfstat cref = |
|
302 |
Control.Exception.catch |
|
303 |
(do |
|
304 |
nt <- needsReload oldfstat path |
|
305 |
case nt of |
|
306 |
Nothing -> return (oldfstat, ConfigToDate) |
|
307 |
Just nt' -> do |
|
308 |
updateConfig path cref |
|
309 |
return (nt', ConfigReloaded) |
|
310 |
) (\e -> do |
|
311 |
let msg = "Failure during configuration update: " ++ |
|
312 |
show (e::IOError) |
|
313 |
writeIORef cref (Bad msg) |
|
314 |
return (nullFStat, ConfigIOError) |
|
315 |
) |
|
316 |
|
|
317 |
-- | Computes the file cache data from a FileStatus structure. |
|
318 |
buildFileStatus :: FileStatus -> FStat |
|
319 |
buildFileStatus ofs = |
|
320 |
let modt = modificationTime ofs |
|
321 |
inum = fileID ofs |
|
322 |
fsize = fileSize ofs |
|
323 |
in (modt, inum, fsize) |
|
324 |
|
|
325 |
-- | Wrapper over 'buildFileStatus'. This reads the data from the |
|
326 |
-- filesystem and then builds our cache structure. |
|
327 |
getFStat :: FilePath -> IO FStat |
|
328 |
getFStat p = liftM buildFileStatus (getFileStatus p) |
|
329 |
|
|
330 |
-- | Check if the file needs reloading |
|
331 |
needsReload :: FStat -> FilePath -> IO (Maybe FStat) |
|
332 |
needsReload oldstat path = do |
|
333 |
newstat <- getFStat path |
|
334 |
return $ if newstat /= oldstat |
|
335 |
then Just newstat |
|
336 |
else Nothing |
|
337 |
|
|
338 |
-- ** Watcher threads |
|
339 |
|
|
340 |
-- $watcher |
|
341 |
-- We have three threads/functions that can mutate the server state: |
|
342 |
-- |
|
343 |
-- 1. the long-interval watcher ('onWatcherTimer') |
|
344 |
-- |
|
345 |
-- 2. the polling watcher ('onPollTimer') |
|
346 |
-- |
|
347 |
-- 3. the inotify event handler ('onInotify') |
|
348 |
-- |
|
349 |
-- All of these will mutate the server state under 'modifyMVar' or |
|
350 |
-- 'modifyMVar_', so that server transitions are more or less |
|
351 |
-- atomic. The inotify handler remains active during polling mode, but |
|
352 |
-- checks for polling mode and doesn't do anything in this case (this |
|
353 |
-- check is needed even if we would unregister the event handler due |
|
354 |
-- to how events are serialised). |
|
355 |
|
|
356 |
-- | Long-interval reload watcher. |
|
357 |
-- |
|
358 |
-- This is on top of the inotify-based triggered reload. |
|
359 |
onWatcherTimer :: IO Bool -> FilePath -> CRef -> MVar ServerState -> IO () |
|
360 |
onWatcherTimer inotiaction path cref state = do |
|
361 |
threadDelay watchInterval |
|
362 |
logDebug "Watcher timer fired" |
|
363 |
modifyMVar_ state (onWatcherInner path cref) |
|
364 |
_ <- inotiaction |
|
365 |
onWatcherTimer inotiaction path cref state |
|
366 |
|
|
367 |
-- | Inner onWatcher handler. |
|
368 |
-- |
|
369 |
-- This mutates the server state under a modifyMVar_ call. It never |
|
370 |
-- changes the reload model, just does a safety reload and tried to |
|
371 |
-- re-establish the inotify watcher. |
|
372 |
onWatcherInner :: FilePath -> CRef -> ServerState -> IO ServerState |
|
373 |
onWatcherInner path cref state = do |
|
374 |
(newfstat, _) <- safeUpdateConfig path (reloadFStat state) cref |
|
375 |
return state { reloadFStat = newfstat } |
|
376 |
|
|
377 |
-- | Short-interval (polling) reload watcher. |
|
378 |
-- |
|
379 |
-- This is only active when we're in polling mode; it will |
|
380 |
-- automatically exit when it detects that the state has changed to |
|
381 |
-- notification. |
|
382 |
onPollTimer :: IO Bool -> FilePath -> CRef -> MVar ServerState -> IO () |
|
383 |
onPollTimer inotiaction path cref state = do |
|
384 |
threadDelay pollInterval |
|
385 |
logDebug "Poll timer fired" |
|
386 |
continue <- modifyMVar state (onPollInner inotiaction path cref) |
|
387 |
if continue |
|
388 |
then onPollTimer inotiaction path cref state |
|
389 |
else logDebug "Inotify watch active, polling thread exiting" |
|
390 |
|
|
391 |
-- | Inner onPoll handler. |
|
392 |
-- |
|
393 |
-- This again mutates the state under a modifyMVar call, and also |
|
394 |
-- returns whether the thread should continue or not. |
|
395 |
onPollInner :: IO Bool -> FilePath -> CRef -> ServerState |
|
396 |
-> IO (ServerState, Bool) |
|
397 |
onPollInner _ _ _ state@(ServerState { reloadModel = ReloadNotify } ) = |
|
398 |
return (state, False) |
|
399 |
onPollInner inotiaction path cref |
|
400 |
state@(ServerState { reloadModel = ReloadPoll pround } ) = do |
|
401 |
(newfstat, reload) <- safeUpdateConfig path (reloadFStat state) cref |
|
402 |
let state' = state { reloadFStat = newfstat } |
|
403 |
-- compute new poll model based on reload data; however, failure to |
|
404 |
-- re-establish the inotifier means we stay on polling |
|
405 |
newmode <- case reload of |
|
406 |
ConfigToDate -> |
|
407 |
if pround >= maxIdlePollRounds |
|
408 |
then do -- try to switch to notify |
|
409 |
result <- inotiaction |
|
410 |
if result |
|
411 |
then moveToNotify |
|
412 |
else return initialPoll |
|
413 |
else return (ReloadPoll (pround + 1)) |
|
414 |
_ -> return initialPoll |
|
415 |
let continue = case newmode of |
|
416 |
ReloadNotify -> False |
|
417 |
_ -> True |
|
418 |
return (state' { reloadModel = newmode }, continue) |
|
419 |
|
|
420 |
-- the following hint is because hlint doesn't understand our const |
|
421 |
-- (return False) is so that we can give a signature to 'e' |
|
422 |
{-# ANN addNotifier "HLint: ignore Evaluate" #-} |
|
423 |
-- | Setup inotify watcher. |
|
424 |
-- |
|
425 |
-- This tries to setup the watch descriptor; in case of any IO errors, |
|
426 |
-- it will return False. |
|
427 |
addNotifier :: INotify -> FilePath -> CRef -> MVar ServerState -> IO Bool |
|
428 |
addNotifier inotify path cref mstate = |
|
429 |
Control.Exception.catch |
|
430 |
(addWatch inotify [CloseWrite] path |
|
431 |
(onInotify inotify path cref mstate) >> return True) |
|
432 |
(\e -> const (return False) (e::IOError)) |
|
433 |
|
|
434 |
-- | Inotify event handler. |
|
435 |
onInotify :: INotify -> String -> CRef -> MVar ServerState -> Event -> IO () |
|
436 |
onInotify inotify path cref mstate Ignored = do |
|
437 |
logDebug "File lost, trying to re-establish notifier" |
|
438 |
modifyMVar_ mstate $ \state -> do |
|
439 |
result <- addNotifier inotify path cref mstate |
|
440 |
(newfstat, _) <- safeUpdateConfig path (reloadFStat state) cref |
|
441 |
let state' = state { reloadFStat = newfstat } |
|
442 |
if result |
|
443 |
then return state' -- keep notify |
|
444 |
else do |
|
445 |
mode <- moveToPolling "cannot re-establish inotify watch" inotify |
|
446 |
path cref mstate |
|
447 |
return state' { reloadModel = mode } |
|
448 |
|
|
449 |
onInotify inotify path cref mstate _ = |
|
450 |
modifyMVar_ mstate $ \state -> |
|
451 |
if reloadModel state == ReloadNotify |
|
452 |
then do |
|
453 |
ctime <- getCurrentTimeUSec |
|
454 |
(newfstat, _) <- safeUpdateConfig path (reloadFStat state) cref |
|
455 |
let state' = state { reloadFStat = newfstat, reloadTime = ctime } |
|
456 |
if abs (reloadTime state - ctime) < reloadRatelimit |
|
457 |
then do |
|
458 |
mode <- moveToPolling "too many reloads" inotify path cref mstate |
|
459 |
return state' { reloadModel = mode } |
|
460 |
else return state' |
|
461 |
else return state |
|
462 |
|
|
463 | 213 |
-- ** Client input/output handlers |
464 | 214 |
|
465 | 215 |
-- | Main loop for a given client. |
... | ... | |
501 | 251 |
return () |
502 | 252 |
|
503 | 253 |
-- | Extract the configuration from our IORef. |
504 |
configReader :: CRef -> IO (Result ConfigData)
|
|
254 |
configReader :: CRef -> ConfigReader
|
|
505 | 255 |
configReader cref = do |
506 | 256 |
cdata <- readIORef cref |
507 | 257 |
return $ liftM fst cdata |
... | ... | |
533 | 283 |
-- | Main function. |
534 | 284 |
main :: MainFn (S.Family, S.SockAddr) PrepResult |
535 | 285 |
main _ _ (s, query_data, cref) = do |
536 |
-- Inotify setup |
|
537 |
inotify <- initINotify |
|
538 |
-- try to load the configuration, if possible |
|
539 |
conf_file <- Path.clusterConfFile |
|
540 |
(fstat, reloaded) <- safeUpdateConfig conf_file nullFStat cref |
|
541 |
ctime <- getCurrentTime |
|
542 |
statemvar <- newMVar $ ServerState ReloadNotify ctime fstat |
|
543 |
let inotiaction = addNotifier inotify conf_file cref statemvar |
|
544 |
has_inotify <- if reloaded == ConfigReloaded |
|
545 |
then inotiaction |
|
546 |
else return False |
|
547 |
if has_inotify |
|
548 |
then logInfo "Starting up in inotify mode" |
|
549 |
else do |
|
550 |
-- inotify was not enabled, we need to update the reload model |
|
551 |
logInfo "Starting up in polling mode" |
|
552 |
modifyMVar_ statemvar |
|
553 |
(\state -> return state { reloadModel = initialPoll }) |
|
286 |
let cfg_transform :: Result ConfigData -> Result (ConfigData, LinkIpMap) |
|
287 |
cfg_transform = liftM (\cfg -> (cfg, buildLinkIpInstnameMap cfg)) |
|
288 |
initConfigReader cfg_transform cref |
|
289 |
|
|
554 | 290 |
hmac <- getClusterHmac |
555 |
-- fork the timeout timer |
|
556 |
_ <- forkIO $ onWatcherTimer inotiaction conf_file cref statemvar |
|
557 |
-- fork the polling timer |
|
558 |
unless has_inotify $ do |
|
559 |
_ <- forkIO $ onPollTimer inotiaction conf_file cref statemvar |
|
560 |
return () |
|
561 | 291 |
-- launch the queryd listener |
562 | 292 |
_ <- forkIO $ runQueryD query_data (configReader cref) |
563 | 293 |
-- and finally enter the responder loop |
Also available in: Unified diff