code.grnet.gr Git - ganeti-local/blob - src/Ganeti/Daemon.hs

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