Daemon.hs 15.1 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
{-| Implementation of the generic daemon functionality.

-}

{-

Copyright (C) 2011, 2012 Google Inc.

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA.

-}

module Ganeti.Daemon
  ( DaemonOptions(..)
  , OptType
29
30
31
  , CheckFn
  , PrepFn
  , MainFn
32
33
34
35
36
37
38
  , defaultOptions
  , oShowHelp
  , oShowVer
  , oNoDaemonize
  , oNoUserChecks
  , oDebug
  , oPort
Iustin Pop's avatar
Iustin Pop committed
39
  , oBindAddress
40
  , oSyslogUsage
41
  , parseArgs
Iustin Pop's avatar
Iustin Pop committed
42
  , parseAddress
43
  , cleanupSocket
44
  , describeError
45
46
47
  , genericMain
  ) where

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)
Iustin Pop's avatar
Iustin Pop committed
54
import qualified Network.Socket as Socket
55
56
57
58
import System.Console.GetOpt
import System.Exit
import System.Environment
import System.IO
59
import System.IO.Error (isDoesNotExistError, modifyIOError, annotateIOError)
60
61
62
63
64
import System.Posix.Directory
import System.Posix.Files
import System.Posix.IO
import System.Posix.Process
import System.Posix.Types
65
import System.Posix.Signals
66

Iustin Pop's avatar
Iustin Pop committed
67
import Ganeti.Common as Common
68
69
70
import Ganeti.Logging
import Ganeti.Runtime
import Ganeti.BasicTypes
71
import Ganeti.Utils
72
import qualified Ganeti.Constants as C
Iustin Pop's avatar
Iustin Pop committed
73
import qualified Ganeti.Ssconf as Ssconf
74

75
76
77
78
79
80
-- * Constants

-- | \/dev\/null path.
devNull :: FilePath
devNull = "/dev/null"

81
82
83
84
85
-- | Error message prefix, used in two separate paths (when forking
-- and when not).
daemonStartupErr :: String -> String
daemonStartupErr = ("Error when starting the daemon process: " ++)

86
87
88
89
90
91
-- * Data types

-- | Command line options structure.
data DaemonOptions = DaemonOptions
  { optShowHelp     :: Bool           -- ^ Just show the help
  , optShowVer      :: Bool           -- ^ Just show the program version
92
  , optShowComp     :: Bool           -- ^ Just show the completion info
93
94
95
96
  , optDaemonize    :: Bool           -- ^ Whether to daemonize or not
  , optPort         :: Maybe Word16   -- ^ Override for the network port
  , optDebug        :: Bool           -- ^ Enable debug messages
  , optNoUserChecks :: Bool           -- ^ Ignore user checks
Iustin Pop's avatar
Iustin Pop committed
97
  , optBindAddress  :: Maybe String   -- ^ Override for the bind address
98
  , optSyslogUsage  :: Maybe SyslogUsage -- ^ Override for Syslog usage
99
100
101
102
103
104
105
  }

-- | Default values for the command line options.
defaultOptions :: DaemonOptions
defaultOptions  = DaemonOptions
  { optShowHelp     = False
  , optShowVer      = False
106
  , optShowComp     = False
107
108
109
110
  , optDaemonize    = True
  , optPort         = Nothing
  , optDebug        = False
  , optNoUserChecks = False
Iustin Pop's avatar
Iustin Pop committed
111
  , optBindAddress  = Nothing
112
  , optSyslogUsage  = Nothing
113
114
  }

Iustin Pop's avatar
Iustin Pop committed
115
116
117
instance StandardOptions DaemonOptions where
  helpRequested = optShowHelp
  verRequested  = optShowVer
118
  compRequested = optShowComp
Iustin Pop's avatar
Iustin Pop committed
119
120
  requestHelp o = o { optShowHelp = True }
  requestVer  o = o { optShowVer  = True }
121
  requestComp o = o { optShowComp = True }
Iustin Pop's avatar
Iustin Pop committed
122

123
-- | Abrreviation for the option type.
Iustin Pop's avatar
Iustin Pop committed
124
type OptType = GenericOptType DaemonOptions
125

126
127
128
129
130
131
132
133
134
-- | Check function type.
type CheckFn a = DaemonOptions -> IO (Either ExitCode a)

-- | Prepare function type.
type PrepFn a b = DaemonOptions -> a -> IO b

-- | Main execution function type.
type MainFn a b = DaemonOptions -> a -> b -> IO ()

135
136
137
-- * Command line options

