Statistics
| Branch: | Tag: | Revision:

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