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