Commit 79ac58fa authored by Iustin Pop's avatar Iustin Pop
Browse files

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: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarGuido Trotter <ultrotter@google.com>
parent 4023aa72
...@@ -30,12 +30,14 @@ module Ganeti.Confd.Server ...@@ -30,12 +30,14 @@ module Ganeti.Confd.Server
) where ) where
import Control.Concurrent import Control.Concurrent
import Control.Exception
import Control.Monad (forever) import Control.Monad (forever)
import qualified Data.ByteString as B import qualified Data.ByteString as B
import Data.IORef import Data.IORef
import Data.List import Data.List
import qualified Data.Map as M import qualified Data.Map as M
import qualified Network.Socket as S import qualified Network.Socket as S
import Prelude hiding (catch)
import System.Posix.Files import System.Posix.Files
import System.Posix.Types import System.Posix.Types
import System.Time import System.Time
...@@ -300,7 +302,8 @@ safeUpdateConfig path oldfstat cref = do ...@@ -300,7 +302,8 @@ safeUpdateConfig path oldfstat cref = do
updateConfig path cref updateConfig path cref
return (nt', ConfigReloaded) return (nt', ConfigReloaded)
) (\e -> do ) (\e -> do
let msg = "Failure during configuration update: " ++ show e let msg = "Failure during configuration update: " ++
show (e::IOError)
writeIORef cref (Bad msg) writeIORef cref (Bad msg)
return (nullFStat, ConfigIOError) return (nullFStat, ConfigIOError)
) )
...@@ -416,7 +419,7 @@ addNotifier :: INotify -> FilePath -> CRef -> MVar ServerState -> IO Bool ...@@ -416,7 +419,7 @@ addNotifier :: INotify -> FilePath -> CRef -> MVar ServerState -> IO Bool
addNotifier inotify path cref mstate = do addNotifier inotify path cref mstate = do
catch (addWatch inotify [CloseWrite] path catch (addWatch inotify [CloseWrite] path
(onInotify inotify path cref mstate) >> return True) (onInotify inotify path cref mstate) >> return True)
(const $ return False) (\e -> const (return False) (e::IOError))
-- | Inotify event handler. -- | Inotify event handler.
onInotify :: INotify -> String -> CRef -> MVar ServerState -> Event -> IO () onInotify :: INotify -> String -> CRef -> MVar ServerState -> Event -> IO ()
......
...@@ -41,10 +41,12 @@ module Ganeti.Daemon ...@@ -41,10 +41,12 @@ module Ganeti.Daemon
, genericMain , genericMain
) where ) where
import Control.Exception
import Control.Monad import Control.Monad
import qualified Data.Version import qualified Data.Version
import Data.Word import Data.Word
import qualified Network.Socket as Socket import qualified Network.Socket as Socket
import Prelude hiding (catch)
import System.Console.GetOpt import System.Console.GetOpt
import System.Exit import System.Exit
import System.Environment import System.Environment
...@@ -199,11 +201,16 @@ _writePidFile path = do ...@@ -199,11 +201,16 @@ _writePidFile path = do
_ <- fdWrite fd (show my_pid ++ "\n") _ <- fdWrite fd (show my_pid ++ "\n")
return fd 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 -- | Wrapper over '_writePidFile' that transforms IO exceptions into a
-- 'Bad' value. -- 'Bad' value.
writePidFile :: FilePath -> IO (Result Fd) writePidFile :: FilePath -> IO (Result Fd)
writePidFile path = do 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. -- | Sets up a daemon's environment.
setupDaemonEnv :: FilePath -> FileMode -> IO () setupDaemonEnv :: FilePath -> FileMode -> IO ()
......
...@@ -34,12 +34,14 @@ module Ganeti.Ssconf ...@@ -34,12 +34,14 @@ module Ganeti.Ssconf
import Ganeti.THH import Ganeti.THH
import Control.Exception
import Control.Monad (liftM) import Control.Monad (liftM)
import Data.Char (isSpace) import Data.Char (isSpace)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Prelude hiding (catch)
import qualified Network.Socket as Socket import qualified Network.Socket as Socket
import System.FilePath ((</>)) import System.FilePath ((</>))
import System.IO.Error import System.IO.Error (isDoesNotExistError)
import qualified Ganeti.Constants as C import qualified Ganeti.Constants as C
import Ganeti.BasicTypes import Ganeti.BasicTypes
......
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