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