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