Extract ConfigReader from Confd/Server.hs
authorThomas Thrainer <thomasth@google.com>
Wed, 3 Jul 2013 14:22:58 +0000 (16:22 +0200)
committerThomas Thrainer <thomasth@google.com>
Wed, 17 Jul 2013 09:33:47 +0000 (11:33 +0200)
Confd's functionality to watch the Ganeti configuration file is
extracted to the ConfigReader module. No functional changes are
introduced.

This extraction makes will enable us to split queryd from confd, as
queryd will have to use the same functionality.

Signed-off-by: Thomas Thrainer <thomasth@google.com>
Reviewed-by: Helga Velroyen <helgav@google.com>

Makefile.am
src/Ganeti/Confd/Server.hs
src/Ganeti/ConfigReader.hs [new file with mode: 0644]
src/Ganeti/Query/Server.hs

index a99c84a..e495f64 100644 (file)
@@ -530,6 +530,7 @@ HS_LIB_SRCS = \
        src/Ganeti/Confd/Types.hs \
        src/Ganeti/Confd/Utils.hs \
        src/Ganeti/Config.hs \
+       src/Ganeti/ConfigReader.hs \
        src/Ganeti/Curl/Multi.hs \
        src/Ganeti/Daemon.hs \
        src/Ganeti/DataCollectors/CLI.hs \
index 4339ce2..adde99a 100644 (file)
@@ -1,5 +1,3 @@
-{-# LANGUAGE BangPatterns #-}
-
 {-| Implementation of the Ganeti confd server functionality.
 
 -}
@@ -32,8 +30,7 @@ module Ganeti.Confd.Server
   ) where
 
 import Control.Concurrent
-import Control.Exception
-import Control.Monad (forever, liftM, unless)
+import Control.Monad (forever, liftM)
 import Data.IORef
 import Data.List
 import qualified Data.Map as M
@@ -41,10 +38,7 @@ import Data.Maybe (fromMaybe)
 import qualified Network.Socket as S
 import System.Exit
 import System.IO
-import System.Posix.Files
-import System.Posix.Types
 import qualified Text.JSON as J
-import System.INotify
 
 import Ganeti.BasicTypes
 import Ganeti.Errors
@@ -54,10 +48,10 @@ import Ganeti.Objects
 import Ganeti.Confd.Types
 import Ganeti.Confd.Utils
 import Ganeti.Config
+import Ganeti.ConfigReader
 import Ganeti.Hash
 import Ganeti.Logging
 import qualified Ganeti.Constants as C
-import qualified Ganeti.Path as Path
 import Ganeti.Query.Server (prepQueryD, runQueryD)
 import Ganeti.Utils
 
@@ -66,54 +60,9 @@ import Ganeti.Utils
 -- | What we store as configuration.
 type CRef = IORef (Result (ConfigData, LinkIpMap))
 
--- | File stat identifier.
-type FStat = (EpochTime, FileID, FileOffset)
-
--- | Null 'FStat' value.
-nullFStat :: FStat
-nullFStat = (-1, -1, -1)
-
 -- | A small type alias for readability.
 type StatusAnswer = (ConfdReplyStatus, J.JSValue)
 
--- | Reload model data type.
-data ReloadModel = ReloadNotify      -- ^ We are using notifications
-                 | ReloadPoll Int    -- ^ We are using polling
-                   deriving (Eq, Show)
-
--- | Server state data type.
-data ServerState = ServerState
-  { reloadModel  :: ReloadModel
-  , reloadTime   :: Integer      -- ^ Reload time (epoch) in microseconds
-  , reloadFStat  :: FStat
-  }
-
--- | Maximum no-reload poll rounds before reverting to inotify.
-maxIdlePollRounds :: Int
-maxIdlePollRounds = 3
-
--- | Reload timeout in microseconds.
-watchInterval :: Int
-watchInterval = C.confdConfigReloadTimeout * 1000000
-
--- | Ratelimit timeout in microseconds.
-pollInterval :: Int
-pollInterval = C.confdConfigReloadRatelimit
-
--- | Ratelimit timeout in microseconds, as an 'Integer'.
-reloadRatelimit :: Integer
-reloadRatelimit = fromIntegral C.confdConfigReloadRatelimit
-
--- | Initial poll round.
-initialPoll :: ReloadModel
-initialPoll = ReloadPoll 0
-
--- | Reload status data type.
-data ConfigReload = ConfigToDate    -- ^ No need to reload
-                  | ConfigReloaded  -- ^ Configuration reloaded
-                  | ConfigIOError   -- ^ Error during configuration reload
-                    deriving (Eq)
-
 -- | Unknown entry standard response.
 queryUnknownEntry :: StatusAnswer
 queryUnknownEntry = (ReplyStatusError, J.showJSON ConfdErrorUnknownEntry)
