root / src / Ganeti / Daemon.hs @ 560ef132
History | View | Annotate | Download (15.6 kB)
1 |
{-| Implementation of the generic daemon functionality. |
---|---|
2 |
|
3 |
-} |
4 |
|
5 |
{- |
6 |
|
7 |
Copyright (C) 2011, 2012 Google Inc. |
8 |
|
9 |
This program is free software; you can redistribute it and/or modify |
10 |
it under the terms of the GNU General Public License as published by |
11 |
the Free Software Foundation; either version 2 of the License, or |
12 |
(at your option) any later version. |
13 |
|
14 |
This program is distributed in the hope that it will be useful, but |
15 |
WITHOUT ANY WARRANTY; without even the implied warranty of |
16 |
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
17 |
General Public License for more details. |
18 |
|
19 |
You should have received a copy of the GNU General Public License |
20 |
along with this program; if not, write to the Free Software |
21 |
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
22 |
02110-1301, USA. |
23 |
|
24 |
-} |
25 |
|
26 |
module Ganeti.Daemon |
27 |
( DaemonOptions(..) |
28 |
, OptType |
29 |
, CheckFn |
30 |
, PrepFn |
31 |
, MainFn |
32 |
, defaultOptions |
33 |
, oShowHelp |
34 |
, oShowVer |
35 |
, oNoDaemonize |
36 |
, oNoUserChecks |
37 |
, oDebug |
38 |
, oPort |
39 |
, oBindAddress |
40 |
, oSyslogUsage |
41 |
, parseArgs |
42 |
, parseAddress |
43 |
, cleanupSocket |
44 |
, describeError |
45 |
, genericMain |
46 |
) where |
47 |
|
48 |
import Control.Concurrent |
49 |
import Control.Exception |
50 |
import Control.Monad |
51 |
import Data.Maybe (fromMaybe, listToMaybe) |
52 |
import Data.Word |
53 |
import GHC.IO.Handle (hDuplicateTo) |
54 |
import Network.BSD (getHostName) |
55 |
import qualified Network.Socket as Socket |
56 |
import System.Console.GetOpt |
57 |
import System.Directory |
58 |
import System.Exit |
59 |
import System.Environment |
60 |
import System.IO |
61 |
import System.IO.Error (isDoesNotExistError, modifyIOError, annotateIOError) |
62 |
import System.Posix.Directory |
63 |
import System.Posix.Files |
64 |
import System.Posix.IO |
65 |
import System.Posix.Process |
66 |
import System.Posix.Types |
67 |
import System.Posix.Signals |
68 |
|
69 |
import Ganeti.Common as Common |
70 |
import Ganeti.Logging |
71 |
import Ganeti.Runtime |
72 |
import Ganeti.BasicTypes |
73 |
import Ganeti.Utils |
74 |
import qualified Ganeti.Constants as C |
75 |
import qualified Ganeti.Ssconf as Ssconf |
76 |
|
77 |
-- * Constants |
78 |
|
79 |
-- | \/dev\/null path. |
80 |
devNull :: FilePath |
81 |
devNull = "/dev/null" |
82 |
|
83 |
-- | Error message prefix, used in two separate paths (when forking |
84 |
-- and when not). |
85 |
daemonStartupErr :: String -> String |
86 |
daemonStartupErr = ("Error when starting the daemon process: " ++) |
87 |
|
88 |
-- * Data types |
89 |
|
90 |
-- | Command line options structure. |
91 |
data DaemonOptions = DaemonOptions |
92 |
{ optShowHelp :: Bool -- ^ Just show the help |
93 |
, optShowVer :: Bool -- ^ Just show the program version |
94 |
, optShowComp :: Bool -- ^ Just show the completion info |
95 |
, optDaemonize :: Bool -- ^ Whether to daemonize or not |
96 |
, optPort :: Maybe Word16 -- ^ Override for the network port |
97 |
, optDebug :: Bool -- ^ Enable debug messages |
98 |
, optNoUserChecks :: Bool -- ^ Ignore user checks |
99 |
, optBindAddress :: Maybe String -- ^ Override for the bind address |
100 |
, optSyslogUsage :: Maybe SyslogUsage -- ^ Override for Syslog usage |
101 |
} |
102 |
|
103 |
-- | Default values for the command line options. |
104 |
defaultOptions :: DaemonOptions |
105 |
defaultOptions = DaemonOptions |
106 |
{ optShowHelp = False |
107 |
, optShowVer = False |
108 |
, optShowComp = False |
109 |
, optDaemonize = True |
110 |
, optPort = Nothing |
111 |
, optDebug = False |
112 |
, optNoUserChecks = False |
113 |
, optBindAddress = Nothing |
114 |
, optSyslogUsage = Nothing |
115 |
} |
116 |
|
117 |
instance StandardOptions DaemonOptions where |
118 |
helpRequested = optShowHelp |
119 |
verRequested = optShowVer |
120 |
compRequested = optShowComp |
121 |
requestHelp o = o { optShowHelp = True } |
122 |
requestVer o = o { optShowVer = True } |
123 |
requestComp o = o { optShowComp = True } |
124 |
|
125 |
-- | Abrreviation for the option type. |
126 |
type OptType = GenericOptType DaemonOptions |
127 |
|
128 |
-- | Check function type. |
129 |
type CheckFn a = DaemonOptions -> IO (Either ExitCode a) |
130 |
|
131 |
-- | Prepare function type. |
132 |
type PrepFn a b = DaemonOptions -> a -> IO b |
133 |
|
134 |
-- | Main execution function type. |
135 |
type MainFn a b = DaemonOptions -> a -> b -> IO () |
136 |
|
137 |
-- * Command line options |
138 |
|
139 |
oNoDaemonize :: OptType |
140 |
oNoDaemonize = |
141 |
(Option "f" ["foreground"] |
142 |
(NoArg (\ opts -> Ok opts { optDaemonize = False })) |
143 |
"Don't detach from the current terminal", |
144 |
OptComplNone) |
145 |
|
146 |
oDebug :: OptType |
147 |
oDebug = |
148 |
(Option "d" ["debug"] |
149 |
(NoArg (\ opts -> Ok opts { optDebug = True })) |
150 |
"Enable debug messages", |
151 |
OptComplNone) |
152 |
|
153 |
oNoUserChecks :: OptType |
154 |
oNoUserChecks = |
155 |
(Option "" ["no-user-checks"] |
156 |
(NoArg (\ opts -> Ok opts { optNoUserChecks = True })) |
157 |
"Ignore user checks", |
158 |
OptComplNone) |
159 |
|
160 |
oPort :: Int -> OptType |
161 |
oPort def = |
162 |
(Option "p" ["port"] |
163 |
(reqWithConversion (tryRead "reading port") |
164 |
(\port opts -> Ok opts { optPort = Just port }) "PORT") |
165 |
("Network port (default: " ++ show def ++ ")"), |
166 |
OptComplInteger) |
167 |
|
168 |
oBindAddress :: OptType |
169 |
oBindAddress = |
170 |
(Option "b" ["bind"] |
171 |
(ReqArg (\addr opts -> Ok opts { optBindAddress = Just addr }) |
172 |
"ADDR") |
173 |
"Bind address (default depends on cluster configuration)", |
174 |
OptComplInetAddr) |
175 |
|
176 |
oSyslogUsage :: OptType |
177 |
oSyslogUsage = |
178 |
(Option "" ["syslog"] |
179 |
(reqWithConversion syslogUsageFromRaw |
180 |
(\su opts -> Ok opts { optSyslogUsage = Just su }) |
181 |
"SYSLOG") |
182 |
("Enable logging to syslog (except debug \ |
183 |
\messages); one of 'no', 'yes' or 'only' [" ++ C.syslogUsage ++ |
184 |
"]"), |
185 |
OptComplChoices ["yes", "no", "only"]) |
186 |
|
187 |
-- | Generic options. |
188 |
genericOpts :: [OptType] |
189 |
genericOpts = [ oShowHelp |
190 |
, oShowVer |
191 |
, oShowComp |
192 |
] |
193 |
|
194 |
-- | Annotates and transforms IOErrors into a Result type. This can be |
195 |
-- used in the error handler argument to 'catch', for example. |
196 |
ioErrorToResult :: String -> IOError -> IO (Result a) |
197 |
ioErrorToResult description exc = |
198 |
return . Bad $ description ++ ": " ++ show exc |
199 |
|
200 |
-- | Small wrapper over getArgs and 'parseOpts'. |
201 |
parseArgs :: String -> [OptType] -> IO (DaemonOptions, [String]) |
202 |
parseArgs cmd options = do |
203 |
cmd_args <- getArgs |
204 |
parseOpts defaultOptions cmd_args cmd (options ++ genericOpts) [] |
205 |
|
206 |
-- * Daemon-related functions |
207 |
|
208 |
-- | PID file mode. |
209 |
pidFileMode :: FileMode |
210 |
pidFileMode = unionFileModes ownerReadMode ownerWriteMode |
211 |
|
212 |
-- | PID file open flags. |
213 |
pidFileFlags :: OpenFileFlags |
214 |
pidFileFlags = defaultFileFlags { noctty = True, trunc = False } |
215 |
|
216 |
-- | Writes a PID file and locks it. |
217 |
writePidFile :: FilePath -> IO Fd |
218 |
writePidFile path = do |
219 |
fd <- openFd path ReadWrite (Just pidFileMode) pidFileFlags |
220 |
setLock fd (WriteLock, AbsoluteSeek, 0, 0) |
221 |
my_pid <- getProcessID |
222 |
_ <- fdWrite fd (show my_pid ++ "\n") |
223 |
return fd |
224 |
|
225 |
-- | Helper function to ensure a socket doesn't exist. Should only be |
226 |
-- called once we have locked the pid file successfully. |
227 |
cleanupSocket :: FilePath -> IO () |
228 |
cleanupSocket socketPath = |
229 |
catchJust (guard . isDoesNotExistError) (removeLink socketPath) |
230 |
(const $ return ()) |
231 |
|
232 |
-- | Sets up a daemon's environment. |
233 |
setupDaemonEnv :: FilePath -> FileMode -> IO () |
234 |
setupDaemonEnv cwd umask = do |
235 |
changeWorkingDirectory cwd |
236 |
_ <- setFileCreationMask umask |
237 |
_ <- createSession |
238 |
return () |
239 |
|
240 |
-- | Cleanup function, performing all the operations that need to be done prior |
241 |
-- to shutting down a daemon. |
242 |
finalCleanup :: FilePath -> IO () |
243 |
finalCleanup = removeFile |
244 |
|
245 |
-- | Signal handler for the termination signal. |
246 |
handleSigTerm :: ThreadId -> IO () |
247 |
handleSigTerm mainTID = |
248 |
-- Throw termination exception to the main thread, so that the daemon is |
249 |
-- actually stopped in the proper way, executing all the functions waiting on |
250 |
-- "finally" statement. |
251 |
Control.Exception.throwTo mainTID ExitSuccess |
252 |
|
253 |
-- | Signal handler for reopening log files. |
254 |
handleSigHup :: FilePath -> IO () |
255 |
handleSigHup path = do |
256 |
setupDaemonFDs (Just path) |
257 |
logInfo "Reopening log files after receiving SIGHUP" |
258 |
|
259 |
-- | Sets up a daemon's standard file descriptors. |
260 |
setupDaemonFDs :: Maybe FilePath -> IO () |
261 |
setupDaemonFDs logfile = do |
262 |
null_in_handle <- openFile devNull ReadMode |
263 |
null_out_handle <- openFile (fromMaybe devNull logfile) AppendMode |
264 |
hDuplicateTo null_in_handle stdin |
265 |
hDuplicateTo null_out_handle stdout |
266 |
hDuplicateTo null_out_handle stderr |
267 |
hClose null_in_handle |
268 |
hClose null_out_handle |
269 |
|
270 |
-- | Computes the default bind address for a given family. |
271 |
defaultBindAddr :: Int -- ^ The port we want |
272 |
-> Socket.Family -- ^ The cluster IP family |
273 |
-> Result (Socket.Family, Socket.SockAddr) |
274 |
defaultBindAddr port Socket.AF_INET = |
275 |
Ok (Socket.AF_INET, |
276 |
Socket.SockAddrInet (fromIntegral port) Socket.iNADDR_ANY) |
277 |
defaultBindAddr port Socket.AF_INET6 = |
278 |
Ok (Socket.AF_INET6, |
279 |
Socket.SockAddrInet6 (fromIntegral port) 0 Socket.iN6ADDR_ANY 0) |
280 |
defaultBindAddr _ fam = Bad $ "Unsupported address family: " ++ show fam |
281 |
|
282 |
-- | Based on the options, compute the socket address to use for the |
283 |
-- daemon. |
284 |
parseAddress :: DaemonOptions -- ^ Command line options |
285 |
-> Int -- ^ Default port for this daemon |
286 |
-> IO (Result (Socket.Family, Socket.SockAddr)) |
287 |
parseAddress opts defport = do |
288 |
let port = maybe defport fromIntegral $ optPort opts |
289 |
def_family <- Ssconf.getPrimaryIPFamily Nothing |
290 |
case optBindAddress opts of |
291 |
Nothing -> return (def_family >>= defaultBindAddr port) |
292 |
Just saddr -> Control.Exception.catch |
293 |
(resolveAddr port saddr) |
294 |
(ioErrorToResult $ "Invalid address " ++ saddr) |
295 |
|
296 |
-- | Environment variable to override the assumed host name of the |
297 |
-- current node. |
298 |
vClusterHostNameEnvVar :: String |
299 |
vClusterHostNameEnvVar = "GANETI_HOSTNAME" |
300 |
|
301 |
getFQDN :: IO String |
302 |
getFQDN = do |
303 |
hostname <- getHostName |
304 |
addrInfos <- Socket.getAddrInfo Nothing (Just hostname) Nothing |
305 |
let address = listToMaybe addrInfos >>= (Just . Socket.addrAddress) |
306 |
case address of |
307 |
Just a -> do |
308 |
fqdn <- liftM fst $ Socket.getNameInfo [] True False a |
309 |
return (fromMaybe hostname fqdn) |
310 |
Nothing -> return hostname |
311 |
|
312 |
-- | Returns if the current node is the master node. |
313 |
isMaster :: IO Bool |
314 |
isMaster = do |
315 |
let ioErrorToNothing :: IOError -> IO (Maybe String) |
316 |
ioErrorToNothing _ = return Nothing |
317 |
vcluster_node <- Control.Exception.catch |
318 |
(liftM Just (getEnv vClusterHostNameEnvVar)) |
319 |
ioErrorToNothing |
320 |
curNode <- case vcluster_node of |
321 |
Just node_name -> return node_name |
322 |
Nothing -> getFQDN |
323 |
masterNode <- Ssconf.getMasterNode Nothing |
324 |
case masterNode of |
325 |
Ok n -> return (curNode == n) |
326 |
Bad _ -> return False |
327 |
|
328 |
-- | Ensures that the daemon runs on the right node (and exits |
329 |
-- gracefully if it doesnt) |
330 |
ensureNode :: GanetiDaemon -> IO () |
331 |
ensureNode daemon = do |
332 |
is_master <- isMaster |
333 |
when (daemonOnlyOnMaster daemon && not is_master) $ do |
334 |
putStrLn "Not master, exiting." |
335 |
exitWith (ExitFailure C.exitNotmaster) |
336 |
|
337 |
-- | Run an I\/O action that might throw an I\/O error, under a |
338 |
-- handler that will simply annotate and re-throw the exception. |
339 |
describeError :: String -> Maybe Handle -> Maybe FilePath -> IO a -> IO a |
340 |
describeError descr hndl fpath = |
341 |
modifyIOError (\e -> annotateIOError e descr hndl fpath) |
342 |
|
343 |
-- | Run an I\/O action as a daemon. |
344 |
-- |
345 |
-- WARNING: this only works in single-threaded mode (either using the |
346 |
-- single-threaded runtime, or using the multi-threaded one but with |
347 |
-- only one OS thread, i.e. -N1). |
348 |
daemonize :: FilePath -> (Maybe Fd -> IO ()) -> IO () |
349 |
daemonize logfile action = do |
350 |
(rpipe, wpipe) <- createPipe |
351 |
-- first fork |
352 |
_ <- forkProcess $ do |
353 |
-- in the child |
354 |
closeFd rpipe |
355 |
let wpipe' = Just wpipe |
356 |
setupDaemonEnv "/" (unionFileModes groupModes otherModes) |
357 |
setupDaemonFDs (Just logfile) `Control.Exception.catch` |
358 |
handlePrepErr False wpipe' |
359 |
_ <- installHandler lostConnection (Catch (handleSigHup logfile)) Nothing |
360 |
-- second fork, launches the actual child code; standard |
361 |
-- double-fork technique |
362 |
_ <- forkProcess (action wpipe') |
363 |
exitImmediately ExitSuccess |
364 |
closeFd wpipe |
365 |
hndl <- fdToHandle rpipe |
366 |
errors <- hGetContents hndl |
367 |
ecode <- if null errors |
368 |
then return ExitSuccess |
369 |
else do |
370 |
hPutStrLn stderr $ daemonStartupErr errors |
371 |
return $ ExitFailure C.exitFailure |
372 |
exitImmediately ecode |
373 |
|
374 |
-- | Generic daemon startup. |
375 |
genericMain :: GanetiDaemon -- ^ The daemon we're running |
376 |
-> [OptType] -- ^ The available options |
377 |
-> CheckFn a -- ^ Check function |
378 |
-> PrepFn a b -- ^ Prepare function |
379 |
-> MainFn a b -- ^ Execution function |
380 |
-> IO () |
381 |
genericMain daemon options check_fn prep_fn exec_fn = do |
382 |
let progname = daemonName daemon |
383 |
|
384 |
(opts, args) <- parseArgs progname options |
385 |
|
386 |
ensureNode daemon |
387 |
|
388 |
exitUnless (null args) "This program doesn't take any arguments" |
389 |
|
390 |
unless (optNoUserChecks opts) $ do |
391 |
runtimeEnts <- getEnts |
392 |
ents <- exitIfBad "Can't find required user/groups" runtimeEnts |
393 |
verifyDaemonUser daemon ents |
394 |
|
395 |
syslog <- case optSyslogUsage opts of |
396 |
Nothing -> exitIfBad "Invalid cluster syslog setting" $ |
397 |
syslogUsageFromRaw C.syslogUsage |
398 |
Just v -> return v |
399 |
|
400 |
log_file <- daemonLogFile daemon |
401 |
-- run the check function and optionally exit if it returns an exit code |
402 |
check_result <- check_fn opts |
403 |
check_result' <- case check_result of |
404 |
Left code -> exitWith code |
405 |
Right v -> return v |
406 |
|
407 |
let processFn = if optDaemonize opts |
408 |
then daemonize log_file |
409 |
else \action -> action Nothing |
410 |
processFn $ innerMain daemon opts syslog check_result' prep_fn exec_fn |
411 |
|
412 |
-- | Full prepare function. |
413 |
-- |
414 |
-- This is executed after daemonization, and sets up both the log |
415 |
-- files (a generic functionality) and the custom prepare function of |
416 |
-- the daemon. |
417 |
fullPrep :: GanetiDaemon -- ^ The daemon we're running |
418 |
-> DaemonOptions -- ^ The options structure, filled from the cmdline |
419 |
-> SyslogUsage -- ^ Syslog mode |
420 |
-> a -- ^ Check results |
421 |
-> PrepFn a b -- ^ Prepare function |
422 |
-> IO (FilePath, b) |
423 |
fullPrep daemon opts syslog check_result prep_fn = do |
424 |
logfile <- if optDaemonize opts |
425 |
then return Nothing |
426 |
else liftM Just $ daemonLogFile daemon |
427 |
pidfile <- daemonPidFile daemon |
428 |
let dname = daemonName daemon |
429 |
setupLogging logfile dname (optDebug opts) True False syslog |
430 |
_ <- describeError "writing PID file; already locked?" |
431 |
Nothing (Just pidfile) $ writePidFile pidfile |
432 |
logNotice $ dname ++ " daemon startup" |
433 |
prep_res <- prep_fn opts check_result |
434 |
tid <- myThreadId |
435 |
_ <- installHandler sigTERM (Catch $ handleSigTerm tid) Nothing |
436 |
return (pidfile, prep_res) |
437 |
|
438 |
-- | Inner daemon function. |
439 |
-- |
440 |
-- This is executed after daemonization. |
441 |
innerMain :: GanetiDaemon -- ^ The daemon we're running |
442 |
-> DaemonOptions -- ^ The options structure, filled from the cmdline |
443 |
-> SyslogUsage -- ^ Syslog mode |
444 |
-> a -- ^ Check results |
445 |
-> PrepFn a b -- ^ Prepare function |
446 |
-> MainFn a b -- ^ Execution function |
447 |
-> Maybe Fd -- ^ Error reporting function |
448 |
-> IO () |
449 |
innerMain daemon opts syslog check_result prep_fn exec_fn fd = do |
450 |
(pidFile, prep_result) <- fullPrep daemon opts syslog check_result prep_fn |
451 |
`Control.Exception.catch` handlePrepErr True fd |
452 |
-- no error reported, we should now close the fd |
453 |
maybeCloseFd fd |
454 |
finally (exec_fn opts check_result prep_result) (finalCleanup pidFile) |
455 |
|
456 |
-- | Daemon prepare error handling function. |
457 |
handlePrepErr :: Bool -> Maybe Fd -> IOError -> IO a |
458 |
handlePrepErr logging_setup fd err = do |
459 |
let msg = show err |
460 |
case fd of |
461 |
-- explicitly writing to the fd directly, since when forking it's |
462 |
-- better (safer) than trying to convert this into a full handle |
463 |
Just fd' -> fdWrite fd' msg >> return () |
464 |
Nothing -> hPutStrLn stderr (daemonStartupErr msg) |
465 |
when logging_setup $ logError msg |
466 |
exitWith $ ExitFailure 1 |
467 |
|
468 |
-- | Close a file descriptor. |
469 |
maybeCloseFd :: Maybe Fd -> IO () |
470 |
maybeCloseFd Nothing = return () |
471 |
maybeCloseFd (Just fd) = closeFd fd |