oNoDaemonize :: OptType
138
139
140
141
142
oNoDaemonize =
  (Option "f" ["foreground"]
   (NoArg (\ opts -> Ok opts { optDaemonize = False}))
   "Don't detach from the current terminal",
   OptComplNone)
143
144

oDebug :: OptType
145
146
147
148
149
oDebug =
  (Option "d" ["debug"]
   (NoArg (\ opts -> Ok opts { optDebug = True }))
   "Enable debug messages",
   OptComplNone)
150
151

oNoUserChecks :: OptType
152
153
154
155
156
oNoUserChecks =
  (Option "" ["no-user-checks"]
   (NoArg (\ opts -> Ok opts { optNoUserChecks = True }))
   "Ignore user checks",
   OptComplNone)
157
158

oPort :: Int -> OptType
159
160
161
162
163
oPort def =
  (Option "p" ["port"]
   (reqWithConversion (tryRead "reading port")
    (\port opts -> Ok opts { optPort = Just port }) "PORT")
   ("Network port (default: " ++ show def ++ ")"),
164
   OptComplInteger)
165

Iustin Pop's avatar
Iustin Pop committed
166
oBindAddress :: OptType
167
168
169
170
171
172
oBindAddress =
  (Option "b" ["bind"]
   (ReqArg (\addr opts -> Ok opts { optBindAddress = Just addr })
    "ADDR")
   "Bind address (default depends on cluster configuration)",
   OptComplInetAddr)
Iustin Pop's avatar
Iustin Pop committed
173

174
oSyslogUsage :: OptType
175
176
177
178
179
180
181
182
183
oSyslogUsage =
  (Option "" ["syslog"]
   (reqWithConversion syslogUsageFromRaw
    (\su opts -> Ok opts { optSyslogUsage = Just su })
    "SYSLOG")
   ("Enable logging to syslog (except debug \
    \messages); one of 'no', 'yes' or 'only' [" ++ C.syslogUsage ++
    "]"),
   OptComplChoices ["yes", "no", "only"])
184

185
186
187
188
-- | Generic options.
genericOpts :: [OptType]
genericOpts = [ oShowHelp
              , oShowVer
189
              , oShowComp
190
191
              ]

192
193
194
195
196
197
-- | Annotates and transforms IOErrors into a Result type. This can be
-- used in the error handler argument to 'catch', for example.
ioErrorToResult :: String -> IOError -> IO (Result a)
ioErrorToResult description exc =
  return . Bad $ description ++ ": " ++ show exc

198
199
200
201
-- | Small wrapper over getArgs and 'parseOpts'.
parseArgs :: String -> [OptType] -> IO (DaemonOptions, [String])
parseArgs cmd options = do
  cmd_args <- getArgs
202
  parseOpts defaultOptions cmd_args cmd (options ++ genericOpts) []
203
204

-- * Daemon-related functions
205

206
207
208
209
-- | PID file mode.
pidFileMode :: FileMode
pidFileMode = unionFileModes ownerReadMode ownerWriteMode

210
211
212
213
-- | PID file open flags.
pidFileFlags :: OpenFileFlags
pidFileFlags = defaultFileFlags { noctty = True, trunc = False }

214
-- | Writes a PID file and locks it.
215
216
writePidFile :: FilePath -> IO Fd
writePidFile path = do
217
  fd <- openFd path ReadWrite (Just pidFileMode) pidFileFlags
218
219
220
221
222
  setLock fd (WriteLock, AbsoluteSeek, 0, 0)
  my_pid <- getProcessID
  _ <- fdWrite fd (show my_pid ++ "\n")
  return fd

223
224
225
-- | Helper function to ensure a socket doesn't exist. Should only be
-- called once we have locked the pid file successfully.
cleanupSocket :: FilePath -> IO ()
Iustin Pop's avatar
Iustin Pop committed
226
cleanupSocket socketPath =
227
228
229
  catchJust (guard . isDoesNotExistError) (removeLink socketPath)
            (const $ return ())

230
231
232
233
234
235
236
237
-- | Sets up a daemon's environment.
setupDaemonEnv :: FilePath -> FileMode -> IO ()
setupDaemonEnv cwd umask = do
  changeWorkingDirectory cwd
  _ <- setFileCreationMask umask
  _ <- createSession
  return ()

238
239
240
241
242
243
-- | Signal handler for reopening log files.
handleSigHup :: FilePath -> IO ()
handleSigHup path = do
  setupDaemonFDs (Just path)
  logInfo "Reopening log files after receiving SIGHUP"