@@ -261,205 +210,6 @@ serializeResponse r =
                   , confdReplyAnswer   = result
                   , confdReplySerial   = 0 }
 
--- * Configuration handling
-
--- ** Helper functions
-
--- | Helper function for logging transition into polling mode.
-moveToPolling :: String -> INotify -> FilePath -> CRef -> MVar ServerState
-              -> IO ReloadModel
-moveToPolling msg inotify path cref mstate = do
-  logInfo $ "Moving to polling mode: " ++ msg
-  let inotiaction = addNotifier inotify path cref mstate
-  _ <- forkIO $ onPollTimer inotiaction path cref mstate
-  return initialPoll
-
--- | Helper function for logging transition into inotify mode.
-moveToNotify :: IO ReloadModel
-moveToNotify = do
-  logInfo "Moving to inotify mode"
-  return ReloadNotify
-
--- ** Configuration loading
-
--- | (Re)loads the configuration.
-updateConfig :: FilePath -> CRef -> IO ()
-updateConfig path r = do
-  newcfg <- loadConfig path
-  let !newdata = case newcfg of
-                   Ok !cfg -> Ok (cfg, buildLinkIpInstnameMap cfg)
-                   Bad _ -> Bad "Cannot load configuration"
-  writeIORef r newdata
-  case newcfg of
-    Ok cfg -> logInfo ("Loaded new config, serial " ++
-                       show (configSerial cfg))
-    Bad msg -> logError $ "Failed to load config: " ++ msg
-  return ()
-
--- | Wrapper over 'updateConfig' that handles IO errors.
-safeUpdateConfig :: FilePath -> FStat -> CRef -> IO (FStat, ConfigReload)
-safeUpdateConfig path oldfstat cref =
-  Control.Exception.catch
-        (do
-          nt <- needsReload oldfstat path
-          case nt of
-            Nothing -> return (oldfstat, ConfigToDate)
-            Just nt' -> do
-                    updateConfig path cref
-                    return (nt', ConfigReloaded)
-        ) (\e -> do
-             let msg = "Failure during configuration update: " ++
-                       show (e::IOError)
-             writeIORef cref (Bad msg)
-             return (nullFStat, ConfigIOError)
-          )
-
--- | Computes the file cache data from a FileStatus structure.
-buildFileStatus :: FileStatus -> FStat
-buildFileStatus ofs =
-    let modt = modificationTime ofs
-        inum = fileID ofs
-        fsize = fileSize ofs
-    in (modt, inum, fsize)
-
--- | Wrapper over 'buildFileStatus'. This reads the data from the
--- filesystem and then builds our cache structure.
-getFStat :: FilePath -> IO FStat
-getFStat p = liftM buildFileStatus (getFileStatus p)
-
--- | Check if the file needs reloading
-needsReload :: FStat -> FilePath -> IO (Maybe FStat)
-needsReload oldstat path = do
-  newstat <- getFStat path
-  return $ if newstat /= oldstat
-             then Just newstat
-             else Nothing
-
--- ** Watcher threads
-
--- $watcher
--- We have three threads/functions that can mutate the server state:
---
--- 1. the long-interval watcher ('onWatcherTimer')
---
--- 2. the polling watcher ('onPollTimer')
---
--- 3. the inotify event handler ('onInotify')
---
--- All of these will mutate the server state under 'modifyMVar' or
--- 'modifyMVar_', so that server transitions are more or less
--- atomic. The inotify handler remains active during polling mode, but
--- checks for polling mode and doesn't do anything in this case (this
--- check is needed even if we would unregister the event handler due
--- to how events are serialised).
-
--- | Long-interval reload watcher.
---
--- This is on top of the inotify-based triggered reload.
-onWatcherTimer :: IO Bool -> FilePath -> CRef -> MVar ServerState -> IO ()
-onWatcherTimer inotiaction path cref state = do
-  threadDelay watchInterval
-  logDebug "Watcher timer fired"
-  modifyMVar_ state (onWatcherInner path cref)
-  _ <- inotiaction
-  onWatcherTimer inotiaction path cref state
-
--- | Inner onWatcher handler.
---
--- This mutates the server state under a modifyMVar_ call. It never
--- changes the reload model, just does a safety reload and tried to
--- re-establish the inotify watcher.
-onWatcherInner :: FilePath -> CRef -> ServerState -> IO ServerState
-onWatcherInner path cref state  = do
-  (newfstat, _) <- safeUpdateConfig path (reloadFStat state) cref
-  return state { reloadFStat = newfstat }
-
--- | Short-interval (polling) reload watcher.
---
--- This is only active when we're in polling mode; it will
--- automatically exit when it detects that the state has changed to
--- notification.
-onPollTimer :: IO Bool -> FilePath -> CRef -> MVar ServerState -> IO ()
-onPollTimer inotiaction path cref state = do
-  threadDelay pollInterval
-  logDebug "Poll timer fired"
-  continue <- modifyMVar state (onPollInner inotiaction path cref)
-  if continue
-    then onPollTimer inotiaction path cref state
-    else logDebug "Inotify watch active, polling thread exiting"
-
--- | Inner onPoll handler.
---
--- This again mutates the state under a modifyMVar call, and also
--- returns whether the thread should continue or not.
-onPollInner :: IO Bool -> FilePath -> CRef -> ServerState
-              -> IO (ServerState, Bool)
-onPollInner _ _ _ state@(ServerState { reloadModel = ReloadNotify } ) =
-  return (state, False)
-onPollInner inotiaction path cref
-            state@(ServerState { reloadModel = ReloadPoll pround } ) = do
-  (newfstat, reload) <- safeUpdateConfig path (reloadFStat state) cref
-  let state' = state { reloadFStat = newfstat }
-  -- compute new poll model based on reload data; however, failure to
-  -- re-establish the inotifier means we stay on polling
-  newmode <- case reload of
-               ConfigToDate ->
-                 if pround >= maxIdlePollRounds
-                   then do -- try to switch to notify
-                     result <- inotiaction
-                     if result
-                       then moveToNotify
-                       else return initialPoll
-                   else return (ReloadPoll (pround + 1))
-               _ -> return initialPoll
-  let continue = case newmode of
-                   ReloadNotify -> False
-                   _            -> True
-  return (state' { reloadModel = newmode }, continue)
-
--- the following hint is because hlint doesn't understand our const
--- (return False) is so that we can give a signature to 'e'
-{-# ANN addNotifier "HLint: ignore Evaluate" #-}
--- | Setup inotify watcher.
---
--- This tries to setup the watch descriptor; in case of any IO errors,
--- it will return False.
-addNotifier :: INotify -> FilePath -> CRef -> MVar ServerState -> IO Bool
-addNotifier inotify path cref mstate =
-  Control.Exception.catch
-        (addWatch inotify [CloseWrite] path
-                    (onInotify inotify path cref mstate) >> return True)
-        (\e -> const (return False) (e::IOError))
-
--- | Inotify event handler.
-onInotify :: INotify -> String -> CRef -> MVar ServerState -> Event -> IO ()
-onInotify inotify path cref mstate Ignored = do
-  logDebug "File lost, trying to re-establish notifier"
-  modifyMVar_ mstate $ \state -> do
-    result <- addNotifier inotify path cref mstate
-    (newfstat, _) <- safeUpdateConfig path (reloadFStat state) cref
-    let state' = state { reloadFStat = newfstat }
-    if result
-      then return state' -- keep notify
-      else do
-        mode <- moveToPolling "cannot re-establish inotify watch" inotify
-                  path cref mstate
-        return state' { reloadModel = mode }
-
-onInotify inotify path cref mstate _ =
-  modifyMVar_ mstate $ \state ->
-    if reloadModel state == ReloadNotify
-       then do
-         ctime <- getCurrentTimeUSec
-         (newfstat, _) <- safeUpdateConfig path (reloadFStat state) cref
-         let state' = state { reloadFStat = newfstat, reloadTime = ctime }
-         if abs (reloadTime state - ctime) < reloadRatelimit
-           then do
-             mode <- moveToPolling "too many reloads" inotify path cref mstate
-             return state' { reloadModel = mode }
-           else return state'
-      else return state
-
 -- ** Client input/output handlers
 
 -- | Main loop for a given client.
@@ -501,7 +251,7 @@ listener s hmac resp = do
   return ()
 
 -- | Extract the configuration from our IORef.
-configReader :: CRef -> IO (Result ConfigData)
+configReader :: CRef -> ConfigReader
 configReader cref = do
   cdata <- readIORef cref
   return $ liftM fst cdata
@@ -533,31 +283,11 @@ prepMain _ (af_family, bindaddr) = do
 -- | Main function.
 main :: MainFn (S.Family, S.SockAddr) PrepResult
 main _ _ (s, query_data, cref) = do
-  -- Inotify setup
-  inotify <- initINotify
-  -- try to load the configuration, if possible
-  conf_file <- Path.clusterConfFile
-  (fstat, reloaded) <- safeUpdateConfig conf_file nullFStat cref
-  ctime <- getCurrentTime
-  statemvar <- newMVar $ ServerState ReloadNotify ctime fstat
-  let inotiaction = addNotifier inotify conf_file cref statemvar
-  has_inotify <- if reloaded == ConfigReloaded
-                   then inotiaction
-                   else return False
-  if has_inotify
-    then logInfo "Starting up in inotify mode"
-    else do
-      -- inotify was not enabled, we need to update the reload model
-      logInfo "Starting up in polling mode"
-      modifyMVar_ statemvar
-        (\state -> return state { reloadModel = initialPoll })
+  let cfg_transform :: Result ConfigData -> Result (ConfigData, LinkIpMap)
+      cfg_transform = liftM (\cfg -> (cfg, buildLinkIpInstnameMap cfg))
+  initConfigReader cfg_transform cref
+
   hmac <- getClusterHmac
-  -- fork the timeout timer
-  _ <- forkIO $ onWatcherTimer inotiaction conf_file cref statemvar
-  -- fork the polling timer
-  unless has_inotify $ do
-    _ <- forkIO $ onPollTimer inotiaction conf_file cref statemvar
-    return ()
   -- launch the queryd listener
   _ <- forkIO $ runQueryD query_data (configReader cref)
   -- and finally enter the responder loop
diff --git a/src/Ganeti/ConfigReader.hs b/src/Ganeti/ConfigReader.hs
new file mode 100644 (file)
index 0000000..b40c6dc
--- /dev/null
@@ -0,0 +1,332 @@
+{-# LANGUAGE BangPatterns #-}
+
+{-| Implementation of configuration reader with watching support.
+
+-}
+
+{-
+
+Copyright (C) 2011, 2012, 2013 Google Inc.
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+02110-1301, USA.
+
+-}
+
+module Ganeti.ConfigReader
+  ( ConfigReader
+  , initConfigReader
+  ) where
+
+import Control.Concurrent
+import Control.Exception
+import Control.Monad (liftM, unless)
+import Data.IORef
+import System.Posix.Files
+import System.Posix.Types
+import System.INotify
+
+import Ganeti.BasicTypes
+import Ganeti.Objects
+import Ganeti.Confd.Utils
+import Ganeti.Config
+import Ganeti.Logging
+import qualified Ganeti.Constants as C
+import qualified Ganeti.Path as Path
+import Ganeti.Utils
+
+-- | A type for functions that can return the configuration when
+-- executed.
+type ConfigReader = IO (Result ConfigData)
+
+-- | File stat identifier.
+type FStat = (EpochTime, FileID, FileOffset)
+
+-- | Null 'FStat' value.
+nullFStat :: FStat
+nullFStat = (-1, -1, -1)
+
+-- | Reload model data type.
+data ReloadModel = ReloadNotify      -- ^ We are using notifications
+                 | ReloadPoll Int    -- ^ We are using polling
+                   deriving (Eq, Show)
+
+-- | Server state data type.
+data ServerState = ServerState
+  { reloadModel  :: ReloadModel
+  , reloadTime   :: Integer      -- ^ Reload time (epoch) in microseconds
+  , reloadFStat  :: FStat
+  }
+
+-- | Maximum no-reload poll rounds before reverting to inotify.
+maxIdlePollRounds :: Int
+maxIdlePollRounds = 3
+
+-- | Reload timeout in microseconds.
+watchInterval :: Int
+watchInterval = C.confdConfigReloadTimeout * 1000000
+
+-- | Ratelimit timeout in microseconds.
+pollInterval :: Int
+pollInterval = C.confdConfigReloadRatelimit
+
+-- | Ratelimit timeout in microseconds, as an 'Integer'.
+reloadRatelimit :: Integer
+reloadRatelimit = fromIntegral C.confdConfigReloadRatelimit
+
+-- | Initial poll round.
+initialPoll :: ReloadModel
+initialPoll = ReloadPoll 0
+
+-- | Reload status data type.
+data ConfigReload = ConfigToDate    -- ^ No need to reload
+                  | ConfigReloaded  -- ^ Configuration reloaded
+                  | ConfigIOError   -- ^ Error during configuration reload
+                    deriving (Eq)
+
+-- * Configuration handling
+
+-- ** Helper functions
+
+-- | Helper function for logging transition into polling mode.
+moveToPolling :: String -> INotify -> FilePath -> (Result ConfigData -> IO ())
+              -> MVar ServerState -> IO ReloadModel
+moveToPolling msg inotify path save_fn mstate = do
+  logInfo $ "Moving to polling mode: " ++ msg
+  let inotiaction = addNotifier inotify path save_fn mstate
+  _ <- forkIO $ onPollTimer inotiaction path save_fn mstate
+  return initialPoll
+
+-- | Helper function for logging transition into inotify mode.
+moveToNotify :: IO ReloadModel
+moveToNotify = do
+  logInfo "Moving to inotify mode"
+  return ReloadNotify
+
+-- ** Configuration loading
+
+-- | (Re)loads the configuration.
+updateConfig :: FilePath -> (Result ConfigData -> IO ()) -> IO ()
+updateConfig path save_fn = do
+  newcfg <- loadConfig path
+  let !newdata = case newcfg of
+                   Ok !cfg -> Ok cfg
+                   Bad _ -> Bad "Cannot load configuration"
+  save_fn newdata
+  case newcfg of
+    Ok cfg -> logInfo ("Loaded new config, serial " ++
+                       show (configSerial cfg))
+    Bad msg -> logError $ "Failed to load config: " ++ msg
+  return ()
+
+-- | Wrapper over 'updateConfig' that handles IO errors.
+safeUpdateConfig :: FilePath -> FStat -> (Result ConfigData -> IO ())
+                 -> IO (FStat, ConfigReload)
+safeUpdateConfig path oldfstat save_fn =
+  Control.Exception.catch
+        (do
+          nt <- needsReload oldfstat path
+          case nt of
+            Nothing -> return (oldfstat, ConfigToDate)
+            Just nt' -> do
+                    updateConfig path save_fn
+                    return (nt', ConfigReloaded)
+        ) (\e -> do
+             let msg = "Failure during configuration update: " ++
+                       show (e::IOError)
+             save_fn $ Bad msg
+             return (nullFStat, ConfigIOError)
+          )
+
+-- | Computes the file cache data from a FileStatus structure.
+buildFileStatus :: FileStatus -> FStat
+buildFileStatus ofs =
+    let modt = modificationTime ofs
+        inum = fileID ofs
+        fsize = fileSize ofs
+    in (modt, inum, fsize)
+
+-- | Wrapper over 'buildFileStatus'. This reads the data from the
+-- filesystem and then builds our cache structure.
+getFStat :: FilePath -> IO FStat
+getFStat p = liftM buildFileStatus (getFileStatus p)
+
+-- | Check if the file needs reloading
+needsReload :: FStat -> FilePath -> IO (Maybe FStat)
+needsReload oldstat path = do
+  newstat <- getFStat path
+  return $ if newstat /= oldstat
+             then Just newstat
+             else Nothing
+
+-- ** Watcher threads
+
+-- $watcher
+-- We have three threads/functions that can mutate the server state:
+--
+-- 1. the long-interval watcher ('onWatcherTimer')
+--
+-- 2. the polling watcher ('onPollTimer')
+--
+-- 3. the inotify event handler ('onInotify')
+--
+-- All of these will mutate the server state under 'modifyMVar' or
+-- 'modifyMVar_', so that server transitions are more or less
+-- atomic. The inotify handler remains active during polling mode, but
+-- checks for polling mode and doesn't do anything in this case (this
+-- check is needed even if we would unregister the event handler due
+-- to how events are serialised).
+
+-- | Long-interval reload watcher.
+--
+-- This is on top of the inotify-based triggered reload.
+onWatcherTimer :: IO Bool -> FilePath -> (Result ConfigData -> IO ())
+               -> MVar ServerState -> IO ()
+onWatcherTimer inotiaction path save_fn state = do
+  threadDelay watchInterval
+  logDebug "Watcher timer fired"
+  modifyMVar_ state (onWatcherInner path save_fn)
+  _ <- inotiaction
+  onWatcherTimer inotiaction path save_fn state
+
+-- | Inner onWatcher handler.
+--
+-- This mutates the server state under a modifyMVar_ call. It never
+-- changes the reload model, just does a safety reload and tried to
+-- re-establish the inotify watcher.
+onWatcherInner :: FilePath -> (Result ConfigData -> IO ()) -> ServerState
+               -> IO ServerState
+onWatcherInner path save_fn state  = do
+  (newfstat, _) <- safeUpdateConfig path (reloadFStat state) save_fn
+  return state { reloadFStat = newfstat }
+
+-- | Short-interval (polling) reload watcher.
+--
+-- This is only active when we're in polling mode; it will
+-- automatically exit when it detects that the state has changed to
+-- notification.
+onPollTimer :: IO Bool -> FilePath -> (Result ConfigData -> IO ())
+            -> MVar ServerState -> IO ()
+onPollTimer inotiaction path save_fn state = do
+  threadDelay pollInterval
+  logDebug "Poll timer fired"
+  continue <- modifyMVar state (onPollInner inotiaction path save_fn)
+  if continue
+    then onPollTimer inotiaction path save_fn state
+    else logDebug "Inotify watch active, polling thread exiting"
+
+-- | Inner onPoll handler.
+--
+-- This again mutates the state under a modifyMVar call, and also
+-- returns whether the thread should continue or not.
+onPollInner :: IO Bool -> FilePath -> (Result ConfigData -> IO ())
+            -> ServerState -> IO (ServerState, Bool)
+onPollInner _ _ _ state@(ServerState { reloadModel = ReloadNotify } ) =
+  return (state, False)
+onPollInner inotiaction path save_fn
+            state@(ServerState { reloadModel = ReloadPoll pround } ) = do
+  (newfstat, reload) <- safeUpdateConfig path (reloadFStat state) save_fn
+  let state' = state { reloadFStat = newfstat }
+  -- compute new poll model based on reload data; however, failure to
+  -- re-establish the inotifier means we stay on polling
+  newmode <- case reload of
+               ConfigToDate ->
+                 if pround >= maxIdlePollRounds
+                   then do -- try to switch to notify
+                     result <- inotiaction
+                     if result
+                       then moveToNotify
+                       else return initialPoll
+                   else return (ReloadPoll (pround + 1))
+               _ -> return initialPoll
+  let continue = case newmode of
+                   ReloadNotify -> False
+                   _            -> True
+  return (state' { reloadModel = newmode }, continue)
+
+-- the following hint is because hlint doesn't understand our const
+-- (return False) is so that we can give a signature to 'e'
+{-# ANN addNotifier "HLint: ignore Evaluate" #-}
+-- | Setup inotify watcher.
+--
+-- This tries to setup the watch descriptor; in case of any IO errors,
+-- it will return False.
+addNotifier :: INotify -> FilePath -> (Result ConfigData -> IO ())
+            -> MVar ServerState -> IO Bool
+addNotifier inotify path save_fn mstate =
+  Control.Exception.catch
+        (addWatch inotify [CloseWrite] path
+            (onInotify inotify path save_fn mstate) >> return True)
+        (\e -> const (return False) (e::IOError))
+
+-- | Inotify event handler.
+onInotify :: INotify -> String -> (Result ConfigData -> IO ())
+          -> MVar ServerState -> Event -> IO ()
+onInotify inotify path save_fn mstate Ignored = do
+  logDebug "File lost, trying to re-establish notifier"
+  modifyMVar_ mstate $ \state -> do
+    result <- addNotifier inotify path save_fn mstate
+    (newfstat, _) <- safeUpdateConfig path (reloadFStat state) save_fn
+    let state' = state { reloadFStat = newfstat }
+    if result
+      then return state' -- keep notify
+      else do
+        mode <- moveToPolling "cannot re-establish inotify watch" inotify
+                  path save_fn mstate
+        return state' { reloadModel = mode }
+
+onInotify inotify path save_fn mstate _ =
+  modifyMVar_ mstate $ \state ->
+    if reloadModel state == ReloadNotify
+       then do
+         ctime <- getCurrentTimeUSec
+         (newfstat, _) <- safeUpdateConfig path (reloadFStat state) save_fn
+         let state' = state { reloadFStat = newfstat, reloadTime = ctime }
+         if abs (reloadTime state - ctime) < reloadRatelimit
+           then do
+             mode <- moveToPolling "too many reloads" inotify path save_fn
+                                   mstate
+             return state' { reloadModel = mode }
+           else return state'
+      else return state
+
+initConfigReader :: (Result ConfigData -> a) -> IORef a -> IO ()
+initConfigReader cfg_transform ioref = do
+  let save_fn = writeIORef ioref . cfg_transform
+
+  -- Inotify setup
+  inotify <- initINotify
+  -- try to load the configuration, if possible
+  conf_file <- Path.clusterConfFile
+  (fstat, reloaded) <- safeUpdateConfig conf_file nullFStat save_fn
+  ctime <- getCurrentTime
+  statemvar <- newMVar $ ServerState ReloadNotify ctime fstat
+  let inotiaction = addNotifier inotify conf_file save_fn statemvar
+  has_inotify <- if reloaded == ConfigReloaded
+                   then inotiaction
+                   else return False
+  if has_inotify
+    then logInfo "Starting up in inotify mode"
+    else do
+      -- inotify was not enabled, we need to update the reload model
+      logInfo "Starting up in polling mode"
+      modifyMVar_ statemvar
+        (\state -> return state { reloadModel = initialPoll })
+  -- fork the timeout timer
+  _ <- forkIO $ onWatcherTimer inotiaction conf_file save_fn statemvar
+  -- fork the polling timer
+  unless has_inotify $ do
+    _ <- forkIO $ onPollTimer inotiaction conf_file save_fn statemvar
+    return ()
\ No newline at end of file
index 46e70cc..ebdbba5 100644 (file)
@@ -26,8 +26,7 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 -}
 
 module Ganeti.Query.Server
-  ( ConfigReader
-  , prepQueryD
+  ( prepQueryD
   , runQueryD
   ) where
 
@@ -47,6 +46,7 @@ import qualified Ganeti.Path as Path
 import Ganeti.Daemon
 import Ganeti.Objects
 import qualified Ganeti.Config as Config
+import Ganeti.ConfigReader
 import Ganeti.BasicTypes
 import Ganeti.Logging
 import Ganeti.Luxi
@@ -55,10 +55,6 @@ import qualified Ganeti.Query.Language as Qlang
 import Ganeti.Query.Query
 import Ganeti.Query.Filter (makeSimpleFilter)
 
--- | A type for functions that can return the configuration when
--- executed.
-type ConfigReader = IO (Result ConfigData)
-
 -- | Helper for classic queries.
 handleClassicQuery :: ConfigData      -- ^ Cluster config
                    -> Qlang.ItemType  -- ^ Query type