Revision 218e3b0f

b/Makefile.am
530 530
	src/Ganeti/Confd/Types.hs \
531 531
	src/Ganeti/Confd/Utils.hs \
532 532
	src/Ganeti/Config.hs \
533
	src/Ganeti/ConfigReader.hs \
533 534
	src/Ganeti/Curl/Multi.hs \
534 535
	src/Ganeti/Daemon.hs \
535 536
	src/Ganeti/DataCollectors/CLI.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
b/src/Ganeti/ConfigReader.hs
1
{-# LANGUAGE BangPatterns #-}
2

  
3
{-| Implementation of configuration reader with watching support.
4

  
5
-}
6

  
7
{-
8

  
9
Copyright (C) 2011, 2012, 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.ConfigReader
29
  ( ConfigReader
30
  , initConfigReader
31
  ) where
32

  
33
import Control.Concurrent
34
import Control.Exception
35
import Control.Monad (liftM, unless)
36
import Data.IORef
37
import System.Posix.Files
38
import System.Posix.Types
39
import System.INotify
40

  
41
import Ganeti.BasicTypes
42
import Ganeti.Objects
43
import Ganeti.Confd.Utils
44
import Ganeti.Config
45
import Ganeti.Logging
46
import qualified Ganeti.Constants as C
47
import qualified Ganeti.Path as Path
48
import Ganeti.Utils
49

  
50
-- | A type for functions that can return the configuration when
51
-- executed.
52
type ConfigReader = IO (Result ConfigData)
53

  
54
-- | File stat identifier.
55
type FStat = (EpochTime, FileID, FileOffset)
56

  
57
-- | Null 'FStat' value.
58
nullFStat :: FStat
59
nullFStat = (-1, -1, -1)
60

  
61
-- | Reload model data type.
62
data ReloadModel = ReloadNotify      -- ^ We are using notifications
63
                 | ReloadPoll Int    -- ^ We are using polling
64
                   deriving (Eq, Show)
65

  
66
-- | Server state data type.
67
data ServerState = ServerState
68
  { reloadModel  :: ReloadModel
69
  , reloadTime   :: Integer      -- ^ Reload time (epoch) in microseconds
70
  , reloadFStat  :: FStat
71
  }
72

  
73
-- | Maximum no-reload poll rounds before reverting to inotify.
74
maxIdlePollRounds :: Int
75
maxIdlePollRounds = 3
76

  
77
-- | Reload timeout in microseconds.
78
watchInterval :: Int
79
watchInterval = C.confdConfigReloadTimeout * 1000000
80

  
81
-- | Ratelimit timeout in microseconds.
82
pollInterval :: Int
83
pollInterval = C.confdConfigReloadRatelimit
84

  
85
-- | Ratelimit timeout in microseconds, as an 'Integer'.
86
reloadRatelimit :: Integer
87
reloadRatelimit = fromIntegral C.confdConfigReloadRatelimit
88

  
89
-- | Initial poll round.
90
initialPoll :: ReloadModel
91
initialPoll = ReloadPoll 0
92

  
93
-- | Reload status data type.
94
data ConfigReload = ConfigToDate    -- ^ No need to reload
95
                  | ConfigReloaded  -- ^ Configuration reloaded
96
                  | ConfigIOError   -- ^ Error during configuration reload
97
                    deriving (Eq)
98

  
99
-- * Configuration handling
100

  
101
-- ** Helper functions
102

  
103
-- | Helper function for logging transition into polling mode.
104
moveToPolling :: String -> INotify -> FilePath -> (Result ConfigData -> IO ())
105
              -> MVar ServerState -> IO ReloadModel
106
moveToPolling msg inotify path save_fn mstate = do
107
  logInfo $ "Moving to polling mode: " ++ msg
108
  let inotiaction = addNotifier inotify path save_fn mstate
109
  _ <- forkIO $ onPollTimer inotiaction path save_fn mstate
110
  return initialPoll
111

  
112
-- | Helper function for logging transition into inotify mode.
113
moveToNotify :: IO ReloadModel
114
moveToNotify = do
115
  logInfo "Moving to inotify mode"
116
  return ReloadNotify
117

  
118
-- ** Configuration loading
119

  
120
-- | (Re)loads the configuration.
121
updateConfig :: FilePath -> (Result ConfigData -> IO ()) -> IO ()
122
updateConfig path save_fn = do
123
  newcfg <- loadConfig path
124
  let !newdata = case newcfg of
125
                   Ok !cfg -> Ok cfg
126
                   Bad _ -> Bad "Cannot load configuration"
127
  save_fn newdata
128
  case newcfg of
129
    Ok cfg -> logInfo ("Loaded new config, serial " ++
130
                       show (configSerial cfg))
131
    Bad msg -> logError $ "Failed to load config: " ++ msg
132
  return ()
133

  
134
-- | Wrapper over 'updateConfig' that handles IO errors.
135
safeUpdateConfig :: FilePath -> FStat -> (Result ConfigData -> IO ())
136
                 -> IO (FStat, ConfigReload)
137
safeUpdateConfig path oldfstat save_fn =
138
  Control.Exception.catch
139
        (do
140
          nt <- needsReload oldfstat path
141
          case nt of
142
            Nothing -> return (oldfstat, ConfigToDate)
143
            Just nt' -> do
144
                    updateConfig path save_fn
145
                    return (nt', ConfigReloaded)
146
        ) (\e -> do
147
             let msg = "Failure during configuration update: " ++
148
                       show (e::IOError)
149
             save_fn $ Bad msg
150
             return (nullFStat, ConfigIOError)
151
          )
152

  
153
-- | Computes the file cache data from a FileStatus structure.
154
buildFileStatus :: FileStatus -> FStat
155
buildFileStatus ofs =
156
    let modt = modificationTime ofs
157
        inum = fileID ofs
158
        fsize = fileSize ofs
159
    in (modt, inum, fsize)
160

  
161
-- | Wrapper over 'buildFileStatus'. This reads the data from the
162
-- filesystem and then builds our cache structure.
163
getFStat :: FilePath -> IO FStat
164
getFStat p = liftM buildFileStatus (getFileStatus p)
165

  
166
-- | Check if the file needs reloading
167
needsReload :: FStat -> FilePath -> IO (Maybe FStat)
168
needsReload oldstat path = do
169
  newstat <- getFStat path
170
  return $ if newstat /= oldstat
171
             then Just newstat
172
             else Nothing
173

  
174
-- ** Watcher threads
175

  
176
-- $watcher
177
-- We have three threads/functions that can mutate the server state:
178
--
179
-- 1. the long-interval watcher ('onWatcherTimer')
180
--
181
-- 2. the polling watcher ('onPollTimer')
182
--
183
-- 3. the inotify event handler ('onInotify')
184
--
185
-- All of these will mutate the server state under 'modifyMVar' or
186
-- 'modifyMVar_', so that server transitions are more or less
187
-- atomic. The inotify handler remains active during polling mode, but
188
-- checks for polling mode and doesn't do anything in this case (this
189
-- check is needed even if we would unregister the event handler due
190
-- to how events are serialised).
191

  
192
-- | Long-interval reload watcher.
193
--
194
-- This is on top of the inotify-based triggered reload.
195
onWatcherTimer :: IO Bool -> FilePath -> (Result ConfigData -> IO ())
196
               -> MVar ServerState -> IO ()
197
onWatcherTimer inotiaction path save_fn state = do
198
  threadDelay watchInterval
199
  logDebug "Watcher timer fired"
200
  modifyMVar_ state (onWatcherInner path save_fn)
201
  _ <- inotiaction
202
  onWatcherTimer inotiaction path save_fn state
203

  
204
-- | Inner onWatcher handler.
205
--
206
-- This mutates the server state under a modifyMVar_ call. It never
207
-- changes the reload model, just does a safety reload and tried to
208
-- re-establish the inotify watcher.
209
onWatcherInner :: FilePath -> (Result ConfigData -> IO ()) -> ServerState
210
               -> IO ServerState
211
onWatcherInner path save_fn state  = do
212
  (newfstat, _) <- safeUpdateConfig path (reloadFStat state) save_fn
213
  return state { reloadFStat = newfstat }
214

  
215
-- | Short-interval (polling) reload watcher.
216
--
217
-- This is only active when we're in polling mode; it will
218
-- automatically exit when it detects that the state has changed to
219
-- notification.
220
onPollTimer :: IO Bool -> FilePath -> (Result ConfigData -> IO ())
221
            -> MVar ServerState -> IO ()
222
onPollTimer inotiaction path save_fn state = do
223
  threadDelay pollInterval
224
  logDebug "Poll timer fired"
225
  continue <- modifyMVar state (onPollInner inotiaction path save_fn)
226
  if continue
227
    then onPollTimer inotiaction path save_fn state
228
    else logDebug "Inotify watch active, polling thread exiting"
229

  
230
-- | Inner onPoll handler.
231
--
232
-- This again mutates the state under a modifyMVar call, and also
233
-- returns whether the thread should continue or not.
234
onPollInner :: IO Bool -> FilePath -> (Result ConfigData -> IO ())
235
            -> ServerState -> IO (ServerState, Bool)
236
onPollInner _ _ _ state@(ServerState { reloadModel = ReloadNotify } ) =
237
  return (state, False)
238
onPollInner inotiaction path save_fn
239
            state@(ServerState { reloadModel = ReloadPoll pround } ) = do
240
  (newfstat, reload) <- safeUpdateConfig path (reloadFStat state) save_fn
241
  let state' = state { reloadFStat = newfstat }
242
  -- compute new poll model based on reload data; however, failure to
243
  -- re-establish the inotifier means we stay on polling
244
  newmode <- case reload of
245
               ConfigToDate ->
246
                 if pround >= maxIdlePollRounds
247
                   then do -- try to switch to notify
248
                     result <- inotiaction
249
                     if result
250
                       then moveToNotify
251
                       else return initialPoll
252
                   else return (ReloadPoll (pround + 1))
253
               _ -> return initialPoll
254
  let continue = case newmode of
255
                   ReloadNotify -> False
256
                   _            -> True
257
  return (state' { reloadModel = newmode }, continue)
258

  
259
-- the following hint is because hlint doesn't understand our const
260
-- (return False) is so that we can give a signature to 'e'
261
{-# ANN addNotifier "HLint: ignore Evaluate" #-}
262
-- | Setup inotify watcher.
263
--
264
-- This tries to setup the watch descriptor; in case of any IO errors,
265
-- it will return False.
266
addNotifier :: INotify -> FilePath -> (Result ConfigData -> IO ())
267
            -> MVar ServerState -> IO Bool
268
addNotifier inotify path save_fn mstate =
269
  Control.Exception.catch
270
        (addWatch inotify [CloseWrite] path
271
            (onInotify inotify path save_fn mstate) >> return True)
272
        (\e -> const (return False) (e::IOError))
273

  
274
-- | Inotify event handler.
275
onInotify :: INotify -> String -> (Result ConfigData -> IO ())
276
          -> MVar ServerState -> Event -> IO ()
277
onInotify inotify path save_fn mstate Ignored = do
278
  logDebug "File lost, trying to re-establish notifier"
279
  modifyMVar_ mstate $ \state -> do
280
    result <- addNotifier inotify path save_fn mstate
281
    (newfstat, _) <- safeUpdateConfig path (reloadFStat state) save_fn
282
    let state' = state { reloadFStat = newfstat }
283
    if result
284
      then return state' -- keep notify
285
      else do
286
        mode <- moveToPolling "cannot re-establish inotify watch" inotify
287
                  path save_fn mstate
288
        return state' { reloadModel = mode }
289

  
290
onInotify inotify path save_fn mstate _ =
291
  modifyMVar_ mstate $ \state ->
292
    if reloadModel state == ReloadNotify
293
       then do
294
         ctime <- getCurrentTimeUSec
295
         (newfstat, _) <- safeUpdateConfig path (reloadFStat state) save_fn
296
         let state' = state { reloadFStat = newfstat, reloadTime = ctime }
297
         if abs (reloadTime state - ctime) < reloadRatelimit
298
           then do
299
             mode <- moveToPolling "too many reloads" inotify path save_fn
300
                                   mstate
301
             return state' { reloadModel = mode }
302
           else return state'
303
      else return state
304

  
305
initConfigReader :: (Result ConfigData -> a) -> IORef a -> IO ()
306
initConfigReader cfg_transform ioref = do
307
  let save_fn = writeIORef ioref . cfg_transform
308

  
309
  -- Inotify setup
310
  inotify <- initINotify
311
  -- try to load the configuration, if possible
312
  conf_file <- Path.clusterConfFile
313
  (fstat, reloaded) <- safeUpdateConfig conf_file nullFStat save_fn
314
  ctime <- getCurrentTime
315
  statemvar <- newMVar $ ServerState ReloadNotify ctime fstat
316
  let inotiaction = addNotifier inotify conf_file save_fn statemvar
317
  has_inotify <- if reloaded == ConfigReloaded
318
                   then inotiaction
319
                   else return False
320
  if has_inotify
321
    then logInfo "Starting up in inotify mode"
322
    else do
323
      -- inotify was not enabled, we need to update the reload model
324
      logInfo "Starting up in polling mode"
325
      modifyMVar_ statemvar
326
        (\state -> return state { reloadModel = initialPoll })
327
  -- fork the timeout timer
328
  _ <- forkIO $ onWatcherTimer inotiaction conf_file save_fn statemvar
329
  -- fork the polling timer
330
  unless has_inotify $ do
331
    _ <- forkIO $ onPollTimer inotiaction conf_file save_fn statemvar
332
    return ()
b/src/Ganeti/Query/Server.hs
26 26
-}
27 27

  
28 28
module Ganeti.Query.Server
29
  ( ConfigReader
30
  , prepQueryD
29
  ( prepQueryD
31 30
  , runQueryD
32 31
  ) where
33 32

  
......
47 46
import Ganeti.Daemon
48 47
import Ganeti.Objects
49 48
import qualified Ganeti.Config as Config
49
import Ganeti.ConfigReader
50 50
import Ganeti.BasicTypes
51 51
import Ganeti.Logging
52 52
import Ganeti.Luxi
......
55 55
import Ganeti.Query.Query
56 56
import Ganeti.Query.Filter (makeSimpleFilter)
57 57

  
58
-- | A type for functions that can return the configuration when
59
-- executed.
60
type ConfigReader = IO (Result ConfigData)
61

  
62 58
-- | Helper for classic queries.
63 59
handleClassicQuery :: ConfigData      -- ^ Cluster config
64 60
                   -> Qlang.ItemType  -- ^ Query type

Also available in: Unified diff