From e14b84e9ff1c5e207d1c6f1f10044ab3583d9377 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Tue, 6 Nov 2012 14:53:45 +0100
Subject: [PATCH] Switch writing of PID file to new reporting style
Currently, the writing of the PID file uses a "standard" error
reporting: catch exception, transform it into a 'Result' type, leave
handling of that to the caller. However, for daemon startup, we
actually want exceptions to be propagated up until the handler which
will write the details to the pipe.
This patch removes the writePidFile wrapper (and stops exporting it),
and changes the code to simply annotate better the I/O error.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Michael Hanselmann <hansmi@google.com>
---
htools/Ganeti/Daemon.hs | 33 ++++++++++++++-------------------
1 file changed, 14 insertions(+), 19 deletions(-)
diff --git a/htools/Ganeti/Daemon.hs b/htools/Ganeti/Daemon.hs
index 51f08059a..f87e49c5c 100644
--- a/htools/Ganeti/Daemon.hs
+++ b/htools/Ganeti/Daemon.hs
@@ -41,7 +41,7 @@ module Ganeti.Daemon
, parseArgs
, parseAddress
, cleanupSocket
- , writePidFile
+ , describeError
, genericMain
) where
@@ -55,7 +55,7 @@ import System.Console.GetOpt
import System.Exit
import System.Environment
import System.IO
-import System.IO.Error (isDoesNotExistError)
+import System.IO.Error (isDoesNotExistError, modifyIOError, annotateIOError)
import System.Posix.Directory
import System.Posix.Files
import System.Posix.IO
@@ -206,26 +206,14 @@ pidFileMode :: FileMode
pidFileMode = unionFileModes ownerReadMode ownerWriteMode
-- | Writes a PID file and locks it.
-_writePidFile :: FilePath -> IO Fd
-_writePidFile path = do
+writePidFile :: FilePath -> IO Fd
+writePidFile path = do
fd <- createFile path pidFileMode
setLock fd (WriteLock, AbsoluteSeek, 0, 0)
my_pid <- getProcessID
_ <- 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 =
- Control.Exception.catch
- (fmap Ok $ _writePidFile path)
- (return . Bad . formatIOError "Failure during writing of the pid file")
-
-- | Helper function to ensure a socket doesn't exist. Should only be
-- called once we have locked the pid file successfully.
cleanupSocket :: FilePath -> IO ()
@@ -298,7 +286,13 @@ parseAddress opts defport = do
(resolveAddr port saddr)
(ioErrorToResult $ "Invalid address " ++ saddr)
--- | Run an I/O action as a daemon.
+-- | Run an I\/O action that might throw an I\/O error, under a
+-- handler that will simply annotate and re-throw the exception.
+describeError :: String -> Maybe Handle -> Maybe FilePath -> IO a -> IO a
+describeError descr hndl fpath =
+ modifyIOError (\e -> annotateIOError e descr hndl fpath)
+
+-- | Run an I\/O action as a daemon.
--
-- WARNING: this only works in single-threaded mode (either using the
-- single-threaded runtime, or using the multi-threaded one but with
@@ -376,9 +370,10 @@ fullPrep daemon opts syslog check_result prep_fn = do
let logfile = if optDaemonize opts
then Nothing
else Just $ daemonLogFile daemon
+ pidfile = daemonPidFile 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
+ _ <- describeError "writing PID file; already locked?"
+ Nothing (Just pidfile) $ writePidFile pidfile
logNotice "starting"
prep_fn opts check_result
--
GitLab