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   , writePidFile
  41   , genericMain
  42   ) where
  43
  44 import Control.Exception
  45 import Control.Monad
  46 import Data.Maybe (fromMaybe)
  47 import qualified Data.Version
  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.Info
  56 import System.IO
  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 import Text.Printf
  64
  65 import Ganeti.Logging
  66 import Ganeti.Runtime
  67 import Ganeti.BasicTypes
  68 import Ganeti.HTools.Utils
  69 import qualified Ganeti.HTools.Version as Version(version)
  70 import qualified Ganeti.Constants as C
  71 import qualified Ganeti.Ssconf as Ssconf
  72
  73 -- * Constants
  74
  75 -- | \/dev\/null path.
  76 devNull :: FilePath
  77 devNull = "/dev/null"
  78
  79 -- * Data types
  80
  81 -- | Command line options structure.
  82 data DaemonOptions = DaemonOptions
  83   { optShowHelp     :: Bool           -- ^ Just show the help
  84   , optShowVer      :: Bool           -- ^ Just show the program version
  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   , optDaemonize    = True
  99   , optPort         = Nothing
 100   , optDebug        = False
 101   , optNoUserChecks = False
 102   , optBindAddress  = Nothing
 103   , optSyslogUsage  = Nothing
 104   }
 105
 106 -- | Abrreviation for the option type.
 107 type OptType = OptDescr (DaemonOptions -> Result DaemonOptions)
 108
 109 -- | Helper function for required arguments which need to be converted
 110 -- as opposed to stored just as string.
 111 reqWithConversion :: (String -> Result a)
 112                   -> (a -> DaemonOptions -> Result DaemonOptions)
 113                   -> String
 114                   -> ArgDescr (DaemonOptions -> Result DaemonOptions)
 115 reqWithConversion conversion_fn updater_fn metavar =
 116   ReqArg (\string_opt opts -> do
 117             parsed_value <- conversion_fn string_opt
 118             updater_fn parsed_value opts) metavar
 119
 120 -- * Command line options
 121
 122 oShowHelp :: OptType
 123 oShowHelp = Option "h" ["help"]
 124             (NoArg (\ opts -> Ok opts { optShowHelp = True}))
 125             "Show the help message and exit"
 126
 127 oShowVer :: OptType
 128 oShowVer = Option "V" ["version"]
 129            (NoArg (\ opts -> Ok opts { optShowVer = True}))
 130            "Show the version of the program and exit"
 131
 132 oNoDaemonize :: OptType
 133 oNoDaemonize = Option "f" ["foreground"]
 134                (NoArg (\ opts -> Ok opts { optDaemonize = False}))
 135                "Don't detach from the current terminal"
 136
 137 oDebug :: OptType
 138 oDebug = Option "d" ["debug"]
 139          (NoArg (\ opts -> Ok opts { optDebug = True }))
 140          "Enable debug messages"
 141
 142 oNoUserChecks :: OptType
 143 oNoUserChecks = Option "" ["no-user-checks"]
 144          (NoArg (\ opts -> Ok opts { optNoUserChecks = True }))
 145          "Ignore user checks"
 146
 147 oPort :: Int -> OptType
 148 oPort def = Option "p" ["port"]
 149             (reqWithConversion (tryRead "reading port")
 150              (\port opts -> Ok opts { optPort = Just port }) "PORT")
 151             ("Network port (default: " ++ show def ++ ")")
 152
 153 oBindAddress :: OptType
 154 oBindAddress = Option "b" ["bind"]
 155                (ReqArg (\addr opts -> Ok opts { optBindAddress = Just addr })
 156                 "ADDR")
 157                "Bind address (default depends on cluster configuration)"
 158
 159 oSyslogUsage :: OptType
 160 oSyslogUsage = Option "" ["syslog"]
 161                (reqWithConversion syslogUsageFromRaw
 162                 (\su opts -> Ok opts { optSyslogUsage = Just su })
 163                 "SYSLOG")
 164                ("Enable logging to syslog (except debug \
 165                 \messages); one of 'no', 'yes' or 'only' [" ++ C.syslogUsage ++
 166                 "]")
 167
 168 -- | Usage info.
 169 usageHelp :: String -> [OptType] -> String
 170 usageHelp progname =
 171   usageInfo (printf "%s %s\nUsage: %s [OPTION...]"
 172              progname Version.version progname)
 173
 174 -- | Command line parser, using the 'Options' structure.
 175 parseOpts :: [String]               -- ^ The command line arguments
 176           -> String                 -- ^ The program name
 177           -> [OptType]              -- ^ The supported command line options
 178           -> IO (DaemonOptions, [String]) -- ^ The resulting options
 179                                           -- and leftover arguments
 180 parseOpts argv progname options =
 181   case getOpt Permute options argv of
 182     (opt_list, args, []) ->
 183       do
 184         parsed_opts <-
 185           exitIfBad "Error while parsing command line arguments" $
 186           foldM (flip id) defaultOptions opt_list
 187         return (parsed_opts, args)
 188     (_, _, errs) -> do
 189       hPutStrLn stderr $ "Command line error: "  ++ concat errs
 190       hPutStrLn stderr $ usageHelp progname options
 191       exitWith $ ExitFailure 2
 192
 193 -- | Small wrapper over getArgs and 'parseOpts'.
 194 parseArgs :: String -> [OptType] -> IO (DaemonOptions, [String])
 195 parseArgs cmd options = do
 196   cmd_args <- getArgs
 197   parseOpts cmd_args cmd options
 198
 199 -- * Daemon-related functions
 200 -- | PID file mode.
 201 pidFileMode :: FileMode
 202 pidFileMode = unionFileModes ownerReadMode ownerWriteMode
 203
 204 -- | Writes a PID file and locks it.
 205 _writePidFile :: FilePath -> IO Fd
 206 _writePidFile path = do
 207   fd <- createFile path pidFileMode
 208   setLock fd (WriteLock, AbsoluteSeek, 0, 0)
 209   my_pid <- getProcessID
 210   _ <- fdWrite fd (show my_pid ++ "\n")
 211   return fd
 212
 213 -- | Helper to format an IOError.
 214 formatIOError :: String -> IOError -> String
 215 formatIOError msg err = msg ++ ": " ++  show err
 216
 217 -- | Wrapper over '_writePidFile' that transforms IO exceptions into a
 218 -- 'Bad' value.
 219 writePidFile :: FilePath -> IO (Result Fd)
 220 writePidFile path = do
 221   catch (fmap Ok $ _writePidFile path)
 222     (return . Bad . formatIOError "Failure during writing of the pid file")
 223
 224 -- | Sets up a daemon's environment.
 225 setupDaemonEnv :: FilePath -> FileMode -> IO ()
 226 setupDaemonEnv cwd umask = do
 227   changeWorkingDirectory cwd
 228   _ <- setFileCreationMask umask
 229   _ <- createSession
 230   return ()
 231
 232 -- | Signal handler for reopening log files.
 233 handleSigHup :: FilePath -> IO ()
 234 handleSigHup path = do
 235   setupDaemonFDs (Just path)
 236   logInfo "Reopening log files after receiving SIGHUP"
 237
 238 -- | Sets up a daemon's standard file descriptors.
 239 setupDaemonFDs :: Maybe FilePath -> IO ()
 240 setupDaemonFDs logfile = do
 241   null_in_handle <- openFile devNull ReadMode
 242   null_out_handle <- openFile (fromMaybe devNull logfile) AppendMode
 243   hDuplicateTo null_in_handle stdin
 244   hDuplicateTo null_out_handle stdout
 245   hDuplicateTo null_out_handle stderr
 246   hClose null_in_handle
 247   hClose null_out_handle
 248
 249 -- | Computes the default bind address for a given family.
 250 defaultBindAddr :: Int                  -- ^ The port we want
 251                 -> Socket.Family        -- ^ The cluster IP family
 252                 -> Result (Socket.Family, Socket.SockAddr)
 253 defaultBindAddr port Socket.AF_INET =
 254   Ok $ (Socket.AF_INET,
 255         Socket.SockAddrInet (fromIntegral port) Socket.iNADDR_ANY)
 256 defaultBindAddr port Socket.AF_INET6 =
 257   Ok $ (Socket.AF_INET6,
 258         Socket.SockAddrInet6 (fromIntegral port) 0 Socket.iN6ADDR_ANY 0)
 259 defaultBindAddr _ fam = Bad $ "Unsupported address family: " ++ show fam
 260
 261 -- | Default hints for the resolver
 262 resolveAddrHints :: Maybe Socket.AddrInfo
 263 resolveAddrHints =
 264   Just Socket.defaultHints { Socket.addrFlags = [Socket.AI_NUMERICHOST,
 265                                                  Socket.AI_NUMERICSERV] }
 266
 267 -- | Resolves a numeric address.
 268 resolveAddr :: Int -> String -> IO (Result (Socket.Family, Socket.SockAddr))
 269 resolveAddr port str = do
 270   resolved <- Socket.getAddrInfo resolveAddrHints (Just str) (Just (show port))
 271   return $ case resolved of
 272              [] -> Bad "Invalid results from lookup?"
 273              best:_ -> Ok $ (Socket.addrFamily best, Socket.addrAddress best)
 274
 275 -- | Based on the options, compute the socket address to use for the
 276 -- daemon.
 277 parseAddress :: DaemonOptions      -- ^ Command line options
 278              -> Int                -- ^ Default port for this daemon
 279              -> IO (Result (Socket.Family, Socket.SockAddr))
 280 parseAddress opts defport = do
 281   let port = maybe defport fromIntegral $ optPort opts
 282   def_family <- Ssconf.getPrimaryIPFamily Nothing
 283   ainfo <- case optBindAddress opts of
 284              Nothing -> return (def_family >>= defaultBindAddr port)
 285              Just saddr -> catch (resolveAddr port saddr)
 286                            (annotateIOError $ "Invalid address " ++ saddr)
 287   return ainfo
 288
 289 -- | Run an I/O action as a daemon.
 290 --
 291 -- WARNING: this only works in single-threaded mode (either using the
 292 -- single-threaded runtime, or using the multi-threaded one but with
 293 -- only one OS thread, i.e. -N1).
 294 --
 295 -- FIXME: this doesn't support error reporting and the prepfn
 296 -- functionality.
 297 daemonize :: FilePath -> IO () -> IO ()
 298 daemonize logfile action = do
 299   -- first fork
 300   _ <- forkProcess $ do
 301     -- in the child
 302     setupDaemonEnv "/" (unionFileModes groupModes otherModes)
 303     setupDaemonFDs $ Just logfile
 304     _ <- installHandler lostConnection (Catch (handleSigHup logfile)) Nothing
 305     _ <- forkProcess action
 306     exitImmediately ExitSuccess
 307   exitImmediately ExitSuccess
 308
 309 -- | Generic daemon startup.
 310 genericMain :: GanetiDaemon -> [OptType] -> (DaemonOptions -> IO ()) -> IO ()
 311 genericMain daemon options main = do
 312   let progname = daemonName daemon
 313   (opts, args) <- parseArgs progname options
 314
 315   when (optShowHelp opts) $ do
 316     putStr $ usageHelp progname options
 317     exitWith ExitSuccess
 318   when (optShowVer opts) $ do
 319     printf "%s %s\ncompiled with %s %s\nrunning on %s %s\n"
 320            progname Version.version
 321            compilerName (Data.Version.showVersion compilerVersion)
 322            os arch :: IO ()
 323     exitWith ExitSuccess
 324
 325   exitUnless (null args) "This program doesn't take any arguments"
 326
 327   unless (optNoUserChecks opts) $ do
 328     runtimeEnts <- getEnts
 329     ents <- exitIfBad "Can't find required user/groups" runtimeEnts
 330     verifyDaemonUser daemon ents
 331
 332   syslog <- case optSyslogUsage opts of
 333               Nothing -> exitIfBad "Invalid cluster syslog setting" $
 334                          syslogUsageFromRaw C.syslogUsage
 335               Just v -> return v
 336   let processFn = if optDaemonize opts
 337                     then daemonize (daemonLogFile daemon)
 338                     else id
 339   processFn $ innerMain daemon opts syslog (main opts)
 340
 341 -- | Inner daemon function.
 342 --
 343 -- This is executed after daemonization.
 344 innerMain :: GanetiDaemon -> DaemonOptions -> SyslogUsage -> IO () -> IO ()
 345 innerMain daemon opts syslog main = do
 346   let logfile = if optDaemonize opts
 347                   then Nothing
 348                   else Just $ daemonLogFile daemon
 349   setupLogging logfile (daemonName daemon) (optDebug opts) True False syslog
 350   pid_fd <- writePidFile (daemonPidFile daemon)
 351   _ <- exitIfBad "Cannot write PID file; already locked? Error" pid_fd
 352   logNotice "starting"
 353   main