code.grnet.gr Git - ganeti-local/blob - 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 msg -> Bad $ "Cannot load configuration from " ++ path
 127                                     ++ ": " ++ msg
 128   save_fn newdata
 129   case newcfg of
 130     Ok cfg -> logInfo ("Loaded new config, serial " ++
 131                        show (configSerial cfg))
 132     Bad msg -> logError $ "Failed to load config: " ++ msg
 133   return ()
 134
 135 -- | Wrapper over 'updateConfig' that handles IO errors.
 136 safeUpdateConfig :: FilePath -> FStat -> (Result ConfigData -> IO ())
 137                  -> IO (FStat, ConfigReload)
 138 safeUpdateConfig path oldfstat save_fn =
 139   Control.Exception.catch
 140         (do
 141           nt <- needsReload oldfstat path
 142           case nt of
 143             Nothing -> return (oldfstat, ConfigToDate)
 144             Just nt' -> do
 145                     updateConfig path save_fn
 146                     return (nt', ConfigReloaded)
 147         ) (\e -> do
 148              let msg = "Failure during configuration update: " ++
 149                        show (e::IOError)
 150              save_fn $ Bad msg
 151              return (nullFStat, ConfigIOError)
 152           )
 153
 154 -- | Computes the file cache data from a FileStatus structure.
 155 buildFileStatus :: FileStatus -> FStat
 156 buildFileStatus ofs =
 157     let modt = modificationTime ofs
 158         inum = fileID ofs
 159         fsize = fileSize ofs
 160     in (modt, inum, fsize)
 161
 162 -- | Wrapper over 'buildFileStatus'. This reads the data from the
 163 -- filesystem and then builds our cache structure.
 164 getFStat :: FilePath -> IO FStat
 165 getFStat p = liftM buildFileStatus (getFileStatus p)
 166
 167 -- | Check if the file needs reloading
 168 needsReload :: FStat -> FilePath -> IO (Maybe FStat)
 169 needsReload oldstat path = do
 170   newstat <- getFStat path
 171   return $ if newstat /= oldstat
 172              then Just newstat
 173              else Nothing
 174
 175 -- ** Watcher threads
 176
 177 -- $watcher
 178 -- We have three threads/functions that can mutate the server state:
 179 --
 180 -- 1. the long-interval watcher ('onWatcherTimer')
 181 --
 182 -- 2. the polling watcher ('onPollTimer')
 183 --
 184 -- 3. the inotify event handler ('onInotify')
 185 --
 186 -- All of these will mutate the server state under 'modifyMVar' or
 187 -- 'modifyMVar_', so that server transitions are more or less
 188 -- atomic. The inotify handler remains active during polling mode, but
 189 -- checks for polling mode and doesn't do anything in this case (this
 190 -- check is needed even if we would unregister the event handler due
 191 -- to how events are serialised).
 192
 193 -- | Long-interval reload watcher.
 194 --
 195 -- This is on top of the inotify-based triggered reload.
 196 onWatcherTimer :: IO Bool -> FilePath -> (Result ConfigData -> IO ())
 197                -> MVar ServerState -> IO ()
 198 onWatcherTimer inotiaction path save_fn state = do
 199   threadDelay watchInterval
 200   logDebug "Watcher timer fired"
 201   modifyMVar_ state (onWatcherInner path save_fn)
 202   _ <- inotiaction
 203   onWatcherTimer inotiaction path save_fn state
 204
 205 -- | Inner onWatcher handler.
 206 --
 207 -- This mutates the server state under a modifyMVar_ call. It never
 208 -- changes the reload model, just does a safety reload and tried to
 209 -- re-establish the inotify watcher.
 210 onWatcherInner :: FilePath -> (Result ConfigData -> IO ()) -> ServerState
 211                -> IO ServerState
 212 onWatcherInner path save_fn state  = do
 213   (newfstat, _) <- safeUpdateConfig path (reloadFStat state) save_fn
 214   return state { reloadFStat = newfstat }
 215
 216 -- | Short-interval (polling) reload watcher.
 217 --
 218 -- This is only active when we're in polling mode; it will
 219 -- automatically exit when it detects that the state has changed to
 220 -- notification.
 221 onPollTimer :: IO Bool -> FilePath -> (Result ConfigData -> IO ())
 222             -> MVar ServerState -> IO ()
 223 onPollTimer inotiaction path save_fn state = do
 224   threadDelay pollInterval
 225   logDebug "Poll timer fired"
 226   continue <- modifyMVar state (onPollInner inotiaction path save_fn)
 227   if continue
 228     then onPollTimer inotiaction path save_fn state
 229     else logDebug "Inotify watch active, polling thread exiting"
 230
 231 -- | Inner onPoll handler.
 232 --
 233 -- This again mutates the state under a modifyMVar call, and also
 234 -- returns whether the thread should continue or not.
 235 onPollInner :: IO Bool -> FilePath -> (Result ConfigData -> IO ())
 236             -> ServerState -> IO (ServerState, Bool)
 237 onPollInner _ _ _ state@(ServerState { reloadModel = ReloadNotify } ) =
 238   return (state, False)
 239 onPollInner inotiaction path save_fn
 240             state@(ServerState { reloadModel = ReloadPoll pround } ) = do
 241   (newfstat, reload) <- safeUpdateConfig path (reloadFStat state) save_fn
 242   let state' = state { reloadFStat = newfstat }
 243   -- compute new poll model based on reload data; however, failure to
 244   -- re-establish the inotifier means we stay on polling
 245   newmode <- case reload of
 246                ConfigToDate ->
 247                  if pround >= maxIdlePollRounds
 248                    then do -- try to switch to notify
 249                      result <- inotiaction
 250                      if result
 251                        then moveToNotify
 252                        else return initialPoll
 253                    else return (ReloadPoll (pround + 1))
 254                _ -> return initialPoll
 255   let continue = case newmode of
 256                    ReloadNotify -> False
 257                    _            -> True
 258   return (state' { reloadModel = newmode }, continue)
 259
 260 -- the following hint is because hlint doesn't understand our const
 261 -- (return False) is so that we can give a signature to 'e'
 262 {-# ANN addNotifier "HLint: ignore Evaluate" #-}
 263 -- | Setup inotify watcher.
 264 --
 265 -- This tries to setup the watch descriptor; in case of any IO errors,
 266 -- it will return False.
 267 addNotifier :: INotify -> FilePath -> (Result ConfigData -> IO ())
 268             -> MVar ServerState -> IO Bool
 269 addNotifier inotify path save_fn mstate =
 270   Control.Exception.catch
 271         (addWatch inotify [CloseWrite] path
 272             (onInotify inotify path save_fn mstate) >> return True)
 273         (\e -> const (return False) (e::IOError))
 274
 275 -- | Inotify event handler.
 276 onInotify :: INotify -> String -> (Result ConfigData -> IO ())
 277           -> MVar ServerState -> Event -> IO ()
 278 onInotify inotify path save_fn mstate Ignored = do
 279   logDebug "File lost, trying to re-establish notifier"
 280   modifyMVar_ mstate $ \state -> do
 281     result <- addNotifier inotify path save_fn mstate
 282     (newfstat, _) <- safeUpdateConfig path (reloadFStat state) save_fn
 283     let state' = state { reloadFStat = newfstat }
 284     if result
 285       then return state' -- keep notify
 286       else do
 287         mode <- moveToPolling "cannot re-establish inotify watch" inotify
 288                   path save_fn mstate
 289         return state' { reloadModel = mode }
 290
 291 onInotify inotify path save_fn mstate _ =
 292   modifyMVar_ mstate $ \state ->
 293     if reloadModel state == ReloadNotify
 294        then do
 295          ctime <- getCurrentTimeUSec
 296          (newfstat, _) <- safeUpdateConfig path (reloadFStat state) save_fn
 297          let state' = state { reloadFStat = newfstat, reloadTime = ctime }
 298          if abs (reloadTime state - ctime) < reloadRatelimit
 299            then do
 300              mode <- moveToPolling "too many reloads" inotify path save_fn
 301                                    mstate
 302              return state' { reloadModel = mode }
 303            else return state'
 304       else return state
 305
 306 initConfigReader :: (Result ConfigData -> a) -> IORef a -> IO ()
 307 initConfigReader cfg_transform ioref = do
 308   let save_fn = writeIORef ioref . cfg_transform
 309
 310   -- Inotify setup
 311   inotify <- initINotify
 312   -- try to load the configuration, if possible
 313   conf_file <- Path.clusterConfFile
 314   (fstat, reloaded) <- safeUpdateConfig conf_file nullFStat save_fn
 315   ctime <- getCurrentTime
 316   statemvar <- newMVar $ ServerState ReloadNotify ctime fstat
 317   let inotiaction = addNotifier inotify conf_file save_fn statemvar
 318   has_inotify <- if reloaded == ConfigReloaded
 319                    then inotiaction
 320                    else return False
 321   if has_inotify
 322     then logInfo "Starting up in inotify mode"
 323     else do
 324       -- inotify was not enabled, we need to update the reload model
 325       logInfo "Starting up in polling mode"
 326       modifyMVar_ statemvar
 327         (\state -> return state { reloadModel = initialPoll })
 328   -- fork the timeout timer
 329   _ <- forkIO $ onWatcherTimer inotiaction conf_file save_fn statemvar
 330   -- fork the polling timer
 331   unless has_inotify $ do
 332     _ <- forkIO $ onPollTimer inotiaction conf_file save_fn statemvar
 333     return ()