Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Daemon.hs @ ecff332f

History | View | Annotate | Download (15.4 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, listToMaybe)
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
getFQDN :: IO String
301
getFQDN = do
302
  hostname <- getHostName
303
  addrInfos <- Socket.getAddrInfo Nothing (Just hostname) Nothing
304
  let address = listToMaybe addrInfos >>= (Just . Socket.addrAddress)
305
  case address of
306
    Just a -> do
307
      fqdn <- liftM fst $ Socket.getNameInfo [] True False a
308
      return (fromMaybe hostname fqdn)
309
    Nothing -> return hostname
310

    
311
-- | Returns if the current node is the master node.
312
isMaster :: IO Bool
313
isMaster = do
314
  let ioErrorToNothing :: IOError -> IO (Maybe String)
315
      ioErrorToNothing _ = return Nothing
316
  vcluster_node <- Control.Exception.catch
317
                     (liftM Just (getEnv vClusterHostNameEnvVar))
318
                     ioErrorToNothing
319
  curNode <- case vcluster_node of
320
    Just node_name -> return node_name
321
    Nothing -> getFQDN
322
  masterNode <- Ssconf.getMasterNode Nothing
323
  case masterNode of
324
    Ok n -> return (curNode == n)
325
    Bad _ -> return False
326

    
327
-- | Ensures that the daemon runs on the right node (and exits
328
-- gracefully if it doesnt)
329
ensureNode :: GanetiDaemon -> IO ()
330
ensureNode daemon = do
331
  is_master <- isMaster
332
  when (daemonOnlyOnMaster daemon && not is_master) $ do
333
    putStrLn "Not master, exiting."
334
    exitWith (ExitFailure C.exitNotmaster)
335

    
336
-- | Run an I\/O action that might throw an I\/O error, under a
337
-- handler that will simply annotate and re-throw the exception.
338
describeError :: String -> Maybe Handle -> Maybe FilePath -> IO a -> IO a
339
describeError descr hndl fpath =
340
  modifyIOError (\e -> annotateIOError e descr hndl fpath)
341

    
342
-- | Run an I\/O action as a daemon.
343
--
344
-- WARNING: this only works in single-threaded mode (either using the
345
-- single-threaded runtime, or using the multi-threaded one but with
346
-- only one OS thread, i.e. -N1).
347
daemonize :: FilePath -> (Maybe Fd -> IO ()) -> IO ()
348
daemonize logfile action = do
349
  (rpipe, wpipe) <- createPipe
350
  -- first fork
351
  _ <- forkProcess $ do
352
    -- in the child
353
    closeFd rpipe
354
    let wpipe' = Just wpipe
355
    setupDaemonEnv "/" (unionFileModes groupModes otherModes)
356
    setupDaemonFDs (Just logfile) `Control.Exception.catch`
357
      handlePrepErr False wpipe'
358
    _ <- installHandler lostConnection (Catch (handleSigHup logfile)) Nothing
359
    -- second fork, launches the actual child code; standard
360
    -- double-fork technique
