From 1ce11d7f13b313c06016cacdf9469d2c4cb714c4 Mon Sep 17 00:00:00 2001 From: Nikita Karetnikov Date: Thu, 22 Aug 2013 10:10:25 +0000 Subject: [PATCH 17/21] Replace 'TorDNSEL.Compat.Exception' with 'Control.Exception'. --- src/TorDNSEL/Config/Internals.hs | 4 ++-- src/TorDNSEL/Main.hsc | 46 +++++++++++++++++++------------------- 2 files changed, 25 insertions(+), 25 deletions(-) diff --git a/src/TorDNSEL/Config/Internals.hs b/src/TorDNSEL/Config/Internals.hs index 54366f3..3849997 100644 --- a/src/TorDNSEL/Config/Internals.hs +++ b/src/TorDNSEL/Config/Internals.hs @@ -49,7 +49,7 @@ import Prelude hiding (log) import Control.Arrow ((***), second) import Control.Concurrent.Chan import Control.Concurrent.MVar -import qualified TorDNSEL.Compat.Exception as E +import qualified Control.Exception as E import Control.Monad (liftM, liftM2, ap) import Control.Monad.Error (MonadError(..)) import Control.Monad.Fix (fix) @@ -435,7 +435,7 @@ startReconfigServer sock sendConfig = do handleMessage :: State -> ReconfigMessage -> IO State handleMessage s (NewClient client signal) = do - E.handleJust E.ioErrors + E.handleJust ioErrors (log Warn "Reading config from reconfigure socket failed: ") $ E.bracket (socketToHandle client ReadWriteMode) hClose $ \handle -> do str <- B.hGetContents handle diff --git a/src/TorDNSEL/Main.hsc b/src/TorDNSEL/Main.hsc index 609543f..598026e 100644 --- a/src/TorDNSEL/Main.hsc +++ b/src/TorDNSEL/Main.hsc @@ -64,7 +64,7 @@ module TorDNSEL.Main ( import Prelude hiding (log) import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan) -import qualified TorDNSEL.Compat.Exception as E +import qualified Control.Exception as E import Control.Monad (when, liftM, forM, forM_) import Control.Monad.Fix (fix) import Control.Monad.State (StateT, runStateT, liftIO, get, put) @@ -200,7 +200,7 @@ main = do `E.catch` \e -> do hCat stderr "Connecting to reconfigure socket failed: " e '\n' exitWith $ fromSysExitCode Unavailable - r <- E.handleJust E.ioErrors (\e -> do + r <- E.handleJust ioErrors (\e -> do hCat stderr "An I/O error occurred while reconfiguring: " e '\n' exitWith $ fromSysExitCode IOError) $ E.bracket (socketToHandle sock ReadWriteMode) hClose $ \handle -> do @@ -221,7 +221,7 @@ main = do conf <- exitLeft Usage $ parseConfigArgs args case B.pack "configfile" `M.lookup` conf of Just fp -> do - file <- E.catchJust E.ioErrors (B.readFile $ B.unpack fp) + file <- E.catchJust ioErrors (B.readFile $ B.unpack fp) (exitPrint NoInput . cat "Opening config file failed: ") exitLeft DataError $ makeConfig . M.union conf =<< parseConfigFile file Nothing -> exitLeft Usage $ makeConfig conf @@ -237,33 +237,33 @@ main = do euid /= 0) $ exitPrint NoPermission ("You must be root to drop privileges or chroot." ++) - ids <- E.catchJust E.ioErrors + ids <- E.catchJust ioErrors (getIDs (cfUser conf) (cfGroup conf)) (exitPrint OSFile . cat "Looking up uid/gid failed: ") - E.catchJust E.ioErrors + E.catchJust ioErrors (checkDirectory (fst ids) (cfChangeRootDirectory conf) (cfStateDirectory conf)) (exitPrint Can'tCreate . cat "Preparing state directory failed: ") - E.catchJust E.ioErrors + E.catchJust ioErrors (checkDirectory Nothing Nothing (cfRuntimeDirectory conf)) (exitPrint Can'tCreate . cat "Preparing runtime directory failed: ") - statsSock <- E.catchJust E.ioErrors + statsSock <- E.catchJust ioErrors (bindStatsSocket $ cfRuntimeDirectory conf) (exitPrint Can'tCreate . cat "Opening statistics listener failed: ") - reconfigSock <- E.catchJust E.ioErrors + reconfigSock <- E.catchJust ioErrors (bindReconfigSocket (cfRuntimeDirectory conf) (fst ids)) (exitPrint Can'tCreate . cat "Opening reconfigure listener failed: ") - pidHandle <- E.catchJust E.ioErrors + pidHandle <- E.catchJust ioErrors (flip openFile WriteMode `liftMb` cfPIDFile conf) (exitPrint Can'tCreate . cat "Opening PID file failed: ") log Notice "Opening DNS listener on " (cfDNSListenAddress conf) '.' - dnsSock <- E.catchJust E.ioErrors + dnsSock <- E.catchJust ioErrors (bindUDPSocket $ cfDNSListenAddress conf) (\e -> exitPrint (bindErrorCode e) $ cat "Opening DNS listener on " (cfDNSListenAddress conf) @@ -276,7 +276,7 @@ main = do let sockAddr = SockAddrInet (fromIntegral port) (htonl . fst $ tcfTestListenAddress testConf) log Notice "Opening exit test listener on " sockAddr '.' - sock <- E.catchJust E.ioErrors + sock <- E.catchJust ioErrors (bindListeningTCPSocket sockAddr) (\e -> exitPrint (bindErrorCode e) $ cat "Opening exit test listener on " sockAddr " failed: " e) @@ -311,7 +311,7 @@ verifyConfig args = Right conf -> case B.pack "configfile" `M.lookup` conf of Just fp -> do - file <- E.catchJust E.ioErrors (B.readFile $ B.unpack fp) $ \e -> do + file <- E.catchJust ioErrors (B.readFile $ B.unpack fp) $ \e -> do hCat stderr "Opening config file failed: " e '\n' exitWith $ fromSysExitCode NoInput check DataError $ parseConfigFile file >>= makeConfig . M.union conf @@ -374,7 +374,7 @@ handleMessage _ static conf s (Reconfigure reconf) = flip runStateT s $ do Nothing | Just configFile <- cfConfigFile conf -> do log Notice "Caught SIGHUP. Reloading config file." - r <- liftIO . E.tryJust E.ioErrors $ B.readFile configFile + r <- liftIO . E.tryJust ioErrors $ B.readFile configFile case r of Left e -> do -- If we're chrooted, it's not suprising that we can't read our @@ -615,7 +615,7 @@ reconfigureDNSListenerAndServer reconfigureDNSListenerAndServer static oldConf newConf errorRespond = do when (cfDNSListenAddress oldConf /= cfDNSListenAddress newConf) $ do log Notice "Opening DNS listener on " (cfDNSListenAddress newConf) '.' - r <- liftIO . E.tryJust E.ioErrors $ + r <- liftIO . E.tryJust ioErrors $ bindUDPSocket $ cfDNSListenAddress newConf case r of Left e -> do @@ -649,14 +649,14 @@ terminateProcess status static s mbWait = do forM_ (M.assocs $ exitTestListeners s) $ \(addr,mbSock) -> whenJust mbSock $ \sock -> do log Info "Closing exit test listener on " addr '.' - ignoreJust E.ioErrors $ sClose sock + ignoreJust ioErrors $ sClose sock log Info "Closing DNS listener." - ignoreJust E.ioErrors . sClose $ dnsListener s + ignoreJust ioErrors . sClose $ dnsListener s log Info "Closing statistics listener." - ignoreJust E.ioErrors . sClose $ statsSocket static + ignoreJust ioErrors . sClose $ statsSocket static log Info "Closing reconfigure listener." - ignoreJust E.ioErrors . sClose $ reconfigSocket static - ignoreJust E.ioErrors . hClose $ randomHandle static + ignoreJust ioErrors . sClose $ reconfigSocket static + ignoreJust ioErrors . hClose $ randomHandle static log Notice "All subsystems have terminated. Exiting now." terminateLogger mbWait closeSystemLogger @@ -732,7 +732,7 @@ setMaxOpenFiles lowerLimit cap = do unResourceLimit (ResourceLimit n) = n unResourceLimit _ = error "unResourceLimit: bug" - fmap unResourceLimit $ E.catchJust E.ioErrors + fmap unResourceLimit $ E.catchJust ioErrors (setResourceLimit ResourceOpenFiles (newLimits most) >> return most) $ \e -> do #ifdef OPEN_MAX @@ -741,9 +741,9 @@ setMaxOpenFiles lowerLimit cap = do if not (isPermissionError e) && openMax < most then do setResourceLimit ResourceOpenFiles (newLimits openMax) return openMax - else E.throwIO (E.IOException e) + else E.throwIO (E.toException e) #else - E.throwIO (E.IOException e) + E.throwIO (E.toException e) #endif instance Ord ResourceLimit where @@ -777,7 +777,7 @@ checkDirectory uid newRoot path = do -- return 'ToStdOut'. checkLogTarget :: LogTarget -> IO LogTarget checkLogTarget target@(ToFile logPath) = - E.catchJust E.ioErrors + E.catchJust ioErrors (do E.bracket (openFile logPath AppendMode) hClose (const $ return ()) return target) (const $ return ToStdOut) -- 1.7.9.5