244
245
246
247
248
249
250
251
252
253
254
-- | Sets up a daemon's standard file descriptors.
setupDaemonFDs :: Maybe FilePath -> IO ()
setupDaemonFDs logfile = do
  null_in_handle <- openFile devNull ReadMode
  null_out_handle <- openFile (fromMaybe devNull logfile) AppendMode
  hDuplicateTo null_in_handle stdin
  hDuplicateTo null_out_handle stdout
  hDuplicateTo null_out_handle stderr
  hClose null_in_handle
  hClose null_out_handle

Iustin Pop's avatar
Iustin Pop committed
255
256
257
258
259
-- | Computes the default bind address for a given family.
defaultBindAddr :: Int                  -- ^ The port we want
                -> Socket.Family        -- ^ The cluster IP family
                -> Result (Socket.Family, Socket.SockAddr)
defaultBindAddr port Socket.AF_INET =
Iustin Pop's avatar
Iustin Pop committed
260
261
  Ok (Socket.AF_INET,
      Socket.SockAddrInet (fromIntegral port) Socket.iNADDR_ANY)
Iustin Pop's avatar
Iustin Pop committed
262
defaultBindAddr port Socket.AF_INET6 =
Iustin Pop's avatar
Iustin Pop committed
263
264
  Ok (Socket.AF_INET6,
      Socket.SockAddrInet6 (fromIntegral port) 0 Socket.iN6ADDR_ANY 0)
Iustin Pop's avatar
Iustin Pop committed
265
266
267
268
269
270
271
272
273
274
275
276
277
278
defaultBindAddr _ fam = Bad $ "Unsupported address family: " ++ show fam

-- | Default hints for the resolver
resolveAddrHints :: Maybe Socket.AddrInfo
resolveAddrHints =
  Just Socket.defaultHints { Socket.addrFlags = [Socket.AI_NUMERICHOST,
                                                 Socket.AI_NUMERICSERV] }

-- | Resolves a numeric address.
resolveAddr :: Int -> String -> IO (Result (Socket.Family, Socket.SockAddr))
resolveAddr port str = do
  resolved <- Socket.getAddrInfo resolveAddrHints (Just str) (Just (show port))
  return $ case resolved of
             [] -> Bad "Invalid results from lookup?"
Iustin Pop's avatar
Iustin Pop committed
279
             best:_ -> Ok (Socket.addrFamily best, Socket.addrAddress best)
Iustin Pop's avatar
Iustin Pop committed
280
281
282
283
284
285
286
287
288

-- | Based on the options, compute the socket address to use for the
-- daemon.
parseAddress :: DaemonOptions      -- ^ Command line options
             -> Int                -- ^ Default port for this daemon
             -> IO (Result (Socket.Family, Socket.SockAddr))
parseAddress opts defport = do
  let port = maybe defport fromIntegral $ optPort opts
  def_family <- Ssconf.getPrimaryIPFamily Nothing
Iustin Pop's avatar
Iustin Pop committed
289
290
  case optBindAddress opts of
    Nothing -> return (def_family >>= defaultBindAddr port)
291
292
    Just saddr -> Control.Exception.catch
                    (resolveAddr port saddr)
293
                    (ioErrorToResult $ "Invalid address " ++ saddr)
Iustin Pop's avatar
Iustin Pop committed
294

295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
-- | Environment variable to override the assumed host name of the
-- current node.
vClusterHostNameEnvVar :: String
vClusterHostNameEnvVar = "GANETI_HOSTNAME"

-- | Returns if the current node is the master node.
isMaster :: IO Bool
isMaster = do
  let ioErrorToNothing :: IOError -> IO (Maybe String)
      ioErrorToNothing _ = return Nothing
  vcluster_node <- Control.Exception.catch
                     (liftM Just (getEnv vClusterHostNameEnvVar))
                     ioErrorToNothing
  curNode <- case vcluster_node of
    Just node_name -> return node_name
    Nothing -> getHostName
  masterNode <- Ssconf.getMasterNode Nothing
  case masterNode of
    Ok n -> return (curNode == n)
    Bad _ -> return False

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

325
326
327
328
329
330
331
-- | Run an I\/O action that might throw an I\/O error, under a
-- handler that will simply annotate and re-throw the exception.
describeError :: String -> Maybe Handle -> Maybe FilePath -> IO a -> IO a
describeError descr hndl fpath =
  modifyIOError (\e -> annotateIOError e descr hndl fpath)

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

