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