361
    _ <- forkProcess (action wpipe')
362
    exitImmediately ExitSuccess
363
  closeFd wpipe
364
  hndl <- fdToHandle rpipe
365
  errors <- hGetContents hndl
366
  ecode <- if null errors
367
             then return ExitSuccess
368
             else do
369
               hPutStrLn stderr $ daemonStartupErr errors
370
               return $ ExitFailure C.exitFailure
371
  exitImmediately ecode
372

    
373
-- | Generic daemon startup.
374
genericMain :: GanetiDaemon -- ^ The daemon we're running
375
            -> [OptType]    -- ^ The available options
376
            -> CheckFn a    -- ^ Check function
377
            -> PrepFn  a b  -- ^ Prepare function
378
            -> MainFn  a b  -- ^ Execution function
379
            -> IO ()
380
genericMain daemon options check_fn prep_fn exec_fn = do
381
  let progname = daemonName daemon
382

    
383
  (opts, args) <- parseArgs progname options
384

    
385
  ensureNode daemon
386

    
387
  exitUnless (null args) "This program doesn't take any arguments"
388

    
389
  unless (optNoUserChecks opts) $ do
390
    runtimeEnts <- getEnts
391
    ents <- exitIfBad "Can't find required user/groups" runtimeEnts
392
    verifyDaemonUser daemon ents
393

    
394
  syslog <- case optSyslogUsage opts of
395
              Nothing -> exitIfBad "Invalid cluster syslog setting" $
396
                         syslogUsageFromRaw C.syslogUsage
397
              Just v -> return v
398

    
399
  log_file <- daemonLogFile daemon
400
  -- run the check function and optionally exit if it returns an exit code
401
  check_result <- check_fn opts
402
  check_result' <- case check_result of
403
                     Left code -> exitWith code
404
                     Right v -> return v
405

    
406
  let processFn = if optDaemonize opts
407
                    then daemonize log_file
408
                    else \action -> action Nothing
409
  processFn $ innerMain daemon opts syslog check_result' prep_fn exec_fn
410

    
411
-- | Full prepare function.
412
--
413
-- This is executed after daemonization, and sets up both the log
414
-- files (a generic functionality) and the custom prepare function of
415
-- the daemon.
416
fullPrep :: GanetiDaemon  -- ^ The daemon we're running
417
         -> DaemonOptions -- ^ The options structure, filled from the cmdline
418
         -> SyslogUsage   -- ^ Syslog mode
419
         -> a             -- ^ Check results
420
         -> PrepFn a b    -- ^ Prepare function
421
         -> IO b
422
fullPrep daemon opts syslog check_result prep_fn = do
423
  logfile <- if optDaemonize opts
424
               then return Nothing
425
               else liftM Just $ daemonLogFile daemon
426
  pidfile <- daemonPidFile daemon
427
  let dname = daemonName daemon
428
  setupLogging logfile dname (optDebug opts) True False syslog
429
  _ <- describeError "writing PID file; already locked?"
430
         Nothing (Just pidfile) $ writePidFile pidfile
431
  logNotice $ dname ++ " daemon startup"
432
  prep_fn opts check_result
433

    
434
-- | Inner daemon function.
435
--
436
-- This is executed after daemonization.
437
innerMain :: GanetiDaemon  -- ^ The daemon we're running
438
          -> DaemonOptions -- ^ The options structure, filled from the cmdline
439
          -> SyslogUsage   -- ^ Syslog mode
440
          -> a             -- ^ Check results
441
          -> PrepFn a b    -- ^ Prepare function
442
          -> MainFn a b    -- ^ Execution function
443
          -> Maybe Fd      -- ^ Error reporting function
444
          -> IO ()
445
innerMain daemon opts syslog check_result prep_fn exec_fn fd = do
446
  prep_result <- fullPrep daemon opts syslog check_result prep_fn
447
                 `Control.Exception.catch` handlePrepErr True fd
448
  -- no error reported, we should now close the fd
449
  maybeCloseFd fd
450
  exec_fn opts check_result prep_result
451

    
452
-- | Daemon prepare error handling function.
453
handlePrepErr :: Bool -> Maybe Fd -> IOError -> IO a
454
handlePrepErr logging_setup fd err = do
455
  let msg = show err
456
  case fd of
457
    -- explicitly writing to the fd directly, since when forking it's
458
    -- better (safer) than trying to convert this into a full handle
459
    Just fd' -> fdWrite fd' msg >> return ()
460
    Nothing  -> hPutStrLn stderr (daemonStartupErr msg)
461
  when logging_setup $ logError msg
462
  exitWith $ ExitFailure 1
463

    
464
-- | Close a file descriptor.
465
maybeCloseFd :: Maybe Fd -> IO ()
466
maybeCloseFd Nothing   = return ()
467
maybeCloseFd (Just fd) = closeFd fd