Merge branch 'stable-2.15' into stable-2.16
[ganeti-github.git] / 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 All rights reserved.
11
12 Redistribution and use in source and binary forms, with or without
13 modification, are permitted provided that the following conditions are
14 met:
15
16 1. Redistributions of source code must retain the above copyright notice,
17 this list of conditions and the following disclaimer.
18
19 2. Redistributions in binary form must reproduce the above copyright
20 notice, this list of conditions and the following disclaimer in the
21 documentation and/or other materials provided with the distribution.
22
23 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
24 IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
25 TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
26 PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
27 CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
28 EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
29 PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
30 PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
31 LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
32 NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
33 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
34
35 -}
36
37 module Ganeti.ConfigReader
38 ( ConfigReader
39 , initConfigReader
40 ) where
41
42 import Control.Concurrent
43 import Control.Exception
44 import Control.Monad (unless)
45 import System.INotify
46
47 import Ganeti.BasicTypes
48 import Ganeti.Objects
49 import Ganeti.Confd.Utils
50 import Ganeti.Config
51 import Ganeti.Logging
52 import qualified Ganeti.Constants as C
53 import qualified Ganeti.Path as Path
54 import Ganeti.Utils
55
56 -- | A type for functions that can return the configuration when
57 -- executed.
58 type ConfigReader = IO (Result ConfigData)
59
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 -- ** Watcher threads
155
156 -- $watcher
157 -- We have three threads/functions that can mutate the server state:
158 --
159 -- 1. the long-interval watcher ('onWatcherTimer')
160 --
161 -- 2. the polling watcher ('onPollTimer')
162 --
163 -- 3. the inotify event handler ('onInotify')
164 --
165 -- All of these will mutate the server state under 'modifyMVar' or
166 -- 'modifyMVar_', so that server transitions are more or less
167 -- atomic. The inotify handler remains active during polling mode, but
168 -- checks for polling mode and doesn't do anything in this case (this
169 -- check is needed even if we would unregister the event handler due
170 -- to how events are serialised).
171
172 -- | Long-interval reload watcher.
173 --
174 -- This is on top of the inotify-based triggered reload.
175 onWatcherTimer :: FilePath -> (Result ConfigData -> IO ())
176 -> MVar ServerState -> IO ()
177 onWatcherTimer path save_fn state = do
178 threadDelay watchInterval
179 logDebug "Config-reader watcher timer fired"
180 modifyMVar_ state (onWatcherInner path save_fn)
181 onWatcherTimer path save_fn state
182
183 -- | Inner onWatcher handler.
184 --
185 -- This mutates the server state under a modifyMVar_ call. It never
186 -- changes the reload model, just does a safety reload and tried to
187 -- re-establish the inotify watcher.
188 onWatcherInner :: FilePath -> (Result ConfigData -> IO ()) -> ServerState
189 -> IO ServerState
190 onWatcherInner path save_fn state = do
191 (newfstat, _) <- safeUpdateConfig path (reloadFStat state) save_fn
192 return state { reloadFStat = newfstat }
193
194 -- | Short-interval (polling) reload watcher.
195 --
196 -- This is only active when we're in polling mode; it will
197 -- automatically exit when it detects that the state has changed to
198 -- notification.
199 onPollTimer :: IO Bool -> FilePath -> (Result ConfigData -> IO ())
200 -> MVar ServerState -> IO ()
201 onPollTimer inotiaction path save_fn state = do
202 threadDelay pollInterval
203 logDebug "Poll timer fired"
204 continue <- modifyMVar state (onPollInner inotiaction path save_fn)
205 if continue
206 then onPollTimer inotiaction path save_fn state
207 else logDebug "Inotify watch active, polling thread exiting"
208
209 -- | Inner onPoll handler.
210 --
211 -- This again mutates the state under a modifyMVar call, and also
212 -- returns whether the thread should continue or not.
213 onPollInner :: IO Bool -> FilePath -> (Result ConfigData -> IO ())
214 -> ServerState -> IO (ServerState, Bool)
215 onPollInner _ _ _ state@(ServerState { reloadModel = ReloadNotify } ) =
216 return (state, False)
217 onPollInner inotiaction path save_fn
218 state@(ServerState { reloadModel = ReloadPoll pround } ) = do
219 (newfstat, reload) <- safeUpdateConfig path (reloadFStat state) save_fn
220 let state' = state { reloadFStat = newfstat }
221 -- compute new poll model based on reload data; however, failure to
222 -- re-establish the inotifier means we stay on polling
223 newmode <- case reload of
224 ConfigToDate ->
225 if pround >= maxIdlePollRounds
226 then do -- try to switch to notify
227 result <- inotiaction
228 if result
229 then moveToNotify
230 else return initialPoll
231 else return (ReloadPoll (pround + 1))
232 _ -> return initialPoll
233 let continue = case newmode of
234 ReloadNotify -> False
235 _ -> True
236 return (state' { reloadModel = newmode }, continue)
237
238 -- the following hint is because hlint doesn't understand our const
239 -- (return False) is so that we can give a signature to 'e'
240 {-# ANN addNotifier "HLint: ignore Evaluate" #-}
241 -- | Setup inotify watcher.
242 --
243 -- This tries to setup the watch descriptor; in case of any IO errors,
244 -- it will return False.
245 addNotifier :: INotify -> FilePath -> (Result ConfigData -> IO ())
246 -> MVar ServerState -> IO Bool
247 addNotifier inotify path save_fn mstate =
248 Control.Exception.catch
249 (addWatch inotify [CloseWrite] path
250 (onInotify inotify path save_fn mstate) >> return True)
251 (\e -> const (return False) (e::IOError))
252
253 -- | Inotify event handler.
254 onInotify :: INotify -> String -> (Result ConfigData -> IO ())
255 -> MVar ServerState -> Event -> IO ()
256 onInotify inotify path save_fn mstate Ignored = do
257 logDebug "File lost, trying to re-establish notifier"
258 modifyMVar_ mstate $ \state -> do
259 result <- addNotifier inotify path save_fn mstate
260 (newfstat, _) <- safeUpdateConfig path (reloadFStat state) save_fn
261 let state' = state { reloadFStat = newfstat }
262 if result
263 then return state' -- keep notify
264 else do
265 mode <- moveToPolling "cannot re-establish inotify watch" inotify
266 path save_fn mstate
267 return state' { reloadModel = mode }
268
269 onInotify inotify path save_fn mstate _ =
270 modifyMVar_ mstate $ \state ->
271 if reloadModel state == ReloadNotify
272 then do
273 ctime <- getCurrentTimeUSec
274 (newfstat, _) <- safeUpdateConfig path (reloadFStat state) save_fn
275 let state' = state { reloadFStat = newfstat, reloadTime = ctime }
276 if abs (reloadTime state - ctime) < reloadRatelimit
277 then do
278 mode <- moveToPolling "too many reloads" inotify path save_fn
279 mstate
280 return state' { reloadModel = mode }
281 else return state'
282 else return state
283
284 initConfigReader :: (Result ConfigData -> IO ()) -> IO ()
285 initConfigReader save_fn = do
286
287 -- Inotify setup
288 inotify <- initINotify
289 -- try to load the configuration, if possible
290 conf_file <- Path.clusterConfFile
291 (fstat, reloaded) <- safeUpdateConfig conf_file nullFStat save_fn
292 ctime <- getCurrentTime
293 statemvar <- newMVar $ ServerState ReloadNotify ctime fstat
294 let inotiaction = addNotifier inotify conf_file save_fn statemvar
295 has_inotify <- if reloaded == ConfigReloaded
296 then inotiaction
297 else return False
298 if has_inotify
299 then logInfo "Starting up in inotify mode"
300 else do
301 -- inotify was not enabled, we need to update the reload model
302 logInfo "Starting up in polling mode"
303 modifyMVar_ statemvar
304 (\state -> return state { reloadModel = initialPoll })
305 -- fork the timeout timer
306 _ <- forkIO $ onWatcherTimer conf_file save_fn statemvar
307 -- fork the polling timer
308 unless has_inotify $ do
309 _ <- forkIO $ onPollTimer inotiaction conf_file save_fn statemvar
310 return ()