module Lambdabot.Signals where
#ifdef mingw32_HOST_OS
import Data.Typeable
import Control.Monad.Error
type Signal = String
newtype SignalException = SignalException Signal deriving Typeable
ircSignalMessage :: Signal -> [Char]
ircSignalMessage s = s
withIrcSignalCatch :: (MonadError e m,MonadIO m) => m () -> m ()
withIrcSignalCatch m = m
#else
import Lambdabot.Error
import Lambdabot.Util
import Data.Typeable
import Control.Concurrent (myThreadId, newEmptyMVar, putMVar, MVar, ThreadId)
import Control.OldException (throwDynTo)
import Control.Monad.Error
import System.IO.Unsafe
import System.Posix.Signals
newtype SignalException = SignalException Signal deriving Typeable
withHandler :: (MonadIO m,MonadError e m) => Signal -> Handler -> m () -> m ()
withHandler s h m
= bracketError (io (installHandler s h Nothing))
(io . flip (installHandler s) Nothing)
(const m)
withHandlerList :: (MonadError e m,MonadIO m)
=> [Signal] -> (Signal -> Handler) -> m () -> m ()
withHandlerList sl h m = foldr (withHandler `ap` h) m sl
ircSignalsToCatch :: [Signal]
ircSignalsToCatch = [
busError,
segmentationViolation,
keyboardSignal,
softwareTermination,
keyboardTermination,
lostConnection,
internalAbort
]
ircSignalMessage :: Signal -> [Char]
ircSignalMessage s
| s==busError = "SIGBUS"
| s==segmentationViolation = "SIGSEGV"
| s==keyboardSignal = "SIGINT"
| s==softwareTermination = "SIGTERM"
| s==keyboardTermination = "SIGQUIT"
| s==lostConnection = "SIGHUP"
| s==internalAbort = "SIGABRT"
| otherwise = "killed by unknown signal"
ircSignalHandler :: ThreadId -> Signal -> Handler
ircSignalHandler threadid s
= CatchOnce $ do
putMVar catchLock ()
releaseSignals
throwDynTo threadid $ SignalException s
releaseSignals :: IO ()
releaseSignals =
flip mapM_ ircSignalsToCatch
(\sig -> installHandler sig Default Nothing)
catchLock :: MVar ()
catchLock = unsafePerformIO newEmptyMVar
withIrcSignalCatch :: (MonadError e m,MonadIO m) => m () -> m ()
withIrcSignalCatch m = do
io $ installHandler sigPIPE Ignore Nothing
io $ installHandler sigALRM Ignore Nothing
threadid <- io myThreadId
withHandlerList ircSignalsToCatch (ircSignalHandler threadid) m
#endif