content: {-# 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.Monad (unless)
  import System.IO.Error (catchIOError)
  import System.INotify
  
  import Ganeti.BasicTypes
  import Ganeti.Objects
  import Ganeti.Compat
  import Ganeti.Config
  import Ganeti.Logging
  import qualified Ganeti.Constants as C
  import qualified Ganeti.Path as Path
  import Ganeti.Utils.Time (getCurrentTime, getCurrentTimeUSec)
  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 =
    catchIOError
          (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)
  
  -- | 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 =
    catchIOError
          (addWatch inotify [CloseWrite] (toInotifyPath path)
              (onInotify inotify path save_fn mstate) >> return True)
          (\_e -> return False)
  
  -- | 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 ()
  