Commit 0c28bee1 authored by Iustin Pop's avatar Iustin Pop
Browse files

Rework logging setup for Haskell daemons



This fixes a missing functionality: closing of stdout/stderr when
forking daemons. Without this, starting the daemons from the command
line seems to work, but doing it from utils.RunCmd breaks, since
without closing the standard descriptors, RunCmd never finishes.

The code is not very nice; basically what we need is an actual type
for the LogMode desired (LogConsole, LogStderr, LogFile FilePath), but
the syslog (yes/no and *only*) complicates this even more. I'll think
more on this and probably fix it in master.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarRené Nussbaumer <rn@google.com>
parent 47834a4f
......@@ -43,8 +43,10 @@ module Ganeti.Daemon
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
......@@ -67,6 +69,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.
......@@ -220,6 +228,17 @@ setupDaemonEnv cwd umask = do
_ <- createSession
return ()
-- | 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
......@@ -268,12 +287,13 @@ 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
_ <- forkProcess action
exitImmediately ExitSuccess
exitImmediately ExitSuccess
......@@ -305,7 +325,9 @@ genericMain daemon options main = do
Nothing -> exitIfBad "Invalid cluster syslog setting" $
syslogUsageFromRaw C.syslogUsage
Just v -> return v
let processFn = if optDaemonize opts then daemonize else id
let processFn = if optDaemonize opts
then daemonize (daemonLogFile daemon)
else id
processFn $ innerMain daemon opts syslog (main opts)
-- | Inner daemon function.
......@@ -313,8 +335,10 @@ genericMain daemon options main = do
-- This is executed after daemonization.
innerMain :: GanetiDaemon -> DaemonOptions -> SyslogUsage -> IO () -> IO ()
innerMain daemon opts syslog main = do
setupLogging (daemonLogFile daemon) (daemonName daemon) (optDebug opts)
(not (optDaemonize opts)) False syslog
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)
_ <- exitIfBad "Cannot write PID file; already locked? Error" pid_fd
logNotice "starting"
......
......@@ -89,7 +89,7 @@ openFormattedHandler True fmt opener = do
return [setFormatter handler fmt]
-- | Sets up the logging configuration.
setupLogging :: String -- ^ Log file
setupLogging :: Maybe String -- ^ Log file
-> String -- ^ Program name
-> Bool -- ^ Debug level
-> Bool -- ^ Log to stderr
......@@ -98,16 +98,19 @@ setupLogging :: String -- ^ Log file
-> IO ()
setupLogging logf program debug stderr_logging console syslog = do
let level = if debug then DEBUG else INFO
destf = if console then C.devConsole else logf
destf = if console then Just C.devConsole else logf
fmt = logFormatter program False False
file_logging = syslog /= SyslogOnly
updateGlobalLogger rootLoggerName (setLevel level)
stderr_handlers <- openFormattedHandler stderr_logging fmt $
streamHandler stderr level
file_handlers <- openFormattedHandler (syslog /= SyslogOnly) fmt $
fileHandler destf level
file_handlers <- case destf of
Nothing -> return []
Just path -> openFormattedHandler file_logging fmt $
fileHandler path level
let handlers = concat [file_handlers, stderr_handlers]
updateGlobalLogger rootLoggerName $ setHandlers handlers
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment