code.grnet.gr Git - ganeti-local/blob - htools/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   , defaultOptions
  30   , oShowHelp
  31   , oShowVer
  32   , oNoDaemonize
  33   , oNoUserChecks
  34   , oDebug
  35   , oPort
  36   , oBindAddress
  37   , oSyslogUsage
  38   , parseArgs
  39   , parseAddress
  40   , cleanupSocket
  41   , writePidFile
  42   , genericMain
  43   ) where
  44
  45 import Control.Exception
  46 import Control.Monad
  47 import Data.Maybe (fromMaybe)
  48 import Data.Word
  49 import GHC.IO.Handle (hDuplicateTo)
  50 import qualified Network.Socket as Socket
  51 import Prelude hiding (catch)
  52 import System.Console.GetOpt
  53 import System.Exit
  54 import System.Environment
  55 import System.IO
  56 import System.IO.Error (isDoesNotExistError)
  57 import System.Posix.Directory
  58 import System.Posix.Files
  59 import System.Posix.IO
  60 import System.Posix.Process
  61 import System.Posix.Types
  62 import System.Posix.Signals
  63
  64 import Ganeti.Common as Common
  65 import Ganeti.Logging
  66 import Ganeti.Runtime
  67 import Ganeti.BasicTypes
  68 import Ganeti.Utils
  69 import qualified Ganeti.Constants as C
  70 import qualified Ganeti.Ssconf as Ssconf
  71
  72 -- * Constants
  73
  74 -- | \/dev\/null path.
  75 devNull :: FilePath
  76 devNull = "/dev/null"
  77
  78 -- * Data types
  79
  80 -- | Command line options structure.
  81 data DaemonOptions = DaemonOptions
  82   { optShowHelp     :: Bool           -- ^ Just show the help
  83   , optShowVer      :: Bool           -- ^ Just show the program version
  84   , optShowComp     :: Bool           -- ^ Just show the completion info
  85   , optDaemonize    :: Bool           -- ^ Whether to daemonize or not
  86   , optPort         :: Maybe Word16   -- ^ Override for the network port
  87   , optDebug        :: Bool           -- ^ Enable debug messages
  88   , optNoUserChecks :: Bool           -- ^ Ignore user checks
  89   , optBindAddress  :: Maybe String   -- ^ Override for the bind address
  90   , optSyslogUsage  :: Maybe SyslogUsage -- ^ Override for Syslog usage
  91   }
  92
  93 -- | Default values for the command line options.
  94 defaultOptions :: DaemonOptions
  95 defaultOptions  = DaemonOptions
  96   { optShowHelp     = False
  97   , optShowVer      = False
  98   , optShowComp     = False
  99   , optDaemonize    = True
 100   , optPort         = Nothing
 101   , optDebug        = False
 102   , optNoUserChecks = False
 103   , optBindAddress  = Nothing
 104   , optSyslogUsage  = Nothing
 105   }
 106
 107 instance StandardOptions DaemonOptions where
 108   helpRequested = optShowHelp
 109   verRequested  = optShowVer
 110   compRequested = optShowComp
 111   requestHelp o = o { optShowHelp = True }
 112   requestVer  o = o { optShowVer  = True }
 113   requestComp o = o { optShowComp = True }
 114
 115 -- | Abrreviation for the option type.
 116 type OptType = GenericOptType DaemonOptions
 117
 118 -- * Command line options
 119
 120 oNoDaemonize :: OptType
 121 oNoDaemonize =
 122   (Option "f" ["foreground"]
 123    (NoArg (\ opts -> Ok opts { optDaemonize = False}))
 124    "Don't detach from the current terminal",
 125    OptComplNone)
 126
 127 oDebug :: OptType
 128 oDebug =
 129   (Option "d" ["debug"]
 130    (NoArg (\ opts -> Ok opts { optDebug = True }))
 131    "Enable debug messages",
 132    OptComplNone)
 133
 134 oNoUserChecks :: OptType
 135 oNoUserChecks =
 136   (Option "" ["no-user-checks"]
 137    (NoArg (\ opts -> Ok opts { optNoUserChecks = True }))
 138    "Ignore user checks",
 139    OptComplNone)
 140
 141 oPort :: Int -> OptType
 142 oPort def =
 143   (Option "p" ["port"]
 144    (reqWithConversion (tryRead "reading port")
 145     (\port opts -> Ok opts { optPort = Just port }) "PORT")
 146    ("Network port (default: " ++ show def ++ ")"),
 147    OptComplInteger)
 148
 149 oBindAddress :: OptType
 150 oBindAddress =
 151   (Option "b" ["bind"]
 152    (ReqArg (\addr opts -> Ok opts { optBindAddress = Just addr })
 153     "ADDR")
 154    "Bind address (default depends on cluster configuration)",
 155    OptComplInetAddr)
 156
 157 oSyslogUsage :: OptType
 158 oSyslogUsage =
 159   (Option "" ["syslog"]
 160    (reqWithConversion syslogUsageFromRaw
 161     (\su opts -> Ok opts { optSyslogUsage = Just su })
 162     "SYSLOG")
 163    ("Enable logging to syslog (except debug \
 164     \messages); one of 'no', 'yes' or 'only' [" ++ C.syslogUsage ++
 165     "]"),
 166    OptComplChoices ["yes", "no", "only"])
 167
 168 -- | Generic options.
 169 genericOpts :: [OptType]
 170 genericOpts = [ oShowHelp
 171               , oShowVer
 172               , oShowComp
 173               ]
 174
 175 -- | Small wrapper over getArgs and 'parseOpts'.
 176 parseArgs :: String -> [OptType] -> IO (DaemonOptions, [String])
 177 parseArgs cmd options = do
 178   cmd_args <- getArgs
 179   parseOpts defaultOptions cmd_args cmd (options ++ genericOpts) []
 180
 181 -- * Daemon-related functions
 182 -- | PID file mode.
 183 pidFileMode :: FileMode
 184 pidFileMode = unionFileModes ownerReadMode ownerWriteMode
 185
 186 -- | Writes a PID file and locks it.
 187 _writePidFile :: FilePath -> IO Fd
 188 _writePidFile path = do
 189   fd <- createFile path pidFileMode
 190   setLock fd (WriteLock, AbsoluteSeek, 0, 0)
 191   my_pid <- getProcessID
 192   _ <- fdWrite fd (show my_pid ++ "\n")
 193   return fd
 194
 195 -- | Helper to format an IOError.
 196 formatIOError :: String -> IOError -> String
 197 formatIOError msg err = msg ++ ": " ++  show err
 198
 199 -- | Wrapper over '_writePidFile' that transforms IO exceptions into a
 200 -- 'Bad' value.
 201 writePidFile :: FilePath -> IO (Result Fd)
 202 writePidFile path =
 203   catch (fmap Ok $ _writePidFile path)
 204     (return . Bad . formatIOError "Failure during writing of the pid file")
 205
 206 -- | Helper function to ensure a socket doesn't exist. Should only be
 207 -- called once we have locked the pid file successfully.
 208 cleanupSocket :: FilePath -> IO ()
 209 cleanupSocket socketPath =
 210   catchJust (guard . isDoesNotExistError) (removeLink socketPath)
 211             (const $ return ())
 212
 213 -- | Sets up a daemon's environment.
 214 setupDaemonEnv :: FilePath -> FileMode -> IO ()
 215 setupDaemonEnv cwd umask = do
 216   changeWorkingDirectory cwd
 217   _ <- setFileCreationMask umask
 218   _ <- createSession
 219   return ()
 220
 221 -- | Signal handler for reopening log files.
 222 handleSigHup :: FilePath -> IO ()
 223 handleSigHup path = do
 224   setupDaemonFDs (Just path)
 225   logInfo "Reopening log files after receiving SIGHUP"
 226
 227 -- | Sets up a daemon's standard file descriptors.
 228 setupDaemonFDs :: Maybe FilePath -> IO ()
 229 setupDaemonFDs logfile = do
 230   null_in_handle <- openFile devNull ReadMode
 231   null_out_handle <- openFile (fromMaybe devNull logfile) AppendMode
 232   hDuplicateTo null_in_handle stdin
 233   hDuplicateTo null_out_handle stdout
 234   hDuplicateTo null_out_handle stderr
 235   hClose null_in_handle
 236   hClose null_out_handle
 237
 238 -- | Computes the default bind address for a given family.
 239 defaultBindAddr :: Int                  -- ^ The port we want
 240                 -> Socket.Family        -- ^ The cluster IP family
 241                 -> Result (Socket.Family, Socket.SockAddr)
 242 defaultBindAddr port Socket.AF_INET =
 243   Ok (Socket.AF_INET,
 244       Socket.SockAddrInet (fromIntegral port) Socket.iNADDR_ANY)
 245 defaultBindAddr port Socket.AF_INET6 =
 246   Ok (Socket.AF_INET6,
 247       Socket.SockAddrInet6 (fromIntegral port) 0 Socket.iN6ADDR_ANY 0)
 248 defaultBindAddr _ fam = Bad $ "Unsupported address family: " ++ show fam
 249
 250 -- | Default hints for the resolver
 251 resolveAddrHints :: Maybe Socket.AddrInfo
 252 resolveAddrHints =
 253   Just Socket.defaultHints { Socket.addrFlags = [Socket.AI_NUMERICHOST,
 254                                                  Socket.AI_NUMERICSERV] }
 255
 256 -- | Resolves a numeric address.
 257 resolveAddr :: Int -> String -> IO (Result (Socket.Family, Socket.SockAddr))
 258 resolveAddr port str = do
 259   resolved <- Socket.getAddrInfo resolveAddrHints (Just str) (Just (show port))
 260   return $ case resolved of
 261              [] -> Bad "Invalid results from lookup?"
 262              best:_ -> Ok (Socket.addrFamily best, Socket.addrAddress best)
 263
 264 -- | Based on the options, compute the socket address to use for the
 265 -- daemon.
 266 parseAddress :: DaemonOptions      -- ^ Command line options
 267              -> Int                -- ^ Default port for this daemon
 268              -> IO (Result (Socket.Family, Socket.SockAddr))
 269 parseAddress opts defport = do
 270   let port = maybe defport fromIntegral $ optPort opts
 271   def_family <- Ssconf.getPrimaryIPFamily Nothing
 272   case optBindAddress opts of
 273     Nothing -> return (def_family >>= defaultBindAddr port)
 274     Just saddr -> catch (resolveAddr port saddr)
 275                   (annotateIOError $ "Invalid address " ++ saddr)
 276
 277 -- | Run an I/O action as a daemon.
 278 --
 279 -- WARNING: this only works in single-threaded mode (either using the
 280 -- single-threaded runtime, or using the multi-threaded one but with
 281 -- only one OS thread, i.e. -N1).
 282 --
 283 -- FIXME: this doesn't support error reporting and the prepfn
 284 -- functionality.
 285 daemonize :: FilePath -> IO () -> IO ()
 286 daemonize logfile action = do
 287   -- first fork
 288   _ <- forkProcess $ do
 289     -- in the child
 290     setupDaemonEnv "/" (unionFileModes groupModes otherModes)
 291     setupDaemonFDs $ Just logfile
 292     _ <- installHandler lostConnection (Catch (handleSigHup logfile)) Nothing
 293     _ <- forkProcess action
 294     exitImmediately ExitSuccess
 295   exitImmediately ExitSuccess
 296
 297 -- | Generic daemon startup.
 298 genericMain :: GanetiDaemon -> [OptType] -> (DaemonOptions -> IO ()) -> IO ()
 299 genericMain daemon options main = do
 300   let progname = daemonName daemon
 301   (opts, args) <- parseArgs progname options
 302
 303   exitUnless (null args) "This program doesn't take any arguments"
 304
 305   unless (optNoUserChecks opts) $ do
 306     runtimeEnts <- getEnts
 307     ents <- exitIfBad "Can't find required user/groups" runtimeEnts
 308     verifyDaemonUser daemon ents
 309
 310   syslog <- case optSyslogUsage opts of
 311               Nothing -> exitIfBad "Invalid cluster syslog setting" $
 312                          syslogUsageFromRaw C.syslogUsage
 313               Just v -> return v
 314   let processFn = if optDaemonize opts
 315                     then daemonize (daemonLogFile daemon)
 316                     else id
 317   processFn $ innerMain daemon opts syslog (main opts)
 318
 319 -- | Inner daemon function.
 320 --
 321 -- This is executed after daemonization.
 322 innerMain :: GanetiDaemon -> DaemonOptions -> SyslogUsage -> IO () -> IO ()
 323 innerMain daemon opts syslog main = do
 324   let logfile = if optDaemonize opts
 325                   then Nothing
 326                   else Just $ daemonLogFile daemon
 327   setupLogging logfile (daemonName daemon) (optDebug opts) True False syslog
 328   pid_fd <- writePidFile (daemonPidFile daemon)
 329   _ <- exitIfBad "Cannot write PID file; already locked? Error" pid_fd
 330   logNotice "starting"
 331   main