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.HTools.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   , 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 instance StandardOptions DaemonOptions where
 106   helpRequested = optShowHelp
 107   verRequested  = optShowVer
 108   requestHelp o = o { optShowHelp = True }
 109   requestVer  o = o { optShowVer  = True }
 110
 111 -- | Abrreviation for the option type.
 112 type OptType = GenericOptType DaemonOptions
 113
 114 -- * Command line options
 115
 116 oNoDaemonize :: OptType
 117 oNoDaemonize = Option "f" ["foreground"]
 118                (NoArg (\ opts -> Ok opts { optDaemonize = False}))
 119                "Don't detach from the current terminal"
 120
 121 oDebug :: OptType
 122 oDebug = Option "d" ["debug"]
 123          (NoArg (\ opts -> Ok opts { optDebug = True }))
 124          "Enable debug messages"
 125
 126 oNoUserChecks :: OptType
 127 oNoUserChecks = Option "" ["no-user-checks"]
 128          (NoArg (\ opts -> Ok opts { optNoUserChecks = True }))
 129          "Ignore user checks"
 130
 131 oPort :: Int -> OptType
 132 oPort def = Option "p" ["port"]
 133             (reqWithConversion (tryRead "reading port")
 134              (\port opts -> Ok opts { optPort = Just port }) "PORT")
 135             ("Network port (default: " ++ show def ++ ")")
 136
 137 oBindAddress :: OptType
 138 oBindAddress = Option "b" ["bind"]
 139                (ReqArg (\addr opts -> Ok opts { optBindAddress = Just addr })
 140                 "ADDR")
 141                "Bind address (default depends on cluster configuration)"
 142
 143 oSyslogUsage :: OptType
 144 oSyslogUsage = Option "" ["syslog"]
 145                (reqWithConversion syslogUsageFromRaw
 146                 (\su opts -> Ok opts { optSyslogUsage = Just su })
 147                 "SYSLOG")
 148                ("Enable logging to syslog (except debug \
 149                 \messages); one of 'no', 'yes' or 'only' [" ++ C.syslogUsage ++
 150                 "]")
 151
 152 -- | Generic options.
 153 genericOpts :: [OptType]
 154 genericOpts = [ oShowHelp
 155               , oShowVer
 156               ]
 157
 158 -- | Small wrapper over getArgs and 'parseOpts'.
 159 parseArgs :: String -> [OptType] -> IO (DaemonOptions, [String])
 160 parseArgs cmd options = do
 161   cmd_args <- getArgs
 162   parseOpts defaultOptions cmd_args cmd $ options ++ genericOpts
 163
 164 -- * Daemon-related functions
 165 -- | PID file mode.
 166 pidFileMode :: FileMode
 167 pidFileMode = unionFileModes ownerReadMode ownerWriteMode
 168
 169 -- | Writes a PID file and locks it.
 170 _writePidFile :: FilePath -> IO Fd
 171 _writePidFile path = do
 172   fd <- createFile path pidFileMode
 173   setLock fd (WriteLock, AbsoluteSeek, 0, 0)
 174   my_pid <- getProcessID
 175   _ <- fdWrite fd (show my_pid ++ "\n")
 176   return fd
 177
 178 -- | Helper to format an IOError.
 179 formatIOError :: String -> IOError -> String
 180 formatIOError msg err = msg ++ ": " ++  show err
 181
 182 -- | Wrapper over '_writePidFile' that transforms IO exceptions into a
 183 -- 'Bad' value.
 184 writePidFile :: FilePath -> IO (Result Fd)
 185 writePidFile path =
 186   catch (fmap Ok $ _writePidFile path)
 187     (return . Bad . formatIOError "Failure during writing of the pid file")
 188
 189 -- | Helper function to ensure a socket doesn't exist. Should only be
 190 -- called once we have locked the pid file successfully.
 191 cleanupSocket :: FilePath -> IO ()
 192 cleanupSocket socketPath =
 193   catchJust (guard . isDoesNotExistError) (removeLink socketPath)
 194             (const $ return ())
 195
 196 -- | Sets up a daemon's environment.
 197 setupDaemonEnv :: FilePath -> FileMode -> IO ()
 198 setupDaemonEnv cwd umask = do
 199   changeWorkingDirectory cwd
 200   _ <- setFileCreationMask umask
 201   _ <- createSession
 202   return ()
 203
 204 -- | Signal handler for reopening log files.
 205 handleSigHup :: FilePath -> IO ()
 206 handleSigHup path = do
 207   setupDaemonFDs (Just path)
 208   logInfo "Reopening log files after receiving SIGHUP"
 209
 210 -- | Sets up a daemon's standard file descriptors.
 211 setupDaemonFDs :: Maybe FilePath -> IO ()
 212 setupDaemonFDs logfile = do
 213   null_in_handle <- openFile devNull ReadMode
 214   null_out_handle <- openFile (fromMaybe devNull logfile) AppendMode
 215   hDuplicateTo null_in_handle stdin
 216   hDuplicateTo null_out_handle stdout
 217   hDuplicateTo null_out_handle stderr
 218   hClose null_in_handle
 219   hClose null_out_handle
 220
 221 -- | Computes the default bind address for a given family.
 222 defaultBindAddr :: Int                  -- ^ The port we want
 223                 -> Socket.Family        -- ^ The cluster IP family
 224                 -> Result (Socket.Family, Socket.SockAddr)
 225 defaultBindAddr port Socket.AF_INET =
 226   Ok (Socket.AF_INET,
 227       Socket.SockAddrInet (fromIntegral port) Socket.iNADDR_ANY)
 228 defaultBindAddr port Socket.AF_INET6 =
 229   Ok (Socket.AF_INET6,
 230       Socket.SockAddrInet6 (fromIntegral port) 0 Socket.iN6ADDR_ANY 0)
 231 defaultBindAddr _ fam = Bad $ "Unsupported address family: " ++ show fam
 232
 233 -- | Default hints for the resolver
 234 resolveAddrHints :: Maybe Socket.AddrInfo
 235 resolveAddrHints =
 236   Just Socket.defaultHints { Socket.addrFlags = [Socket.AI_NUMERICHOST,
 237                                                  Socket.AI_NUMERICSERV] }
 238
 239 -- | Resolves a numeric address.
 240 resolveAddr :: Int -> String -> IO (Result (Socket.Family, Socket.SockAddr))
 241 resolveAddr port str = do
 242   resolved <- Socket.getAddrInfo resolveAddrHints (Just str) (Just (show port))
 243   return $ case resolved of
 244              [] -> Bad "Invalid results from lookup?"
 245              best:_ -> Ok (Socket.addrFamily best, Socket.addrAddress best)
 246
 247 -- | Based on the options, compute the socket address to use for the
 248 -- daemon.
 249 parseAddress :: DaemonOptions      -- ^ Command line options
 250              -> Int                -- ^ Default port for this daemon
 251              -> IO (Result (Socket.Family, Socket.SockAddr))
 252 parseAddress opts defport = do
 253   let port = maybe defport fromIntegral $ optPort opts
 254   def_family <- Ssconf.getPrimaryIPFamily Nothing
 255   case optBindAddress opts of
 256     Nothing -> return (def_family >>= defaultBindAddr port)
 257     Just saddr -> catch (resolveAddr port saddr)
 258                   (annotateIOError $ "Invalid address " ++ saddr)
 259
 260 -- | Run an I/O action as a daemon.
 261 --
 262 -- WARNING: this only works in single-threaded mode (either using the
 263 -- single-threaded runtime, or using the multi-threaded one but with
 264 -- only one OS thread, i.e. -N1).
 265 --
 266 -- FIXME: this doesn't support error reporting and the prepfn
 267 -- functionality.
 268 daemonize :: FilePath -> IO () -> IO ()
 269 daemonize logfile action = do
 270   -- first fork
 271   _ <- forkProcess $ do
 272     -- in the child
 273     setupDaemonEnv "/" (unionFileModes groupModes otherModes)
 274     setupDaemonFDs $ Just logfile
 275     _ <- installHandler lostConnection (Catch (handleSigHup logfile)) Nothing
 276     _ <- forkProcess action
 277     exitImmediately ExitSuccess
 278   exitImmediately ExitSuccess
 279
 280 -- | Generic daemon startup.
 281 genericMain :: GanetiDaemon -> [OptType] -> (DaemonOptions -> IO ()) -> IO ()
 282 genericMain daemon options main = do
 283   let progname = daemonName daemon
 284   (opts, args) <- parseArgs progname options
 285
 286   exitUnless (null args) "This program doesn't take any arguments"
 287
 288   unless (optNoUserChecks opts) $ do
 289     runtimeEnts <- getEnts
 290     ents <- exitIfBad "Can't find required user/groups" runtimeEnts
 291     verifyDaemonUser daemon ents
 292
 293   syslog <- case optSyslogUsage opts of
 294               Nothing -> exitIfBad "Invalid cluster syslog setting" $
 295                          syslogUsageFromRaw C.syslogUsage
 296               Just v -> return v
 297   let processFn = if optDaemonize opts
 298                     then daemonize (daemonLogFile daemon)
 299                     else id
 300   processFn $ innerMain daemon opts syslog (main opts)
 301
 302 -- | Inner daemon function.
 303 --
 304 -- This is executed after daemonization.
 305 innerMain :: GanetiDaemon -> DaemonOptions -> SyslogUsage -> IO () -> IO ()
 306 innerMain daemon opts syslog main = do
 307   let logfile = if optDaemonize opts
 308                   then Nothing
 309                   else Just $ daemonLogFile daemon
 310   setupLogging logfile (daemonName daemon) (optDebug opts) True False syslog
 311   pid_fd <- writePidFile (daemonPidFile daemon)
 312   _ <- exitIfBad "Cannot write PID file; already locked? Error" pid_fd
 313   logNotice "starting"
 314   main