From 79ac58fa1be8fe2ce30f237295e19b011e80e0e9 Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Mon, 30 Apr 2012 16:53:59 -0700
Subject: [PATCH] Further fixes for new-style exception handling
Commit 30d25dd8 moved the htools code to new-style exception handling,
but the hconfd code hasn't been, which fails when compiling on newer
GHC versions.
This patch does the rest of the move; however, the situation is not
very nice, we should have a better way to handle this (introduce
catchIO? or something like that).
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Guido Trotter <ultrotter@google.com>
---
htools/Ganeti/Confd/Server.hs | 7 +++++--
htools/Ganeti/Daemon.hs | 9 ++++++++-
htools/Ganeti/Ssconf.hs | 4 +++-
3 files changed, 16 insertions(+), 4 deletions(-)
diff --git a/htools/Ganeti/Confd/Server.hs b/htools/Ganeti/Confd/Server.hs
index ffe40a989..493c8c6ad 100644
--- a/htools/Ganeti/Confd/Server.hs
+++ b/htools/Ganeti/Confd/Server.hs
@@ -30,12 +30,14 @@ module Ganeti.Confd.Server
) where
import Control.Concurrent
+import Control.Exception
import Control.Monad (forever)
import qualified Data.ByteString as B
import Data.IORef
import Data.List
import qualified Data.Map as M
import qualified Network.Socket as S
+import Prelude hiding (catch)
import System.Posix.Files
import System.Posix.Types
import System.Time
@@ -300,7 +302,8 @@ safeUpdateConfig path oldfstat cref = do
updateConfig path cref
return (nt', ConfigReloaded)
) (\e -> do
- let msg = "Failure during configuration update: " ++ show e
+ let msg = "Failure during configuration update: " ++
+ show (e::IOError)
writeIORef cref (Bad msg)
return (nullFStat, ConfigIOError)
)
@@ -416,7 +419,7 @@ addNotifier :: INotify -> FilePath -> CRef -> MVar ServerState -> IO Bool
addNotifier inotify path cref mstate = do
catch (addWatch inotify [CloseWrite] path
(onInotify inotify path cref mstate) >> return True)
- (const $ return False)
+ (\e -> const (return False) (e::IOError))
-- | Inotify event handler.
onInotify :: INotify -> String -> CRef -> MVar ServerState -> Event -> IO ()
diff --git a/htools/Ganeti/Daemon.hs b/htools/Ganeti/Daemon.hs
index e0587f8ec..42e81cc98 100644
--- a/htools/Ganeti/Daemon.hs
+++ b/htools/Ganeti/Daemon.hs
@@ -41,10 +41,12 @@ module Ganeti.Daemon
, genericMain
) where
+import Control.Exception
import Control.Monad
import qualified Data.Version
import Data.Word
import qualified Network.Socket as Socket
+import Prelude hiding (catch)
import System.Console.GetOpt
import System.Exit
import System.Environment
@@ -199,11 +201,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 ()
diff --git a/htools/Ganeti/Ssconf.hs b/htools/Ganeti/Ssconf.hs
index d3944dde2..5910cd1a3 100644
--- a/htools/Ganeti/Ssconf.hs
+++ b/htools/Ganeti/Ssconf.hs
@@ -34,12 +34,14 @@ module Ganeti.Ssconf
import Ganeti.THH
+import Control.Exception
import Control.Monad (liftM)
import Data.Char (isSpace)
import Data.Maybe (fromMaybe)
+import Prelude hiding (catch)
import qualified Network.Socket as Socket
import System.FilePath ((</>))
-import System.IO.Error
+import System.IO.Error (isDoesNotExistError)
import qualified Ganeti.Constants as C
import Ganeti.BasicTypes
--
GitLab