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