X-Git-Url: https://code.grnet.gr/git/ganeti-local/blobdiff_plain/152e05e139cf8e8532a2e8a33cdccd6d3c2a402d..13f2321cc5e852dd2183faa1de1c5e14569a5599:/htools/Ganeti/Daemon.hs diff --git a/htools/Ganeti/Daemon.hs b/htools/Ganeti/Daemon.hs index 155afa4..c6708f1 100644 --- a/htools/Ganeti/Daemon.hs +++ b/htools/Ganeti/Daemon.hs @@ -34,16 +34,21 @@ module Ganeti.Daemon , oDebug , oPort , oBindAddress + , oSyslogUsage , parseArgs , parseAddress , writePidFile , genericMain ) where +import Control.Exception import Control.Monad +import Data.Maybe (fromMaybe) import qualified Data.Version import Data.Word +import GHC.IO.Handle (hDuplicateTo) import qualified Network.Socket as Socket +import Prelude hiding (catch) import System.Console.GetOpt import System.Exit import System.Environment @@ -54,6 +59,7 @@ import System.Posix.Files import System.Posix.IO import System.Posix.Process import System.Posix.Types +import System.Posix.Signals import Text.Printf import Ganeti.Logging @@ -64,6 +70,12 @@ import qualified Ganeti.HTools.Version as Version(version) import qualified Ganeti.Constants as C import qualified Ganeti.Ssconf as Ssconf +-- * Constants + +-- | \/dev\/null path. +devNull :: FilePath +devNull = "/dev/null" + -- * Data types -- | Command line options structure. @@ -75,6 +87,7 @@ data DaemonOptions = DaemonOptions , optDebug :: Bool -- ^ Enable debug messages , optNoUserChecks :: Bool -- ^ Ignore user checks , optBindAddress :: Maybe String -- ^ Override for the bind address + , optSyslogUsage :: Maybe SyslogUsage -- ^ Override for Syslog usage } -- | Default values for the command line options. @@ -87,6 +100,7 @@ defaultOptions = DaemonOptions , optDebug = False , optNoUserChecks = False , optBindAddress = Nothing + , optSyslogUsage = Nothing } -- | Abrreviation for the option type. @@ -142,6 +156,15 @@ oBindAddress = Option "b" ["bind"] "ADDR") "Bind address (default depends on cluster configuration)" +oSyslogUsage :: OptType +oSyslogUsage = Option "" ["syslog"] + (reqWithConversion syslogUsageFromRaw + (\su opts -> Ok opts { optSyslogUsage = Just su }) + "SYSLOG") + ("Enable logging to syslog (except debug \ + \messages); one of 'no', 'yes' or 'only' [" ++ C.syslogUsage ++ + "]") + -- | Usage info. usageHelp :: String -> [OptType] -> String usageHelp progname = @@ -159,13 +182,8 @@ parseOpts argv progname options = (opt_list, args, []) -> do parsed_opts <- - case foldM (flip id) defaultOptions opt_list of - Bad msg -> do - hPutStrLn stderr "Error while parsing command\ - \line arguments:" - hPutStrLn stderr msg - exitWith $ ExitFailure 1 - Ok val -> return val + exitIfBad "Error while parsing command line arguments" $ + foldM (flip id) defaultOptions opt_list return (parsed_opts, args) (_, _, errs) -> do hPutStrLn stderr $ "Command line error: " ++ concat errs @@ -192,11 +210,16 @@ _writePidFile path = do _ <- fdWrite fd (show my_pid ++ "\n") return fd +-- | Helper to format an IOError. +formatIOError :: String -> IOError -> String +formatIOError msg err = msg ++ ": " ++ show err + -- | Wrapper over '_writePidFile' that transforms IO exceptions into a -- 'Bad' value. writePidFile :: FilePath -> IO (Result Fd) writePidFile path = do - catch (fmap Ok $ _writePidFile path) (return . Bad . show) + catch (fmap Ok $ _writePidFile path) + (return . Bad . formatIOError "Failure during writing of the pid file") -- | Sets up a daemon's environment. setupDaemonEnv :: FilePath -> FileMode -> IO () @@ -206,6 +229,23 @@ setupDaemonEnv cwd umask = do _ <- createSession return () +-- | Signal handler for reopening log files. +handleSigHup :: FilePath -> IO () +handleSigHup path = do + setupDaemonFDs (Just path) + logInfo "Reopening log files after receiving SIGHUP" + +-- | Sets up a daemon's standard file descriptors. +setupDaemonFDs :: Maybe FilePath -> IO () +setupDaemonFDs logfile = do + null_in_handle <- openFile devNull ReadMode + null_out_handle <- openFile (fromMaybe devNull logfile) AppendMode + hDuplicateTo null_in_handle stdin + hDuplicateTo null_out_handle stdout + hDuplicateTo null_out_handle stderr + hClose null_in_handle + hClose null_out_handle + -- | Computes the default bind address for a given family. defaultBindAddr :: Int -- ^ The port we want -> Socket.Family -- ^ The cluster IP family @@ -254,12 +294,14 @@ parseAddress opts defport = do -- -- FIXME: this doesn't support error reporting and the prepfn -- functionality. -daemonize :: IO () -> IO () -daemonize action = do +daemonize :: FilePath -> IO () -> IO () +daemonize logfile action = do -- first fork _ <- forkProcess $ do -- in the child setupDaemonEnv "/" (unionFileModes groupModes otherModes) + setupDaemonFDs $ Just logfile + _ <- installHandler lostConnection (Catch (handleSigHup logfile)) Nothing _ <- forkProcess action exitImmediately ExitSuccess exitImmediately ExitSuccess @@ -279,34 +321,33 @@ genericMain daemon options main = do compilerName (Data.Version.showVersion compilerVersion) os arch :: IO () exitWith ExitSuccess - unless (null args) $ do - hPutStrLn stderr "This program doesn't take any arguments" - exitWith $ ExitFailure C.exitFailure + + exitUnless (null args) "This program doesn't take any arguments" unless (optNoUserChecks opts) $ do runtimeEnts <- getEnts - case runtimeEnts of - Bad msg -> do - hPutStrLn stderr $ "Can't find required user/groups: " ++ msg - exitWith $ ExitFailure C.exitFailure - Ok ents -> verifyDaemonUser daemon ents - - let processFn = if optDaemonize opts then daemonize else id - processFn $ innerMain daemon opts (main opts) + ents <- exitIfBad "Can't find required user/groups" runtimeEnts + verifyDaemonUser daemon ents + + syslog <- case optSyslogUsage opts of + Nothing -> exitIfBad "Invalid cluster syslog setting" $ + syslogUsageFromRaw C.syslogUsage + Just v -> return v + let processFn = if optDaemonize opts + then daemonize (daemonLogFile daemon) + else id + processFn $ innerMain daemon opts syslog (main opts) -- | Inner daemon function. -- -- This is executed after daemonization. -innerMain :: GanetiDaemon -> DaemonOptions -> IO () -> IO () -innerMain daemon opts main = do - setupLogging (daemonLogFile daemon) (daemonName daemon) (optDebug opts) - (not (optDaemonize opts)) False +innerMain :: GanetiDaemon -> DaemonOptions -> SyslogUsage -> IO () -> IO () +innerMain daemon opts syslog main = do + let logfile = if optDaemonize opts + then Nothing + else Just $ daemonLogFile daemon + setupLogging logfile (daemonName daemon) (optDebug opts) True False syslog pid_fd <- writePidFile (daemonPidFile daemon) - case pid_fd of - Bad msg -> do - hPutStrLn stderr $ "Cannot write PID file; already locked? Error: " ++ - msg - exitWith $ ExitFailure 1 - _ -> return () + _ <- exitIfBad "Cannot write PID file; already locked? Error" pid_fd logNotice "starting" main