Synnefo » snf-ganeti

{-# 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 (unless)

import Data.IORef

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 :: IO Bool -> FilePath -> (Result ConfigData -> IO ())

               -> MVar ServerState -> IO ()

onWatcherTimer inotiaction path save_fn state = do

  threadDelay watchInterval

  logDebug "Config-reader 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 ()