src/Ganeti/ConfigReader.hs - ganeti - Git at Google

 {-# LANGUAGE BangPatterns #-}

 {-| Implementation of configuration reader with watching support.

 -}

 {-

 Copyright (C) 2011, 2012, 2013 Google Inc.
 All rights reserved.

 Redistribution and use in source and binary forms, with or without
 modification, are permitted provided that the following conditions are
 met:

 1. Redistributions of source code must retain the above copyright notice,
 this list of conditions and the following disclaimer.

 2. Redistributions in binary form must reproduce the above copyright
 notice, this list of conditions and the following disclaimer in the
 documentation and/or other materials provided with the distribution.

 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
 IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
 TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
 PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
 CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
 EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
 PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
 PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
 LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
 NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

 -}

 module Ganeti.ConfigReader
   ( ConfigReader
   , initConfigReader
   ) where

 import Control.Concurrent
 import Control.Exception
 import Control.Monad (unless)
 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)


 -- | 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 msg -> Bad $ "Cannot load configuration from " ++ path
                                     ++ ": " ++ msg
   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)
           )

 -- ** 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 :: FilePath -> (Result ConfigData -> IO ())
                -> MVar ServerState -> IO ()
 onWatcherTimer path save_fn state = do
   threadDelay watchInterval
   logDebug "Config-reader watcher timer fired"
   modifyMVar_ state (onWatcherInner path save_fn)
   onWatcherTimer 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 for " ++ path
   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 for " ++ path
   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 _ = do
   logDebug $ "onInotify fired for " ++ path
   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 -> IO ()) -> IO ()
 initConfigReader save_fn = do

   -- 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 conf_file save_fn statemvar
   -- fork the polling timer
   unless has_inotify $ do
     _ <- forkIO $ onPollTimer inotiaction conf_file save_fn statemvar
     return ()
	{-# LANGUAGE BangPatterns #-}

	{-\| Implementation of configuration reader with watching support.

	-}

	{-

	Copyright (C) 2011, 2012, 2013 Google Inc.
	All rights reserved.

	Redistribution and use in source and binary forms, with or without
	modification, are permitted provided that the following conditions are
	met:

	1. Redistributions of source code must retain the above copyright notice,
	this list of conditions and the following disclaimer.

	2. Redistributions in binary form must reproduce the above copyright
	notice, this list of conditions and the following disclaimer in the
	documentation and/or other materials provided with the distribution.

	THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
	IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
	TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
	PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
	CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
	EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
	PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
	PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
	LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
	NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
	SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

	-}

	module Ganeti.ConfigReader
	( ConfigReader
	, initConfigReader
	) where

	import Control.Concurrent
	import Control.Exception
	import Control.Monad (unless)
	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)


	-- \| 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 msg -> Bad $ "Cannot load configuration from " ++ path
	++ ": " ++ msg
	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)
	)

	-- ** 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 :: FilePath -> (Result ConfigData -> IO ())
	-> MVar ServerState -> IO ()
	onWatcherTimer path save_fn state = do
	threadDelay watchInterval
	logDebug "Config-reader watcher timer fired"
	modifyMVar_ state (onWatcherInner path save_fn)
	onWatcherTimer 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 for " ++ path
	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 for " ++ path
	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 _ = do
	logDebug $ "onInotify fired for " ++ path
	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 -> IO ()) -> IO ()
	initConfigReader save_fn = do

	-- 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 conf_file save_fn statemvar
	-- fork the polling timer
	unless has_inotify $ do
	_ <- forkIO $ onPollTimer inotiaction conf_file save_fn statemvar
	return ()