System/Posix/Signals.hsc

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  System.Posix.Signals
   4 -- Copyright   :  (c) The University of Glasgow 2002
   5 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   6 --
   7 -- Maintainer  :  libraries@haskell.org
   8 -- Stability   :  provisional
   9 -- Portability :  non-portable (requires POSIX)
  10 --
  11 -- POSIX signal support
  12 --
  13 -----------------------------------------------------------------------------
  14
  15 #include "config.h"
  16
  17 module System.Posix.Signals (
  18 #ifndef mingw32_TARGET_OS
  19   -- * The Signal type
  20   Signal,
  21
  22   -- * Specific signals
  23   nullSignal,
  24   internalAbort, sigABRT,
  25   realTimeAlarm, sigALRM,
  26   busError, sigBUS,
  27   processStatusChanged, sigCHLD,
  28   continueProcess, sigCONT,
  29   floatingPointException, sigFPE,
  30   lostConnection, sigHUP,
  31   illegalInstruction, sigILL,
  32   keyboardSignal, sigINT,
  33   killProcess, sigKILL,
  34   openEndedPipe, sigPIPE,
  35   keyboardTermination, sigQUIT,
  36   segmentationViolation, sigSEGV,
  37   softwareStop, sigSTOP,
  38   softwareTermination, sigTERM,
  39   keyboardStop, sigTSTP,
  40   backgroundRead, sigTTIN,
  41   backgroundWrite, sigTTOU,
  42   userDefinedSignal1, sigUSR1,
  43   userDefinedSignal2, sigUSR2,
  44 #if HAVE_SIGPOLL
  45   pollableEvent, sigPOLL,
  46 #endif
  47   profilingTimerExpired, sigPROF,
  48   badSystemCall, sigSYS,
  49   breakpointTrap, sigTRAP,
  50   urgentDataAvailable, sigURG,
  51   virtualTimerExpired, sigVTALRM,
  52   cpuTimeLimitExceeded, sigXCPU,
  53   fileSizeLimitExceeded, sigXFSZ,
  54
  55   -- * Sending signals
  56   raiseSignal,
  57   signalProcess,
  58   signalProcessGroup,
  59
  60   -- * Handling signals
  61   Handler(..),
  62   installHandler,
  63
  64   -- * Signal sets
  65   SignalSet,
  66   emptySignalSet, fullSignalSet,
  67   addSignal, deleteSignal, inSignalSet,
  68
  69   -- * The process signal mask
  70   getSignalMask, setSignalMask, blockSignals, unblockSignals,
  71
  72   -- * The alarm timer
  73   scheduleAlarm,
  74
  75   -- * Waiting for signals
  76   getPendingSignals, awaitSignal,
  77
  78   -- * The @NOCLDSTOP@ flag
  79   setStoppedChildFlag, queryStoppedChildFlag,
  80
  81   -- MISSING FUNCTIONALITY:
  82   -- sigaction(), (inc. the sigaction structure + flags etc.)
  83   -- the siginfo structure
  84   -- sigaltstack()
  85   -- sighold, sigignore, sigpause, sigrelse, sigset
  86   -- siginterrupt
  87 #endif
  88   ) where
  89
  90 #include "Signals.h"
  91
  92 import Foreign
  93 import Foreign.C
  94 import System.IO.Unsafe
  95 import System.Posix.Types
  96 import System.Posix.Internals
  97
  98 #ifndef mingw32_TARGET_OS
  99 -- WHOLE FILE...
 100
 101 -- -----------------------------------------------------------------------------
 102 -- Specific signals
 103
 104 type Signal = CInt
 105
 106 nullSignal :: Signal
 107 nullSignal = 0
 108
 109 foreign import ccall unsafe "__hsposix_SIGABRT"   sigABRT   :: CInt
 110 foreign import ccall unsafe "__hsposix_SIGALRM"   sigALRM   :: CInt
 111 foreign import ccall unsafe "__hsposix_SIGBUS"    sigBUS    :: CInt
 112 foreign import ccall unsafe "__hsposix_SIGCHLD"   sigCHLD   :: CInt
 113 foreign import ccall unsafe "__hsposix_SIGCONT"   sigCONT   :: CInt
 114 foreign import ccall unsafe "__hsposix_SIGFPE"    sigFPE    :: CInt
 115 foreign import ccall unsafe "__hsposix_SIGHUP"    sigHUP    :: CInt
 116 foreign import ccall unsafe "__hsposix_SIGILL"    sigILL    :: CInt
 117 foreign import ccall unsafe "__hsposix_SIGINT"    sigINT    :: CInt
 118 foreign import ccall unsafe "__hsposix_SIGKILL"   sigKILL   :: CInt
 119 foreign import ccall unsafe "__hsposix_SIGPIPE"   sigPIPE   :: CInt
 120 foreign import ccall unsafe "__hsposix_SIGQUIT"   sigQUIT   :: CInt
 121 foreign import ccall unsafe "__hsposix_SIGSEGV"   sigSEGV   :: CInt
 122 foreign import ccall unsafe "__hsposix_SIGSTOP"   sigSTOP   :: CInt
 123 foreign import ccall unsafe "__hsposix_SIGTERM"   sigTERM   :: CInt
 124 foreign import ccall unsafe "__hsposix_SIGTSTP"   sigTSTP   :: CInt
 125 foreign import ccall unsafe "__hsposix_SIGTTIN"   sigTTIN   :: CInt
 126 foreign import ccall unsafe "__hsposix_SIGTTOU"   sigTTOU   :: CInt
 127 foreign import ccall unsafe "__hsposix_SIGUSR1"   sigUSR1   :: CInt
 128 foreign import ccall unsafe "__hsposix_SIGUSR2"   sigUSR2   :: CInt
 129 #if HAVE_SIGPOLL
 130 foreign import ccall unsafe "__hsposix_SIGPOLL"   sigPOLL   :: CInt
 131 #endif
 132 foreign import ccall unsafe "__hsposix_SIGPROF"   sigPROF   :: CInt
 133 foreign import ccall unsafe "__hsposix_SIGSYS"    sigSYS    :: CInt
 134 foreign import ccall unsafe "__hsposix_SIGTRAP"   sigTRAP   :: CInt
 135 foreign import ccall unsafe "__hsposix_SIGURG"    sigURG    :: CInt
 136 foreign import ccall unsafe "__hsposix_SIGVTALRM" sigVTALRM :: CInt
 137 foreign import ccall unsafe "__hsposix_SIGXCPU"   sigXCPU   :: CInt
 138 foreign import ccall unsafe "__hsposix_SIGXFSZ"   sigXFSZ   :: CInt
 139
 140 internalAbort ::Signal
 141 internalAbort = sigABRT
 142
 143 realTimeAlarm :: Signal
 144 realTimeAlarm = sigALRM
 145
 146 busError :: Signal
 147 busError = sigBUS
 148
 149 processStatusChanged :: Signal
 150 processStatusChanged = sigCHLD
 151
 152 #ifndef cygwin32_TARGET_OS
 153 continueProcess :: Signal
 154 continueProcess = sigCONT
 155 #endif
 156
 157 floatingPointException :: Signal
 158 floatingPointException = sigFPE
 159
 160 lostConnection :: Signal
 161 lostConnection = sigHUP
 162
 163 illegalInstruction :: Signal
 164 illegalInstruction = sigILL
 165
 166 keyboardSignal :: Signal
 167 keyboardSignal = sigINT
 168
 169 killProcess :: Signal
 170 killProcess = sigKILL
 171
 172 openEndedPipe :: Signal
 173 openEndedPipe = sigPIPE
 174
 175 keyboardTermination :: Signal
 176 keyboardTermination = sigQUIT
 177
 178 segmentationViolation :: Signal
 179 segmentationViolation = sigSEGV
 180
 181 softwareStop :: Signal
 182 softwareStop = sigSTOP
 183
 184 softwareTermination :: Signal
 185 softwareTermination = sigTERM
 186
 187 keyboardStop :: Signal
 188 keyboardStop = sigTSTP
 189
 190 backgroundRead :: Signal
 191 backgroundRead = sigTTIN
 192
 193 backgroundWrite :: Signal
 194 backgroundWrite = sigTTOU
 195
 196 userDefinedSignal1 :: Signal
 197 userDefinedSignal1 = sigUSR1
 198
 199 userDefinedSignal2 :: Signal
 200 userDefinedSignal2 = sigUSR2
 201
 202 #if HAVE_SIGPOLL
 203 pollableEvent :: Signal
 204 pollableEvent = sigPOLL
 205 #endif
 206
 207 profilingTimerExpired :: Signal
 208 profilingTimerExpired = sigPROF
 209
 210 badSystemCall :: Signal
 211 badSystemCall = sigSYS
 212
 213 breakpointTrap :: Signal
 214 breakpointTrap = sigTRAP
 215
 216 urgentDataAvailable :: Signal
 217 urgentDataAvailable = sigURG
 218
 219 virtualTimerExpired :: Signal
 220 virtualTimerExpired = sigVTALRM
 221
 222 cpuTimeLimitExceeded :: Signal
 223 cpuTimeLimitExceeded = sigXCPU
 224
 225 fileSizeLimitExceeded :: Signal
 226 fileSizeLimitExceeded = sigXFSZ
 227
 228 -- -----------------------------------------------------------------------------
 229 -- Signal-related functions
 230
 231 signalProcess :: Signal -> ProcessID -> IO ()
 232 signalProcess sig pid
 233  = throwErrnoIfMinus1_ "signalProcess" (c_kill (fromIntegral pid) sig)
 234
 235 foreign import ccall unsafe "kill"
 236   c_kill :: CPid -> CInt -> IO CInt
 237
 238 signalProcessGroup :: Signal -> ProcessGroupID -> IO ()
 239 signalProcessGroup sig pgid
 240   = throwErrnoIfMinus1_ "signalProcessGroup" (c_killpg (fromIntegral pgid) sig)
 241
 242 foreign import ccall unsafe "killpg"
 243   c_killpg :: CPid -> CInt -> IO CInt
 244
 245 raiseSignal :: Signal -> IO ()
 246 raiseSignal sig = throwErrnoIfMinus1_ "raiseSignal" (c_raise sig)
 247
 248 foreign import ccall unsafe "raise"
 249   c_raise :: CInt -> IO CInt
 250
 251 data Handler = Default
 252              | Ignore
 253              -- not yet: | Hold
 254              | Catch (IO ())
 255              | CatchOnce (IO ())
 256
 257 installHandler :: Signal
 258                -> Handler
 259                -> Maybe SignalSet       -- other signals to block
 260                -> IO Handler            -- old handler
 261
 262 #ifdef __PARALLEL_HASKELL__
 263 installHandler =
 264   error "installHandler: not available for Parallel Haskell"
 265 #else
 266
 267 installHandler int handler maybe_mask = do
 268     case maybe_mask of
 269         Nothing -> install' nullPtr
 270         Just (SignalSet x) -> withForeignPtr x $ install'
 271   where
 272     install' mask =
 273       alloca $ \p_sp -> do
 274
 275       rc <- case handler of
 276               Default -> stg_sig_install int (#const STG_SIG_DFL) p_sp mask
 277               Ignore  -> stg_sig_install int (#const STG_SIG_IGN) p_sp mask
 278               Catch m -> install'' m p_sp mask int (#const STG_SIG_HAN)
 279               CatchOnce m -> install'' m p_sp mask int (#const STG_SIG_RST)
 280
 281       case rc of
 282         (#const STG_SIG_DFL) -> return Default
 283         (#const STG_SIG_IGN) -> return Ignore
 284         (#const STG_SIG_ERR) -> throwErrno "installHandler"
 285         (#const STG_SIG_HAN) -> do
 286                 m <- peekHandler p_sp
 287                 return (Catch m)
 288         (#const STG_SIG_RST) -> do
 289                 m <- peekHandler p_sp
 290                 return (CatchOnce m)
 291
 292     install'' m p_sp mask int reset = do
 293       sptr <- newStablePtr m
 294       poke p_sp sptr
 295       stg_sig_install int reset p_sp mask
 296
 297     peekHandler p_sp = do
 298       osptr <- peek p_sp
 299       deRefStablePtr osptr
 300
 301 foreign import ccall unsafe
 302   stg_sig_install :: CInt -> CInt -> Ptr (StablePtr (IO ())) -> Ptr CSigset
 303          -> IO CInt
 304
 305 #endif // !__PARALLEL_HASKELL__
 306
 307 -- -----------------------------------------------------------------------------
 308 -- Alarms
 309
 310 scheduleAlarm :: Int -> IO Int
 311 scheduleAlarm secs = do
 312    r <- c_alarm (fromIntegral secs)
 313    return (fromIntegral r)
 314
 315 foreign import ccall unsafe "alarm"
 316   c_alarm :: CUInt -> IO CUInt
 317
 318 -- -----------------------------------------------------------------------------
 319 -- The NOCLDSTOP flag
 320
 321 foreign import ccall "&nocldstop" nocldstop :: Ptr Int
 322
 323 -- | Tells the system whether or not to set the @SA_NOCLDSTOP@ flag when
 324 -- installing new signal handlers.
 325 setStoppedChildFlag :: Bool -> IO Bool
 326 setStoppedChildFlag b = do
 327     rc <- peek nocldstop
 328     poke nocldstop x
 329     return (rc == (0::Int))
 330   where
 331     x = case b of {True -> 0; False -> 1}
 332
 333 -- | Queries the current state of the stopped child flag.
 334 queryStoppedChildFlag :: IO Bool
 335 queryStoppedChildFlag = do
 336     rc <- peek nocldstop
 337     return (rc == (0::Int))
 338
 339 -- -----------------------------------------------------------------------------
 340 -- Manipulating signal sets
 341
 342 newtype SignalSet = SignalSet (ForeignPtr CSigset)
 343
 344 emptySignalSet :: SignalSet
 345 emptySignalSet = unsafePerformIO $ do
 346   fp <- mallocForeignPtrBytes sizeof_sigset_t
 347   throwErrnoIfMinus1_ "emptySignalSet" (withForeignPtr fp $ c_sigemptyset)
 348   return (SignalSet fp)
 349
 350 fullSignalSet :: SignalSet
 351 fullSignalSet = unsafePerformIO $ do
 352   fp <- mallocForeignPtrBytes sizeof_sigset_t
 353   throwErrnoIfMinus1_ "fullSignalSet" (withForeignPtr fp $ c_sigfillset)
 354   return (SignalSet fp)
 355
 356 infixr `addSignal`, `deleteSignal`
 357 addSignal :: Signal -> SignalSet -> SignalSet
 358 addSignal sig (SignalSet fp1) = unsafePerformIO $ do
 359   fp2 <- mallocForeignPtrBytes sizeof_sigset_t
 360   withForeignPtr fp1 $ \p1 ->
 361     withForeignPtr fp2 $ \p2 -> do
 362       copyBytes p2 p1 sizeof_sigset_t
 363       throwErrnoIfMinus1_ "addSignal" (c_sigaddset p2 sig)
 364   return (SignalSet fp2)
 365
 366 deleteSignal :: Signal -> SignalSet -> SignalSet
 367 deleteSignal sig (SignalSet fp1) = unsafePerformIO $ do
 368   fp2 <- mallocForeignPtrBytes sizeof_sigset_t
 369   withForeignPtr fp1 $ \p1 ->
 370     withForeignPtr fp2 $ \p2 -> do
 371       copyBytes p2 p1 sizeof_sigset_t
 372       throwErrnoIfMinus1_ "deleteSignal" (c_sigdelset p2 sig)
 373   return (SignalSet fp2)
 374
 375 inSignalSet :: Signal -> SignalSet -> Bool
 376 inSignalSet sig (SignalSet fp) = unsafePerformIO $
 377   withForeignPtr fp $ \p -> do
 378     r <- throwErrnoIfMinus1 "inSignalSet" (c_sigismember p sig)
 379     return (r /= 0)
 380
 381 getSignalMask :: IO SignalSet
 382 getSignalMask = do
 383   fp <- mallocForeignPtrBytes sizeof_sigset_t
 384   withForeignPtr fp $ \p ->
 385     throwErrnoIfMinus1_ "getSignalMask" (c_sigprocmask 0 p nullPtr)
 386   return (SignalSet fp)
 387
 388 sigProcMask :: String -> CInt -> SignalSet -> IO ()
 389 sigProcMask fn how (SignalSet set) =
 390   withForeignPtr set $ \p_set ->
 391     throwErrnoIfMinus1_ fn (c_sigprocmask how p_set nullPtr)
 392
 393 setSignalMask :: SignalSet -> IO ()
 394 setSignalMask set = sigProcMask "setSignalMask" c_SIG_SETMASK set
 395
 396 blockSignals :: SignalSet -> IO ()
 397 blockSignals set = sigProcMask "blockSignals" c_SIG_BLOCK set
 398
 399 unblockSignals :: SignalSet -> IO ()
 400 unblockSignals set = sigProcMask "unblockSignals" c_SIG_UNBLOCK set
 401
 402 getPendingSignals :: IO SignalSet
 403 getPendingSignals = do
 404   fp <- mallocForeignPtrBytes sizeof_sigset_t
 405   withForeignPtr fp $ \p ->
 406    throwErrnoIfMinus1_ "getPendingSignals" (c_sigpending p)
 407   return (SignalSet fp)
 408
 409 #ifndef cygwin32_TARGET_OS
 410 awaitSignal :: Maybe SignalSet -> IO ()
 411 awaitSignal maybe_sigset = do
 412   fp <- case maybe_sigset of
 413           Nothing -> do SignalSet fp <- getSignalMask; return fp
 414           Just (SignalSet fp) -> return fp
 415   withForeignPtr fp $ \p -> do
 416   c_sigsuspend p
 417   return ()
 418   -- ignore the return value; according to the docs it can only ever be
 419   -- (-1) with errno set to EINTR.
 420
 421 foreign import ccall unsafe "sigsuspend"
 422   c_sigsuspend :: Ptr CSigset -> IO CInt
 423 #endif
 424
 425 foreign import ccall unsafe "__hscore_sigdelset"
 426   c_sigdelset   :: Ptr CSigset -> CInt -> IO CInt
 427
 428 foreign import ccall unsafe "__hscore_sigfillset"
 429   c_sigfillset  :: Ptr CSigset -> IO CInt
 430
 431 foreign import ccall unsafe "__hscore_sigismember"
 432   c_sigismember :: Ptr CSigset -> CInt -> IO CInt
 433
 434 foreign import ccall unsafe "sigpending"
 435   c_sigpending :: Ptr CSigset -> IO CInt
 436
 437 foreign import ccall unsafe "__hsposix_SIG_BLOCK"   c_SIG_BLOCK   :: CInt
 438 foreign import ccall unsafe "__hsposix_SIG_SETMASK" c_SIG_SETMASK :: CInt
 439 foreign import ccall unsafe "__hsposix_SIG_UNBLOCK" c_SIG_UNBLOCK :: CInt
 440
 441 #endif /* mingw32_TARGET_OS */
 442