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.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