{-# LINE 1 "libraries/unix/System/Posix/Signals.hsc" #-}
{-# LANGUAGE CApiFFI, CPP, DeriveDataTypeable, NondecreasingIndentation #-}
{-# OPTIONS_GHC -fno-cse #-} -- global variables
{-# LANGUAGE Trustworthy #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  System.Posix.Signals
-- Copyright   :  (c) The University of Glasgow 2002
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  provisional
-- Portability :  non-portable (requires POSIX)
--
-- POSIX signal support
--
-----------------------------------------------------------------------------


#include "HsUnixConfig.h"


{-# LINE 22 "libraries/unix/System/Posix/Signals.hsc" #-}


{-# LINE 24 "libraries/unix/System/Posix/Signals.hsc" #-}

module System.Posix.Signals (
  -- * The Signal type
  Signal,

  -- * Specific signals
  nullSignal,
  internalAbort, sigABRT,
  realTimeAlarm, sigALRM,
  busError, sigBUS,
  processStatusChanged, sigCHLD,
  continueProcess, sigCONT,
  floatingPointException, sigFPE,
  lostConnection, sigHUP,
  illegalInstruction, sigILL,
  keyboardSignal, sigINT,
  killProcess, sigKILL,
  openEndedPipe, sigPIPE,
  keyboardTermination, sigQUIT,
  segmentationViolation, sigSEGV,
  softwareStop, sigSTOP,
  softwareTermination, sigTERM,
  keyboardStop, sigTSTP,
  backgroundRead, sigTTIN,
  backgroundWrite, sigTTOU,
  userDefinedSignal1, sigUSR1,
  userDefinedSignal2, sigUSR2,

{-# LINE 52 "libraries/unix/System/Posix/Signals.hsc" #-}
  pollableEvent, sigPOLL,

{-# LINE 54 "libraries/unix/System/Posix/Signals.hsc" #-}
  profilingTimerExpired, sigPROF,
  badSystemCall, sigSYS,
  breakpointTrap, sigTRAP,
  urgentDataAvailable, sigURG,
  virtualTimerExpired, sigVTALRM,
  cpuTimeLimitExceeded, sigXCPU,
  fileSizeLimitExceeded, sigXFSZ,

  -- * Sending signals
  raiseSignal,
  signalProcess,
  signalProcessGroup,

  -- * Handling signals
  Handler(Default,Ignore,Catch,CatchOnce,CatchInfo,CatchInfoOnce),
  SignalInfo(..), SignalSpecificInfo(..),
  installHandler,

  -- * Signal sets
  SignalSet,
  emptySignalSet, fullSignalSet, reservedSignals,
  addSignal, deleteSignal, inSignalSet,

  -- * The process signal mask
  getSignalMask, setSignalMask, blockSignals, unblockSignals,

  -- * The alarm timer
  scheduleAlarm,

  -- * Waiting for signals
  getPendingSignals,
  awaitSignal,

  -- * The @NOCLDSTOP@ flag
  setStoppedChildFlag, queryStoppedChildFlag,

  -- MISSING FUNCTIONALITY:
  -- sigaction(), (inc. the sigaction structure + flags etc.)
  -- the siginfo structure
  -- sigaltstack()
  -- sighold, sigignore, sigpause, sigrelse, sigset
  -- siginterrupt
  ) where

import Data.Word
import Foreign.C
import Foreign.ForeignPtr
import Foreign.Marshal
import Foreign.Ptr
import Foreign.Storable

{-# LINE 108 "libraries/unix/System/Posix/Signals.hsc" #-}
import System.IO.Unsafe (unsafePerformIO)
import System.Posix.Types
import System.Posix.Internals
import System.Posix.Process
import System.Posix.Process.Internals
import Data.Dynamic


{-# LINE 124 "libraries/unix/System/Posix/Signals.hsc" #-}
#include "rts/Signals.h"

{-# LINE 126 "libraries/unix/System/Posix/Signals.hsc" #-}

import GHC.Conc hiding (Signal)


{-# LINE 132 "libraries/unix/System/Posix/Signals.hsc" #-}

-- -----------------------------------------------------------------------------
-- Specific signals

nullSignal :: Signal
nullSignal :: CInt
nullSignal = CInt
0

-- | Process abort signal.
sigABRT   :: CInt
sigABRT :: CInt
sigABRT   = CONST_SIGABRT

-- | Alarm clock.
sigALRM   :: CInt
sigALRM :: CInt
sigALRM   = CONST_SIGALRM

-- | Access to an undefined portion of a memory object.
sigBUS    :: CInt
sigBUS :: CInt
sigBUS    = CONST_SIGBUS

-- | Child process terminated, stopped, or continued.
sigCHLD   :: CInt
sigCHLD :: CInt
sigCHLD   = CONST_SIGCHLD

-- | Continue executing, if stopped.
sigCONT   :: CInt
sigCONT :: CInt
sigCONT   = CONST_SIGCONT

-- | Erroneous arithmetic operation.
sigFPE    :: CInt
sigFPE :: CInt
sigFPE    = CONST_SIGFPE

-- | Hangup.
sigHUP    :: CInt
sigHUP :: CInt
sigHUP    = CONST_SIGHUP

-- | Illegal instruction.
sigILL    :: CInt
sigILL :: CInt
sigILL    = CONST_SIGILL

-- | Terminal interrupt signal.
sigINT    :: CInt
sigINT :: CInt
sigINT    = CONST_SIGINT

-- | Kill (cannot be caught or ignored).
sigKILL   :: CInt
sigKILL :: CInt
sigKILL   = CONST_SIGKILL

-- | Write on a pipe with no one to read it.
sigPIPE   :: CInt
sigPIPE :: CInt
sigPIPE   = CONST_SIGPIPE

-- | Terminal quit signal.
sigQUIT   :: CInt
sigQUIT :: CInt
sigQUIT   = CONST_SIGQUIT

-- | Invalid memory reference.
sigSEGV   :: CInt
sigSEGV :: CInt
sigSEGV   = CONST_SIGSEGV

-- | Stop executing (cannot be caught or ignored).
sigSTOP   :: CInt
sigSTOP :: CInt
sigSTOP   = CONST_SIGSTOP

-- | Termination signal.
sigTERM   :: CInt
sigTERM :: CInt
sigTERM   = CONST_SIGTERM

-- | Terminal stop signal.
sigTSTP   :: CInt
sigTSTP :: CInt
sigTSTP   = CONST_SIGTSTP

-- | Background process attempting read.
sigTTIN   :: CInt
sigTTIN :: CInt
sigTTIN   = CONST_SIGTTIN

-- | Background process attempting write.
sigTTOU   :: CInt
sigTTOU :: CInt
sigTTOU   = CONST_SIGTTOU

-- | User-defined signal 1.
sigUSR1   :: CInt
sigUSR1 :: CInt
sigUSR1   = CONST_SIGUSR1

-- | User-defined signal 2.
sigUSR2   :: CInt
sigUSR2 :: CInt
sigUSR2   = CONST_SIGUSR2


{-# LINE 220 "libraries/unix/System/Posix/Signals.hsc" #-}
-- | Pollable event.
sigPOLL   :: CInt
sigPOLL :: CInt
sigPOLL   = CONST_SIGPOLL

{-# LINE 224 "libraries/unix/System/Posix/Signals.hsc" #-}

-- | Profiling timer expired.
sigPROF   :: CInt
sigPROF :: CInt
sigPROF   = CONST_SIGPROF

-- | Bad system call.
sigSYS    :: CInt
sigSYS :: CInt
sigSYS    = CONST_SIGSYS

-- | Trace/breakpoint trap.
sigTRAP   :: CInt
sigTRAP :: CInt
sigTRAP   = CONST_SIGTRAP

-- | High bandwidth data is available at a socket.
sigURG    :: CInt
sigURG :: CInt
sigURG    = CONST_SIGURG

-- | Virtual timer expired.
sigVTALRM :: CInt
sigVTALRM :: CInt
sigVTALRM = CONST_SIGVTALRM

-- | CPU time limit exceeded.
sigXCPU   :: CInt
sigXCPU :: CInt
sigXCPU   = CONST_SIGXCPU

-- | File size limit exceeded.
sigXFSZ   :: CInt
sigXFSZ :: CInt
sigXFSZ   = CONST_SIGXFSZ

-- | Alias for 'sigABRT'.
internalAbort ::Signal
internalAbort :: CInt
internalAbort = CInt
sigABRT

-- | Alias for 'sigALRM'.
realTimeAlarm :: Signal
realTimeAlarm :: CInt
realTimeAlarm = CInt
sigALRM

-- | Alias for 'sigBUS'.
busError :: Signal
busError :: CInt
busError = CInt
sigBUS

-- | Alias for 'sigCHLD'.
processStatusChanged :: Signal
processStatusChanged :: CInt
processStatusChanged = CInt
sigCHLD

-- | Alias for 'sigCONT'.
continueProcess :: Signal
continueProcess :: CInt
continueProcess = CInt
sigCONT

-- | Alias for 'sigFPE'.
floatingPointException :: Signal
floatingPointException :: CInt
floatingPointException = CInt
sigFPE

-- | Alias for 'sigHUP'.
lostConnection :: Signal
lostConnection :: CInt
lostConnection = CInt
sigHUP

-- | Alias for 'sigILL'.
illegalInstruction :: Signal
illegalInstruction :: CInt
illegalInstruction = CInt
sigILL

-- | Alias for 'sigINT'.
keyboardSignal :: Signal
keyboardSignal :: CInt
keyboardSignal = CInt
sigINT

-- | Alias for 'sigKILL'.
killProcess :: Signal
killProcess :: CInt
killProcess = CInt
sigKILL

-- | Alias for 'sigPIPE'.
openEndedPipe :: Signal
openEndedPipe :: CInt
openEndedPipe = CInt
sigPIPE

-- | Alias for 'sigQUIT'.
keyboardTermination :: Signal
keyboardTermination :: CInt
keyboardTermination = CInt
sigQUIT

-- | Alias for 'sigSEGV'.
segmentationViolation :: Signal
segmentationViolation :: CInt
segmentationViolation = CInt
sigSEGV

-- | Alias for 'sigSTOP'.
softwareStop :: Signal
softwareStop :: CInt
softwareStop = CInt
sigSTOP

-- | Alias for 'sigTERM'.
softwareTermination :: Signal
softwareTermination :: CInt
softwareTermination = CInt
sigTERM

-- | Alias for 'sigTSTP'.
keyboardStop :: Signal
keyboardStop :: CInt
keyboardStop = CInt
sigTSTP

-- | Alias for 'sigTTIN'.
backgroundRead :: Signal
backgroundRead :: CInt
backgroundRead = CInt
sigTTIN

-- | Alias for 'sigTTOU'.
backgroundWrite :: Signal
backgroundWrite :: CInt
backgroundWrite = CInt
sigTTOU

-- | Alias for 'sigUSR1'.
userDefinedSignal1 :: Signal
userDefinedSignal1 :: CInt
userDefinedSignal1 = CInt
sigUSR1

-- | Alias for 'sigUSR2'.
userDefinedSignal2 :: Signal
userDefinedSignal2 :: CInt
userDefinedSignal2 = CInt
sigUSR2


{-# LINE 334 "libraries/unix/System/Posix/Signals.hsc" #-}
-- | Alias for 'sigPOLL'.
pollableEvent :: Signal
pollableEvent :: CInt
pollableEvent = CInt
sigPOLL

{-# LINE 338 "libraries/unix/System/Posix/Signals.hsc" #-}

-- | Alias for 'sigPROF'.
profilingTimerExpired :: Signal
profilingTimerExpired :: CInt
profilingTimerExpired = CInt
sigPROF

-- | Alias for 'sigSYS'.
badSystemCall :: Signal
badSystemCall :: CInt
badSystemCall = CInt
sigSYS

-- | Alias for 'sigTRAP'.
breakpointTrap :: Signal
breakpointTrap :: CInt
breakpointTrap = CInt
sigTRAP

-- | Alias for 'sigURG'.
urgentDataAvailable :: Signal
urgentDataAvailable :: CInt
urgentDataAvailable = CInt
sigURG

-- | Alias for 'sigVTALRM'.
virtualTimerExpired :: Signal
virtualTimerExpired :: CInt
virtualTimerExpired = CInt
sigVTALRM

-- | Alias for 'sigXCPU'.
cpuTimeLimitExceeded :: Signal
cpuTimeLimitExceeded :: CInt
cpuTimeLimitExceeded = CInt
sigXCPU

-- | Alias for 'sigXFSZ'.
fileSizeLimitExceeded :: Signal
fileSizeLimitExceeded :: CInt
fileSizeLimitExceeded = CInt
sigXFSZ

-- -----------------------------------------------------------------------------
-- Signal-related functions

-- | @signalProcess int pid@ calls @kill@ to signal process @pid@
--   with interrupt signal @int@.
signalProcess :: Signal -> ProcessID -> IO ()

{-# LINE 380 "libraries/unix/System/Posix/Signals.hsc" #-}

signalProcess :: CInt -> ProcessID -> IO ()
signalProcess CInt
sig ProcessID
pid
 = String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"signalProcess" (ProcessID -> CInt -> IO CInt
c_kill ProcessID
pid CInt
sig)

foreign import ccall unsafe "kill"
  c_kill :: CPid -> CInt -> IO CInt


{-# LINE 388 "libraries/unix/System/Posix/Signals.hsc" #-}


-- | @signalProcessGroup int pgid@ calls @kill@ to signal
--  all processes in group @pgid@ with interrupt signal @int@.
signalProcessGroup :: Signal -> ProcessGroupID -> IO ()

{-# LINE 400 "libraries/unix/System/Posix/Signals.hsc" #-}

signalProcessGroup :: CInt -> ProcessID -> IO ()
signalProcessGroup CInt
sig ProcessID
pgid
  = String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"signalProcessGroup" (ProcessID -> CInt -> IO CInt
c_killpg ProcessID
pgid CInt
sig)

foreign import ccall unsafe "killpg"
  c_killpg :: CPid -> CInt -> IO CInt


{-# LINE 408 "libraries/unix/System/Posix/Signals.hsc" #-}

-- | @raiseSignal int@ calls @kill@ to signal the current process
--   with interrupt signal @int@.
raiseSignal :: Signal -> IO ()

{-# LINE 419 "libraries/unix/System/Posix/Signals.hsc" #-}

raiseSignal :: CInt -> IO ()
raiseSignal CInt
sig = String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"raiseSignal" (CInt -> IO CInt
c_raise CInt
sig)

-- See also note in GHC's rts/RtsUtils.c
-- This is somewhat fragile because we need to keep the
-- `#if`-conditional in sync with GHC's runtime.

{-# LINE 429 "libraries/unix/System/Posix/Signals.hsc" #-}
foreign import ccall unsafe "raise"
  c_raise :: CInt -> IO CInt

{-# LINE 432 "libraries/unix/System/Posix/Signals.hsc" #-}


{-# LINE 434 "libraries/unix/System/Posix/Signals.hsc" #-}

type Signal = CInt

-- | The actions to perform when a signal is received.
data Handler = Default
                 -- ^ Sets the disposition of the signal to @SIG_DFL@, which
                 -- means we want the default action associated with the
                 -- signal. For example, the default action for @SIGTERM@ (and
                 -- various other signals) is to terminate the process.
             | Ignore
                 -- ^ Set the disposition of the signal to @SIG_IGN@, which
                 -- means we want to /ignore/ the signal.  Ignored signals will
                 -- not be delivered to the process, and if also /blocked/ will
                 -- not be added to the pending set for later delivery (if/when
                 -- unblocked).  Some signals (e.g. @SIGSTOP@ and @SIGKILL@)
                 -- cannot be caught or ignored.
             -- not yet: | Hold
             | Catch (IO ())
                 -- ^ signal handler is not reset
             | CatchOnce (IO ())
                 -- ^ signal handler is automatically reset (via @SA_RESETHAND@)
             | CatchInfo (SignalInfo -> IO ())     -- ^ @since 2.7.0.0
             | CatchInfoOnce (SignalInfo -> IO ()) -- ^ @since 2.7.0.0
  deriving (Typeable)

-- | Information about a received signal (derived from @siginfo_t@).
--
-- @since 2.7.0.0
data SignalInfo = SignalInfo {
      SignalInfo -> CInt
siginfoSignal   :: Signal,
      SignalInfo -> Errno
siginfoError    :: Errno,
      SignalInfo -> SignalSpecificInfo
siginfoSpecific :: SignalSpecificInfo
  }

-- | Information specific to a particular type of signal
-- (derived from @siginfo_t@).
--
-- @since 2.7.0.0
data SignalSpecificInfo
  = NoSignalSpecificInfo
  | SigChldInfo {
      SignalSpecificInfo -> ProcessID
siginfoPid    :: ProcessID,
      SignalSpecificInfo -> UserID
siginfoUid    :: UserID,
      SignalSpecificInfo -> ProcessStatus
siginfoStatus :: ProcessStatus
    }

-- | @installHandler int handler iset@ calls @sigaction@ to install an
--   interrupt handler for signal @int@.  If @handler@ is @Default@,
--   @SIG_DFL@ is installed; if @handler@ is @Ignore@, @SIG_IGN@ is
--   installed; if @handler@ is @Catch action@, a handler is installed
--   which will invoke @action@ in a new thread when (or shortly after) the
--   signal is received.
--   If @iset@ is @Just s@, then the @sa_mask@ of the @sigaction@ structure
--   is set to @s@; otherwise it is cleared.  The previously installed
--   signal handler for @int@ is returned
installHandler :: Signal
               -> Handler
               -> Maybe SignalSet       -- ^ other signals to block
               -> IO Handler            -- ^ old handler


{-# LINE 506 "libraries/unix/System/Posix/Signals.hsc" #-}

installHandler :: CInt -> Handler -> Maybe SignalSet -> IO Handler
installHandler CInt
sig Handler
handler Maybe SignalSet
_maybe_mask = do
  IO ()
ensureIOManagerIsRunning  -- for the threaded RTS

  -- if we're setting the action to DFL or IGN, we should do that *first*
  -- if we're setting a handler,
  --   if the previous action was handle, then setHandler is ok
  --   if the previous action was IGN/DFL, then setHandler followed by sig_install
  (CInt
old_action, Maybe (HandlerFun, Dynamic)
old_handler) <-
    case Handler
handler of
      Handler
Ignore  -> do
        CInt
old_action  <- CInt -> CInt -> Ptr CSigset -> IO CInt
stg_sig_install CInt
sig STG_SIG_IGN nullPtr
        Maybe (HandlerFun, Dynamic)
old_handler <- CInt
-> Maybe (HandlerFun, Dynamic) -> IO (Maybe (HandlerFun, Dynamic))
setHandler CInt
sig Maybe (HandlerFun, Dynamic)
forall a. Maybe a
Nothing
        (CInt, Maybe (HandlerFun, Dynamic))
-> IO (CInt, Maybe (HandlerFun, Dynamic))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt
old_action, Maybe (HandlerFun, Dynamic)
old_handler)

      Handler
Default -> do
        CInt
old_action  <- CInt -> CInt -> Ptr CSigset -> IO CInt
stg_sig_install CInt
sig STG_SIG_DFL nullPtr
        Maybe (HandlerFun, Dynamic)
old_handler <- CInt
-> Maybe (HandlerFun, Dynamic) -> IO (Maybe (HandlerFun, Dynamic))
setHandler CInt
sig Maybe (HandlerFun, Dynamic)
forall a. Maybe a
Nothing
        (CInt, Maybe (HandlerFun, Dynamic))
-> IO (CInt, Maybe (HandlerFun, Dynamic))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt
old_action, Maybe (HandlerFun, Dynamic)
old_handler)

      Handler
_some_kind_of_catch -> do
        -- I don't think it's possible to get CatchOnce right.  If
        -- there's a signal in flight, then we might run the handler
        -- more than once.
        let dyn :: Dynamic
dyn = Handler -> Dynamic
forall a. Typeable a => a -> Dynamic
toDyn Handler
handler
        Maybe (HandlerFun, Dynamic)
old_handler <- case Handler
handler of
            Catch         IO ()
action -> CInt
-> Maybe (HandlerFun, Dynamic) -> IO (Maybe (HandlerFun, Dynamic))
setHandler CInt
sig ((HandlerFun, Dynamic) -> Maybe (HandlerFun, Dynamic)
forall a. a -> Maybe a
Just (IO () -> HandlerFun
forall a b. a -> b -> a
const IO ()
action,Dynamic
dyn))
            CatchOnce     IO ()
action -> CInt
-> Maybe (HandlerFun, Dynamic) -> IO (Maybe (HandlerFun, Dynamic))
setHandler CInt
sig ((HandlerFun, Dynamic) -> Maybe (HandlerFun, Dynamic)
forall a. a -> Maybe a
Just (IO () -> HandlerFun
forall a b. a -> b -> a
const IO ()
action,Dynamic
dyn))
            CatchInfo     SignalInfo -> IO ()
action -> CInt
-> Maybe (HandlerFun, Dynamic) -> IO (Maybe (HandlerFun, Dynamic))
setHandler CInt
sig ((HandlerFun, Dynamic) -> Maybe (HandlerFun, Dynamic)
forall a. a -> Maybe a
Just ((SignalInfo -> IO ()) -> HandlerFun
getinfo SignalInfo -> IO ()
action,Dynamic
dyn))
            CatchInfoOnce SignalInfo -> IO ()
action -> CInt
-> Maybe (HandlerFun, Dynamic) -> IO (Maybe (HandlerFun, Dynamic))
setHandler CInt
sig ((HandlerFun, Dynamic) -> Maybe (HandlerFun, Dynamic)
forall a. a -> Maybe a
Just ((SignalInfo -> IO ()) -> HandlerFun
getinfo SignalInfo -> IO ()
action,Dynamic
dyn))

{-# LINE 539 "libraries/unix/System/Posix/Signals.hsc" #-}

        let action :: CInt
action = case Handler
handler of
                Catch IO ()
_         -> STG_SIG_HAN
                CatchOnce IO ()
_     -> STG_SIG_RST
                CatchInfo SignalInfo -> IO ()
_     -> STG_SIG_HAN
                CatchInfoOnce SignalInfo -> IO ()
_ -> STG_SIG_RST

{-# LINE 548 "libraries/unix/System/Posix/Signals.hsc" #-}

        CInt
old_action <- CInt -> CInt -> Ptr CSigset -> IO CInt
stg_sig_install CInt
sig CInt
action Ptr CSigset
forall a. Ptr a
nullPtr
                   -- mask is pointless, so leave it NULL

        (CInt, Maybe (HandlerFun, Dynamic))
-> IO (CInt, Maybe (HandlerFun, Dynamic))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt
old_action, Maybe (HandlerFun, Dynamic)
old_handler)

  case (Maybe (HandlerFun, Dynamic)
old_handler,CInt
old_action) of
    (Maybe (HandlerFun, Dynamic)
_,       STG_SIG_DFL) -> return $ Default
    (Maybe (HandlerFun, Dynamic)
_,       STG_SIG_IGN) -> return $ Ignore
    (Maybe (HandlerFun, Dynamic)
Nothing, CInt
_)           -> Handler -> IO Handler
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Handler -> IO Handler) -> Handler -> IO Handler
forall a b. (a -> b) -> a -> b
$ Handler
Ignore
    (Just (HandlerFun
_,Dynamic
dyn),  CInt
_)
        | Just Handler
h <- Dynamic -> Maybe Handler
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic Dynamic
dyn  -> Handler -> IO Handler
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Handler
h
        | Just IO ()
io <- Dynamic -> Maybe (IO ())
forall a. Typeable a => Dynamic -> Maybe a
fromDynamic Dynamic
dyn -> Handler -> IO Handler
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> Handler
Catch IO ()
io)
        -- handlers put there by the base package have type IO ()
        | Bool
otherwise                  -> Handler -> IO Handler
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Handler
Default

foreign import ccall unsafe
  stg_sig_install
        :: CInt                         -- sig no.
        -> CInt                         -- action code (STG_SIG_HAN etc.)
        -> Ptr CSigset                  -- (in, out) blocked
        -> IO CInt                      -- (ret) old action code

getinfo :: (SignalInfo -> IO ()) -> ForeignPtr Word8 -> IO ()
getinfo :: (SignalInfo -> IO ()) -> HandlerFun
getinfo SignalInfo -> IO ()
handler ForeignPtr Word8
fp_info = do
  SignalInfo
si <- ForeignPtr Word8 -> IO SignalInfo
unmarshalSigInfo ForeignPtr Word8
fp_info
  SignalInfo -> IO ()
handler SignalInfo
si

unmarshalSigInfo :: ForeignPtr Word8 -> IO SignalInfo
unmarshalSigInfo :: ForeignPtr Word8 -> IO SignalInfo
unmarshalSigInfo ForeignPtr Word8
fp = do
  ForeignPtr Word8 -> (Ptr Word8 -> IO SignalInfo) -> IO SignalInfo
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp ((Ptr Word8 -> IO SignalInfo) -> IO SignalInfo)
-> (Ptr Word8 -> IO SignalInfo) -> IO SignalInfo
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> do
    CInt
sig   <- ((\Ptr Word8
hsc_ptr -> Ptr Word8 -> Int -> IO CInt
forall b. Ptr b -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Word8
hsc_ptr Int
0)) Ptr Word8
p
{-# LINE 580 "libraries/unix/System/Posix/Signals.hsc" #-}
    errno <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p
{-# LINE 581 "libraries/unix/System/Posix/Signals.hsc" #-}
    extra <- case sig of
                _ | sig == sigCHLD -> do
                    pid <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p
{-# LINE 584 "libraries/unix/System/Posix/Signals.hsc" #-}
                    uid <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) p
{-# LINE 585 "libraries/unix/System/Posix/Signals.hsc" #-}
                    wstat <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p
{-# LINE 586 "libraries/unix/System/Posix/Signals.hsc" #-}
                    pstat <- decipherWaitStatus wstat
                    return SigChldInfo { siginfoPid = pid,
                                         siginfoUid = uid,
                                         siginfoStatus = pstat }
                _ | otherwise ->
                    return NoSignalSpecificInfo
    SignalInfo -> IO SignalInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
      SignalInfo {
        siginfoSignal :: CInt
siginfoSignal = CInt
sig,
        siginfoError :: Errno
siginfoError  = CInt -> Errno
Errno CInt
errno,
        siginfoSpecific :: SignalSpecificInfo
siginfoSpecific = SignalSpecificInfo
extra }


{-# LINE 599 "libraries/unix/System/Posix/Signals.hsc" #-}


{-# LINE 608 "libraries/unix/System/Posix/Signals.hsc" #-}

-- -----------------------------------------------------------------------------
-- Alarms

-- | @scheduleAlarm i@ calls @alarm@ to schedule a real time
--   alarm at least @i@ seconds in the future.
scheduleAlarm :: Int -> IO Int
scheduleAlarm :: Int -> IO Int
scheduleAlarm Int
secs = do
   CUInt
r <- CUInt -> IO CUInt
c_alarm (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
secs)
   Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
r)

foreign import ccall unsafe "alarm"
  c_alarm :: CUInt -> IO CUInt


{-# LINE 623 "libraries/unix/System/Posix/Signals.hsc" #-}

-- -----------------------------------------------------------------------------
-- The NOCLDSTOP flag


{-# LINE 638 "libraries/unix/System/Posix/Signals.hsc" #-}

foreign import ccall "&nocldstop" nocldstop :: Ptr Int

-- | Tells the system whether or not to set the @SA_NOCLDSTOP@ flag when
-- installing new signal handlers.
setStoppedChildFlag :: Bool -> IO Bool
setStoppedChildFlag :: Bool -> IO Bool
setStoppedChildFlag Bool
b = do
    Int
rc <- Ptr Int -> IO Int
forall a. Storable a => Ptr a -> IO a
peek Ptr Int
nocldstop
    Ptr Int -> Int -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Int
nocldstop (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> Int
forall a. Enum a => a -> Int
fromEnum (Bool -> Bool
not Bool
b)
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
rc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
0::Int))

-- | Queries the current state of the stopped child flag.
queryStoppedChildFlag :: IO Bool
queryStoppedChildFlag :: IO Bool
queryStoppedChildFlag = do
    Int
rc <- Ptr Int -> IO Int
forall a. Storable a => Ptr a -> IO a
peek Ptr Int
nocldstop
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
rc Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
0::Int))


{-# LINE 656 "libraries/unix/System/Posix/Signals.hsc" #-}

-- -----------------------------------------------------------------------------
-- Manipulating signal sets


{-# LINE 661 "libraries/unix/System/Posix/Signals.hsc" #-}

newtype SignalSet = SignalSet (ForeignPtr CSigset)


{-# LINE 669 "libraries/unix/System/Posix/Signals.hsc" #-}


{-# LINE 704 "libraries/unix/System/Posix/Signals.hsc" #-}

emptySignalSet :: SignalSet
emptySignalSet :: SignalSet
emptySignalSet = IO SignalSet -> SignalSet
forall a. IO a -> a
unsafePerformIO (IO SignalSet -> SignalSet) -> IO SignalSet -> SignalSet
forall a b. (a -> b) -> a -> b
$ do
  ForeignPtr CSigset
fp <- Int -> IO (ForeignPtr CSigset)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
sizeof_sigset_t
  String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"emptySignalSet" (ForeignPtr CSigset -> (Ptr CSigset -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CSigset
fp ((Ptr CSigset -> IO CInt) -> IO CInt)
-> (Ptr CSigset -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr CSigset -> IO CInt
c_sigemptyset)
  SignalSet -> IO SignalSet
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr CSigset -> SignalSet
SignalSet ForeignPtr CSigset
fp)

fullSignalSet :: SignalSet
fullSignalSet :: SignalSet
fullSignalSet = IO SignalSet -> SignalSet
forall a. IO a -> a
unsafePerformIO (IO SignalSet -> SignalSet) -> IO SignalSet -> SignalSet
forall a b. (a -> b) -> a -> b
$ do
  ForeignPtr CSigset
fp <- Int -> IO (ForeignPtr CSigset)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
sizeof_sigset_t
  String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"fullSignalSet" (ForeignPtr CSigset -> (Ptr CSigset -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CSigset
fp ((Ptr CSigset -> IO CInt) -> IO CInt)
-> (Ptr CSigset -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr CSigset -> IO CInt
c_sigfillset)
  SignalSet -> IO SignalSet
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr CSigset -> SignalSet
SignalSet ForeignPtr CSigset
fp)

-- | A set of signals reserved for use by the implementation.  In GHC, this will normally
-- include either `sigVTALRM` or `sigALRM`.
reservedSignals :: SignalSet
reservedSignals :: SignalSet
reservedSignals = CInt -> SignalSet -> SignalSet
addSignal CInt
rtsTimerSignal SignalSet
emptySignalSet

foreign import ccall rtsTimerSignal :: CInt

infixr `addSignal`, `deleteSignal`
addSignal :: Signal -> SignalSet -> SignalSet
addSignal :: CInt -> SignalSet -> SignalSet
addSignal CInt
sig (SignalSet ForeignPtr CSigset
fp1) = IO SignalSet -> SignalSet
forall a. IO a -> a
unsafePerformIO (IO SignalSet -> SignalSet) -> IO SignalSet -> SignalSet
forall a b. (a -> b) -> a -> b
$ do
  ForeignPtr CSigset
fp2 <- Int -> IO (ForeignPtr CSigset)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
sizeof_sigset_t
  ForeignPtr CSigset -> (Ptr CSigset -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CSigset
fp1 ((Ptr CSigset -> IO ()) -> IO ())
-> (Ptr CSigset -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CSigset
p1 ->
    ForeignPtr CSigset -> (Ptr CSigset -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CSigset
fp2 ((Ptr CSigset -> IO ()) -> IO ())
-> (Ptr CSigset -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CSigset
p2 -> do
      Ptr CSigset -> Ptr CSigset -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr CSigset
p2 Ptr CSigset
p1 Int
sizeof_sigset_t
      String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"addSignal" (Ptr CSigset -> CInt -> IO CInt
c_sigaddset Ptr CSigset
p2 CInt
sig)
  SignalSet -> IO SignalSet
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr CSigset -> SignalSet
SignalSet ForeignPtr CSigset
fp2)

deleteSignal :: Signal -> SignalSet -> SignalSet
deleteSignal :: CInt -> SignalSet -> SignalSet
deleteSignal CInt
sig (SignalSet ForeignPtr CSigset
fp1) = IO SignalSet -> SignalSet
forall a. IO a -> a
unsafePerformIO (IO SignalSet -> SignalSet) -> IO SignalSet -> SignalSet
forall a b. (a -> b) -> a -> b
$ do
  ForeignPtr CSigset
fp2 <- Int -> IO (ForeignPtr CSigset)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
sizeof_sigset_t
  ForeignPtr CSigset -> (Ptr CSigset -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CSigset
fp1 ((Ptr CSigset -> IO ()) -> IO ())
-> (Ptr CSigset -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CSigset
p1 ->
    ForeignPtr CSigset -> (Ptr CSigset -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CSigset
fp2 ((Ptr CSigset -> IO ()) -> IO ())
-> (Ptr CSigset -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CSigset
p2 -> do
      Ptr CSigset -> Ptr CSigset -> Int -> IO ()
forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr CSigset
p2 Ptr CSigset
p1 Int
sizeof_sigset_t
      String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"deleteSignal" (Ptr CSigset -> CInt -> IO CInt
c_sigdelset Ptr CSigset
p2 CInt
sig)
  SignalSet -> IO SignalSet
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr CSigset -> SignalSet
SignalSet ForeignPtr CSigset
fp2)

inSignalSet :: Signal -> SignalSet -> Bool
inSignalSet :: CInt -> SignalSet -> Bool
inSignalSet CInt
sig (SignalSet ForeignPtr CSigset
fp) = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$
  ForeignPtr CSigset -> (Ptr CSigset -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CSigset
fp ((Ptr CSigset -> IO Bool) -> IO Bool)
-> (Ptr CSigset -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr CSigset
p -> do
    CInt
r <- String -> IO CInt -> IO CInt
forall a. (Eq a, Num a) => String -> IO a -> IO a
throwErrnoIfMinus1 String
"inSignalSet" (Ptr CSigset -> CInt -> IO CInt
c_sigismember Ptr CSigset
p CInt
sig)
    Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt
r CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0)


{-# LINE 750 "libraries/unix/System/Posix/Signals.hsc" #-}


{-# LINE 774 "libraries/unix/System/Posix/Signals.hsc" #-}

-- | @getSignalMask@ calls @sigprocmask@ to determine the
--   set of interrupts which are currently being blocked.
getSignalMask :: IO SignalSet
getSignalMask :: IO SignalSet
getSignalMask = do
  ForeignPtr CSigset
fp <- Int -> IO (ForeignPtr CSigset)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
sizeof_sigset_t
  ForeignPtr CSigset -> (Ptr CSigset -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CSigset
fp ((Ptr CSigset -> IO ()) -> IO ())
-> (Ptr CSigset -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CSigset
p ->
    String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"getSignalMask" (CInt -> Ptr CSigset -> Ptr CSigset -> IO CInt
c_sigprocmask CInt
0 Ptr CSigset
forall a. Ptr a
nullPtr Ptr CSigset
p)
  SignalSet -> IO SignalSet
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr CSigset -> SignalSet
SignalSet ForeignPtr CSigset
fp)

sigProcMask :: String -> CInt -> SignalSet -> IO ()
sigProcMask :: String -> CInt -> SignalSet -> IO ()
sigProcMask String
fn CInt
how (SignalSet ForeignPtr CSigset
set) =
  ForeignPtr CSigset -> (Ptr CSigset -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CSigset
set ((Ptr CSigset -> IO ()) -> IO ())
-> (Ptr CSigset -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CSigset
p_set ->
    String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
fn (CInt -> Ptr CSigset -> Ptr CSigset -> IO CInt
c_sigprocmask CInt
how Ptr CSigset
p_set Ptr CSigset
forall a. Ptr a
nullPtr)

-- | @setSignalMask mask@ calls @sigprocmask@ with
--   @SIG_SETMASK@ to block all interrupts in @mask@.
setSignalMask :: SignalSet -> IO ()
setSignalMask :: SignalSet -> IO ()
setSignalMask SignalSet
set = String -> CInt -> SignalSet -> IO ()
sigProcMask String
"setSignalMask" (CONST_SIG_SETMASK :: CInt) set

-- | @blockSignals mask@ calls @sigprocmask@ with
--   @SIG_BLOCK@ to add all interrupts in @mask@ to the
--  set of blocked interrupts.
blockSignals :: SignalSet -> IO ()
blockSignals :: SignalSet -> IO ()
blockSignals SignalSet
set = String -> CInt -> SignalSet -> IO ()
sigProcMask String
"blockSignals" (CONST_SIG_BLOCK :: CInt) set

-- | @unblockSignals mask@ calls @sigprocmask@ with
--   @SIG_UNBLOCK@ to remove all interrupts in @mask@ from the
--   set of blocked interrupts.
unblockSignals :: SignalSet -> IO ()
unblockSignals :: SignalSet -> IO ()
unblockSignals SignalSet
set = String -> CInt -> SignalSet -> IO ()
sigProcMask String
"unblockSignals" (CONST_SIG_UNBLOCK :: CInt) set


{-# LINE 807 "libraries/unix/System/Posix/Signals.hsc" #-}


{-# LINE 821 "libraries/unix/System/Posix/Signals.hsc" #-}

-- | @getPendingSignals@ calls @sigpending@ to obtain
--   the set of interrupts which have been received but are currently blocked.
getPendingSignals :: IO SignalSet
getPendingSignals :: IO SignalSet
getPendingSignals = do
  ForeignPtr CSigset
fp <- Int -> IO (ForeignPtr CSigset)
forall a. Int -> IO (ForeignPtr a)
mallocForeignPtrBytes Int
sizeof_sigset_t
  ForeignPtr CSigset -> (Ptr CSigset -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CSigset
fp ((Ptr CSigset -> IO ()) -> IO ())
-> (Ptr CSigset -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CSigset
p ->
   String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"getPendingSignals" (Ptr CSigset -> IO CInt
c_sigpending Ptr CSigset
p)
  SignalSet -> IO SignalSet
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr CSigset -> SignalSet
SignalSet ForeignPtr CSigset
fp)

-- | @awaitSignal iset@ suspends execution until an interrupt is received.
-- If @iset@ is @Just s@, @awaitSignal@ calls @sigsuspend@, installing
-- @s@ as the new signal mask before suspending execution; otherwise, it
-- calls @sigsuspend@ with current signal mask. Note that RTS
-- scheduler signal (either 'virtualTimerExpired' or 'realTimeAlarm')
-- could cause premature termination of this call. It might be necessary to block that
-- signal before invocation of @awaitSignal@ with 'blockSignals' 'reservedSignals'.
--
-- @awaitSignal@ returns when signal was received and processed by a
-- signal handler, or if the signal could not be caught. If you have
-- installed any signal handlers with @installHandler@, it may be wise
-- to call @yield@ directly after @awaitSignal@ to ensure that the
-- signal handler runs as promptly as possible.
awaitSignal :: Maybe SignalSet -> IO ()
awaitSignal :: Maybe SignalSet -> IO ()
awaitSignal Maybe SignalSet
maybe_sigset = do
  ForeignPtr CSigset
fp <- case Maybe SignalSet
maybe_sigset of
          Maybe SignalSet
Nothing -> do SignalSet ForeignPtr CSigset
fp <- IO SignalSet
getSignalMask; ForeignPtr CSigset -> IO (ForeignPtr CSigset)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ForeignPtr CSigset
fp
          Just (SignalSet ForeignPtr CSigset
fp) -> ForeignPtr CSigset -> IO (ForeignPtr CSigset)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ForeignPtr CSigset
fp
  ForeignPtr CSigset -> (Ptr CSigset -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr CSigset
fp ((Ptr CSigset -> IO ()) -> IO ())
-> (Ptr CSigset -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CSigset
p -> do
  CInt
_ <- Ptr CSigset -> IO CInt
c_sigsuspend Ptr CSigset
p
  () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  -- ignore the return value; according to the docs it can only ever be
  -- (-1) with errno set to EINTR.
  -- XXX My manpage says it can also return EFAULT. And why is ignoring
  -- EINTR the right thing to do?


{-# LINE 858 "libraries/unix/System/Posix/Signals.hsc" #-}


{-# LINE 860 "libraries/unix/System/Posix/Signals.hsc" #-}

foreign import ccall unsafe "sigsuspend"
  c_sigsuspend :: Ptr CSigset -> IO CInt

foreign import capi unsafe "signal.h sigdelset"
  c_sigdelset   :: Ptr CSigset -> CInt -> IO CInt

foreign import capi unsafe "signal.h sigfillset"
  c_sigfillset  :: Ptr CSigset -> IO CInt

foreign import capi unsafe "signal.h sigismember"
  c_sigismember :: Ptr CSigset -> CInt -> IO CInt

foreign import ccall unsafe "sigpending"
  c_sigpending :: Ptr CSigset -> IO CInt


{-# LINE 877 "libraries/unix/System/Posix/Signals.hsc" #-}