From 0c28bee1358ba512275d6608eed9680d87f7b68c Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Fri, 25 May 2012 17:40:53 +0200
Subject: [PATCH] Rework logging setup for Haskell daemons
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
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: Iustin Pop <iustin@google.com>
Reviewed-by: RenΓ© Nussbaumer <rn@google.com>
---
htools/Ganeti/Daemon.hs | 34 +++++++++++++++++++++++++++++-----
htools/Ganeti/Logging.hs | 11 +++++++----
2 files changed, 36 insertions(+), 9 deletions(-)
diff --git a/htools/Ganeti/Daemon.hs b/htools/Ganeti/Daemon.hs
index 42e81cc98..1d0e3d415 100644
--- a/htools/Ganeti/Daemon.hs
+++ b/htools/Ganeti/Daemon.hs
@@ -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"
diff --git a/htools/Ganeti/Logging.hs b/htools/Ganeti/Logging.hs
index 371ec61b9..c71775730 100644
--- a/htools/Ganeti/Logging.hs
+++ b/htools/Ganeti/Logging.hs
@@ -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
--
GitLab