-- | Generic daemon startup.
363
364
365
366
367
368
369
genericMain :: GanetiDaemon -- ^ The daemon we're running
            -> [OptType]    -- ^ The available options
            -> CheckFn a    -- ^ Check function
            -> PrepFn  a b  -- ^ Prepare function
            -> MainFn  a b  -- ^ Execution function
            -> IO ()
genericMain daemon options check_fn prep_fn exec_fn = do
370
  let progname = daemonName daemon
371

372
373
  (opts, args) <- parseArgs progname options

374
375
  ensureNode daemon

Iustin Pop's avatar
Iustin Pop committed
376
  exitUnless (null args) "This program doesn't take any arguments"
377
378
379

  unless (optNoUserChecks opts) $ do
    runtimeEnts <- getEnts
Iustin Pop's avatar
Iustin Pop committed
380
381
    ents <- exitIfBad "Can't find required user/groups" runtimeEnts
    verifyDaemonUser daemon ents
382

383
  syslog <- case optSyslogUsage opts of
Iustin Pop's avatar
Iustin Pop committed
384
              Nothing -> exitIfBad "Invalid cluster syslog setting" $
385
386
                         syslogUsageFromRaw C.syslogUsage
              Just v -> return v
387

Iustin Pop's avatar
Iustin Pop committed
388
  log_file <- daemonLogFile daemon
389
390
391
392
393
394
  -- run the check function and optionally exit if it returns an exit code
  check_result <- check_fn opts
  check_result' <- case check_result of
                     Left code -> exitWith code
                     Right v -> return v

395
  let processFn = if optDaemonize opts
Iustin Pop's avatar
Iustin Pop committed
396
                    then daemonize log_file
397
                    else \action -> action Nothing
398
  processFn $ innerMain daemon opts syslog check_result' prep_fn exec_fn
399

400
401
402
403
404
405
406
407
408
409
410
411
-- | Full prepare function.
--
-- This is executed after daemonization, and sets up both the log
-- files (a generic functionality) and the custom prepare function of
-- the daemon.
fullPrep :: GanetiDaemon  -- ^ The daemon we're running
         -> DaemonOptions -- ^ The options structure, filled from the cmdline
         -> SyslogUsage   -- ^ Syslog mode
         -> a             -- ^ Check results
         -> PrepFn a b    -- ^ Prepare function
         -> IO b
fullPrep daemon opts syslog check_result prep_fn = do
Iustin Pop's avatar
Iustin Pop committed
412
413
414
415
416
  logfile <- if optDaemonize opts
               then return Nothing
               else liftM Just $ daemonLogFile daemon
  pidfile <- daemonPidFile daemon
  let dname = daemonName daemon
Iustin Pop's avatar
Iustin Pop committed
417
  setupLogging logfile dname (optDebug opts) True False syslog
418
419
  _ <- describeError "writing PID file; already locked?"
         Nothing (Just pidfile) $ writePidFile pidfile
Iustin Pop's avatar
Iustin Pop committed
420
  logNotice $ dname ++ " daemon startup"
421
422
  prep_fn opts check_result

423
424
425
-- | Inner daemon function.
--
-- This is executed after daemonization.
426
427
428
429
430
431
innerMain :: GanetiDaemon  -- ^ The daemon we're running
          -> DaemonOptions -- ^ The options structure, filled from the cmdline
          -> SyslogUsage   -- ^ Syslog mode
          -> a             -- ^ Check results
          -> PrepFn a b    -- ^ Prepare function
          -> MainFn a b    -- ^ Execution function
432
          -> Maybe Fd      -- ^ Error reporting function
433
          -> IO ()
434
435
innerMain daemon opts syslog check_result prep_fn exec_fn fd = do
  prep_result <- fullPrep daemon opts syslog check_result prep_fn
436
                 `Control.Exception.catch` handlePrepErr True fd
437
438
  -- no error reported, we should now close the fd
  maybeCloseFd fd
439
  exec_fn opts check_result prep_result
440
441

-- | Daemon prepare error handling function.
442
443
handlePrepErr :: Bool -> Maybe Fd -> IOError -> IO a
handlePrepErr logging_setup fd err = do
444
445
446
447
448
449
  let msg = show err
  case fd of
    -- explicitly writing to the fd directly, since when forking it's
    -- better (safer) than trying to convert this into a full handle
    Just fd' -> fdWrite fd' msg >> return ()
    Nothing  -> hPutStrLn stderr (daemonStartupErr msg)
450
  when logging_setup $ logError msg
451
452
453
454
455
456
  exitWith $ ExitFailure 1

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