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 "ghcconfig.h"
  16
  17 module System.Posix.Signals (
  18 #ifndef mingw32_HOST_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 #ifdef 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 #ifdef __GLASGOW_HASKELL__
  61   -- * Handling signals
  62   Handler(..),
  63   installHandler,
  64 #endif
  65
  66   -- * Signal sets
  67   SignalSet,
  68   emptySignalSet, fullSignalSet,
  69   addSignal, deleteSignal, inSignalSet,
  70
  71   -- * The process signal mask
  72   getSignalMask, setSignalMask, blockSignals, unblockSignals,
  73
  74   -- * The alarm timer
  75   scheduleAlarm,
  76
  77   -- * Waiting for signals
  78   getPendingSignals,
  79 #ifndef cygwin32_HOST_OS
  80   awaitSignal,
  81 #endif
  82
  83 #ifdef __GLASGOW_HASKELL__
  84   -- * The @NOCLDSTOP@ flag
  85   setStoppedChildFlag, queryStoppedChildFlag,
  86 #endif
  87
  88   -- MISSING FUNCTIONALITY:
  89   -- sigaction(), (inc. the sigaction structure + flags etc.)
  90   -- the siginfo structure
  91   -- sigaltstack()
  92   -- sighold, sigignore, sigpause, sigrelse, sigset
  93   -- siginterrupt
  94 #endif
  95   ) where
  96
  97 import Prelude -- necessary to get dependencies right
  98
  99 #ifdef __GLASGOW_HASKELL__
 100 #include "Signals.h"
 101 #else
 102 #include "HsBase.h"
 103 #endif
 104
 105 import Foreign
 106 import Foreign.C
 107 import System.IO.Unsafe
 108 import System.Posix.Types
 109 import System.Posix.Internals
 110
 111 #ifndef mingw32_HOST_OS
 112 -- WHOLE FILE...
 113
 114 -- -----------------------------------------------------------------------------
 115 -- Specific signals
 116
 117 type Signal = CInt
 118
 119 nullSignal :: Signal
 120 nullSignal = 0
 121
 122 #ifdef __HUGS__
 123 sigABRT   = (#const SIGABRT)   :: CInt
 124 sigALRM   = (#const SIGALRM)   :: CInt
 125 sigBUS    = (#const SIGBUS)    :: CInt
 126 sigCHLD   = (#const SIGCHLD)   :: CInt
 127 sigCONT   = (#const SIGCONT)   :: CInt
 128 sigFPE    = (#const SIGFPE)    :: CInt
 129 sigHUP    = (#const SIGHUP)    :: CInt
 130 sigILL    = (#const SIGILL)    :: CInt
 131 sigINT    = (#const SIGINT)    :: CInt
 132 sigKILL   = (#const SIGKILL)   :: CInt
 133 sigPIPE   = (#const SIGPIPE)   :: CInt
 134 sigQUIT   = (#const SIGQUIT)   :: CInt
 135 sigSEGV   = (#const SIGSEGV)   :: CInt
 136 sigSTOP   = (#const SIGSTOP)   :: CInt
 137 sigTERM   = (#const SIGTERM)   :: CInt
 138 sigTSTP   = (#const SIGTSTP)   :: CInt
 139 sigTTIN   = (#const SIGTTIN)   :: CInt
 140 sigTTOU   = (#const SIGTTOU)   :: CInt
 141 sigUSR1   = (#const SIGUSR1)   :: CInt
 142 sigUSR2   = (#const SIGUSR2)   :: CInt
 143 #ifdef SIGPOLL
 144 sigPOLL   = (#const SIGPOLL)   :: CInt
 145 #endif
 146 sigPROF   = (#const SIGPROF)   :: CInt
 147 sigSYS    = (#const SIGSYS)    :: CInt
 148 sigTRAP   = (#const SIGTRAP)   :: CInt
 149 sigURG    = (#const SIGURG)    :: CInt
 150 sigVTALRM = (#const SIGVTALRM) :: CInt
 151 sigXCPU   = (#const SIGXCPU)   :: CInt
 152 sigXFSZ   = (#const SIGXFSZ)   :: CInt
 153 #else
 154 foreign import ccall unsafe "__hsposix_SIGABRT"   sigABRT   :: CInt
 155 foreign import ccall unsafe "__hsposix_SIGALRM"   sigALRM   :: CInt
 156 foreign import ccall unsafe "__hsposix_SIGBUS"    sigBUS    :: CInt
 157 foreign import ccall unsafe "__hsposix_SIGCHLD"   sigCHLD   :: CInt
 158 foreign import ccall unsafe "__hsposix_SIGCONT"   sigCONT   :: CInt
 159 foreign import ccall unsafe "__hsposix_SIGFPE"    sigFPE    :: CInt
 160 foreign import ccall unsafe "__hsposix_SIGHUP"    sigHUP    :: CInt
 161 foreign import ccall unsafe "__hsposix_SIGILL"    sigILL    :: CInt
 162 foreign import ccall unsafe "__hsposix_SIGINT"    sigINT    :: CInt
 163 foreign import ccall unsafe "__hsposix_SIGKILL"   sigKILL   :: CInt
 164 foreign import ccall unsafe "__hsposix_SIGPIPE"   sigPIPE   :: CInt
 165 foreign import ccall unsafe "__hsposix_SIGQUIT"   sigQUIT   :: CInt
 166 foreign import ccall unsafe "__hsposix_SIGSEGV"   sigSEGV   :: CInt
 167 foreign import ccall unsafe "__hsposix_SIGSTOP"   sigSTOP   :: CInt
 168 foreign import ccall unsafe "__hsposix_SIGTERM"   sigTERM   :: CInt
 169 foreign import ccall unsafe "__hsposix_SIGTSTP"   sigTSTP   :: CInt
 170 foreign import ccall unsafe "__hsposix_SIGTTIN"   sigTTIN   :: CInt
 171 foreign import ccall unsafe "__hsposix_SIGTTOU"   sigTTOU   :: CInt
 172 foreign import ccall unsafe "__hsposix_SIGUSR1"   sigUSR1   :: CInt
 173 foreign import ccall unsafe "__hsposix_SIGUSR2"   sigUSR2   :: CInt
 174 #ifdef SIGPOLL
 175 foreign import ccall unsafe "__hsposix_SIGPOLL"   sigPOLL   :: CInt
 176 #endif
 177 foreign import ccall unsafe "__hsposix_SIGPROF"   sigPROF   :: CInt
 178 foreign import ccall unsafe "__hsposix_SIGSYS"    sigSYS    :: CInt
 179 foreign import ccall unsafe "__hsposix_SIGTRAP"   sigTRAP   :: CInt
 180 foreign import ccall unsafe "__hsposix_SIGURG"    sigURG    :: CInt
 181 foreign import ccall unsafe "__hsposix_SIGVTALRM" sigVTALRM :: CInt
 182 foreign import ccall unsafe "__hsposix_SIGXCPU"   sigXCPU   :: CInt
 183 foreign import ccall unsafe "__hsposix_SIGXFSZ"   sigXFSZ   :: CInt
 184 #endif /* __HUGS__ */
 185
 186 internalAbort ::Signal
 187 internalAbort = sigABRT
 188
 189 realTimeAlarm :: Signal
 190 realTimeAlarm = sigALRM
 191
 192 busError :: Signal
 193 busError = sigBUS
 194
 195 processStatusChanged :: Signal
 196 processStatusChanged = sigCHLD
 197
 198 continueProcess :: Signal
 199 continueProcess = sigCONT
 200
 201 floatingPointException :: Signal
 202 floatingPointException = sigFPE
 203
 204 lostConnection :: Signal
 205 lostConnection = sigHUP
 206
 207 illegalInstruction :: Signal
 208 illegalInstruction = sigILL
 209
 210 keyboardSignal :: Signal
 211 keyboardSignal = sigINT
 212
 213 killProcess :: Signal
 214 killProcess = sigKILL
 215
 216 openEndedPipe :: Signal
 217 openEndedPipe = sigPIPE
 218
 219 keyboardTermination :: Signal
 220 keyboardTermination = sigQUIT
 221
 222 segmentationViolation :: Signal
 223 segmentationViolation = sigSEGV
 224
 225 softwareStop :: Signal
 226 softwareStop = sigSTOP
 227
 228 softwareTermination :: Signal
 229 softwareTermination = sigTERM
 230
 231 keyboardStop :: Signal
 232 keyboardStop = sigTSTP
 233
 234 backgroundRead :: Signal
 235 backgroundRead = sigTTIN
 236
 237 backgroundWrite :: Signal
 238 backgroundWrite = sigTTOU
 239
 240 userDefinedSignal1 :: Signal
 241 userDefinedSignal1 = sigUSR1
 242
 243 userDefinedSignal2 :: Signal
 244 userDefinedSignal2 = sigUSR2
 245
 246 #ifdef SIGPOLL
 247 pollableEvent :: Signal
 248 pollableEvent = sigPOLL
 249 #endif
 250
 251 profilingTimerExpired :: Signal
 252 profilingTimerExpired = sigPROF
 253
 254 badSystemCall :: Signal
 255 badSystemCall = sigSYS
 256
 257 breakpointTrap :: Signal
 258 breakpointTrap = sigTRAP
 259
 260 urgentDataAvailable :: Signal
 261 urgentDataAvailable = sigURG
 262
 263 virtualTimerExpired :: Signal
 264 virtualTimerExpired = sigVTALRM
 265
 266 cpuTimeLimitExceeded :: Signal
 267 cpuTimeLimitExceeded = sigXCPU
 268
 269 fileSizeLimitExceeded :: Signal
 270 fileSizeLimitExceeded = sigXFSZ
 271
 272 -- -----------------------------------------------------------------------------
 273 -- Signal-related functions
 274
 275 signalProcess :: Signal -> ProcessID -> IO ()
 276 signalProcess sig pid
 277  = throwErrnoIfMinus1_ "signalProcess" (c_kill (fromIntegral pid) sig)
 278
 279 foreign import ccall unsafe "kill"
 280   c_kill :: CPid -> CInt -> IO CInt
 281
 282 signalProcessGroup :: Signal -> ProcessGroupID -> IO ()
 283 signalProcessGroup sig pgid
 284   = throwErrnoIfMinus1_ "signalProcessGroup" (c_killpg (fromIntegral pgid) sig)
 285
 286 foreign import ccall unsafe "killpg"
 287   c_killpg :: CPid -> CInt -> IO CInt
 288
 289 raiseSignal :: Signal -> IO ()
 290 raiseSignal sig = throwErrnoIfMinus1_ "raiseSignal" (c_raise sig)
 291
 292 #if defined(__GLASGOW_HASKELL__) && (defined(openbsd_HOST_OS) || defined(freebsd_HOST_OS))
 293 foreign import ccall unsafe "genericRaise"
 294   c_raise :: CInt -> IO CInt
 295 #else
 296 foreign import ccall unsafe "raise"
 297   c_raise :: CInt -> IO CInt
 298 #endif
 299
 300 #ifdef __GLASGOW_HASKELL__
 301 data Handler = Default
 302              | Ignore
 303              -- not yet: | Hold
 304              | Catch (IO ())
 305              | CatchOnce (IO ())
 306
 307 installHandler :: Signal
 308                -> Handler
 309                -> Maybe SignalSet       -- other signals to block
 310                -> IO Handler            -- old handler
 311
 312 #ifdef __PARALLEL_HASKELL__
 313 installHandler =
 314   error "installHandler: not available for Parallel Haskell"
 315 #else
 316
 317 installHandler int handler maybe_mask = do
 318     case maybe_mask of
 319         Nothing -> install' nullPtr
 320         Just (SignalSet x) -> withForeignPtr x $ install'
 321   where
 322     install' mask =
 323       alloca $ \p_sp -> do
 324
 325       rc <- case handler of
 326               Default -> stg_sig_install int (#const STG_SIG_DFL) p_sp mask
 327               Ignore  -> stg_sig_install int (#const STG_SIG_IGN) p_sp mask
 328               Catch m -> install'' m p_sp mask int (#const STG_SIG_HAN)
 329               CatchOnce m -> install'' m p_sp mask int (#const STG_SIG_RST)
 330
 331       case rc of
 332         (#const STG_SIG_DFL) -> return Default
 333         (#const STG_SIG_IGN) -> return Ignore
 334         (#const STG_SIG_ERR) -> throwErrno "installHandler"
 335         (#const STG_SIG_HAN) -> do
 336                 m <- peekHandler p_sp
 337                 return (Catch m)
 338         (#const STG_SIG_RST) -> do
 339                 m <- peekHandler p_sp
 340                 return (CatchOnce m)
 341
 342     install'' m p_sp mask int reset = do
 343       sptr <- newStablePtr m
 344       poke p_sp sptr
 345       stg_sig_install int reset p_sp mask
 346
 347     peekHandler p_sp = do
 348       osptr <- peek p_sp
 349       deRefStablePtr osptr
 350
 351 foreign import ccall unsafe
 352   stg_sig_install :: CInt -> CInt -> Ptr (StablePtr (IO ())) -> Ptr CSigset
 353          -> IO CInt
 354
 355 #endif /* !__PARALLEL_HASKELL__ */
 356 #endif /* __GLASGOW_HASKELL__ */
 357
 358 -- -----------------------------------------------------------------------------
 359 -- Alarms
 360
 361 scheduleAlarm :: Int -> IO Int
 362 scheduleAlarm secs = do
 363    r <- c_alarm (fromIntegral secs)
 364    return (fromIntegral r)
 365
 366 foreign import ccall unsafe "alarm"
 367   c_alarm :: CUInt -> IO CUInt
 368
 369 #ifdef __GLASGOW_HASKELL__
 370 -- -----------------------------------------------------------------------------
 371 -- The NOCLDSTOP flag
 372
 373 foreign import ccall "&nocldstop" nocldstop :: Ptr Int
 374
 375 -- | Tells the system whether or not to set the @SA_NOCLDSTOP@ flag when
 376 -- installing new signal handlers.
 377 setStoppedChildFlag :: Bool -> IO Bool
 378 setStoppedChildFlag b = do
 379     rc <- peek nocldstop
 380     poke nocldstop $ fromEnum (not b)
 381     return (rc == (0::Int))
 382
 383 -- | Queries the current state of the stopped child flag.
 384 queryStoppedChildFlag :: IO Bool
 385 queryStoppedChildFlag = do
 386     rc <- peek nocldstop
 387     return (rc == (0::Int))
 388 #endif /* __GLASGOW_HASKELL__ */
 389
 390 -- -----------------------------------------------------------------------------
 391 -- Manipulating signal sets
 392
 393 newtype SignalSet = SignalSet (ForeignPtr CSigset)
 394
 395 emptySignalSet :: SignalSet
 396 emptySignalSet = unsafePerformIO $ do
 397   fp <- mallocForeignPtrBytes sizeof_sigset_t
 398   throwErrnoIfMinus1_ "emptySignalSet" (withForeignPtr fp $ c_sigemptyset)
 399   return (SignalSet fp)
 400
 401 fullSignalSet :: SignalSet
 402 fullSignalSet = unsafePerformIO $ do
 403   fp <- mallocForeignPtrBytes sizeof_sigset_t
 404   throwErrnoIfMinus1_ "fullSignalSet" (withForeignPtr fp $ c_sigfillset)
 405   return (SignalSet fp)
 406
 407 infixr `addSignal`, `deleteSignal`
 408 addSignal :: Signal -> SignalSet -> SignalSet
 409 addSignal sig (SignalSet fp1) = unsafePerformIO $ do
 410   fp2 <- mallocForeignPtrBytes sizeof_sigset_t
 411   withForeignPtr fp1 $ \p1 ->
 412     withForeignPtr fp2 $ \p2 -> do
 413       copyBytes p2 p1 sizeof_sigset_t
 414       throwErrnoIfMinus1_ "addSignal" (c_sigaddset p2 sig)
 415   return (SignalSet fp2)
 416
 417 deleteSignal :: Signal -> SignalSet -> SignalSet
 418 deleteSignal sig (SignalSet fp1) = unsafePerformIO $ do
 419   fp2 <- mallocForeignPtrBytes sizeof_sigset_t
 420   withForeignPtr fp1 $ \p1 ->
 421     withForeignPtr fp2 $ \p2 -> do
 422       copyBytes p2 p1 sizeof_sigset_t
 423       throwErrnoIfMinus1_ "deleteSignal" (c_sigdelset p2 sig)
 424   return (SignalSet fp2)
 425
 426 inSignalSet :: Signal -> SignalSet -> Bool
 427 inSignalSet sig (SignalSet fp) = unsafePerformIO $
 428   withForeignPtr fp $ \p -> do
 429     r <- throwErrnoIfMinus1 "inSignalSet" (c_sigismember p sig)
 430     return (r /= 0)
 431
 432 getSignalMask :: IO SignalSet
 433 getSignalMask = do
 434   fp <- mallocForeignPtrBytes sizeof_sigset_t
 435   withForeignPtr fp $ \p ->
 436     throwErrnoIfMinus1_ "getSignalMask" (c_sigprocmask 0 nullPtr p)
 437   return (SignalSet fp)
 438
 439 sigProcMask :: String -> CInt -> SignalSet -> IO ()
 440 sigProcMask fn how (SignalSet set) =
 441   withForeignPtr set $ \p_set ->
 442     throwErrnoIfMinus1_ fn (c_sigprocmask how p_set nullPtr)
 443
 444 setSignalMask :: SignalSet -> IO ()
 445 setSignalMask set = sigProcMask "setSignalMask" c_SIG_SETMASK set
 446
 447 blockSignals :: SignalSet -> IO ()
 448 blockSignals set = sigProcMask "blockSignals" c_SIG_BLOCK set
 449
 450 unblockSignals :: SignalSet -> IO ()
 451 unblockSignals set = sigProcMask "unblockSignals" c_SIG_UNBLOCK set
 452
 453 getPendingSignals :: IO SignalSet
 454 getPendingSignals = do
 455   fp <- mallocForeignPtrBytes sizeof_sigset_t
 456   withForeignPtr fp $ \p ->
 457    throwErrnoIfMinus1_ "getPendingSignals" (c_sigpending p)
 458   return (SignalSet fp)
 459
 460 #ifndef cygwin32_HOST_OS
 461 awaitSignal :: Maybe SignalSet -> IO ()
 462 awaitSignal maybe_sigset = do
 463   fp <- case maybe_sigset of
 464           Nothing -> do SignalSet fp <- getSignalMask; return fp
 465           Just (SignalSet fp) -> return fp
 466   withForeignPtr fp $ \p -> do
 467   c_sigsuspend p
 468   return ()
 469   -- ignore the return value; according to the docs it can only ever be
 470   -- (-1) with errno set to EINTR.
 471
 472 foreign import ccall unsafe "sigsuspend"
 473   c_sigsuspend :: Ptr CSigset -> IO CInt
 474 #endif
 475
 476 #ifdef __HUGS__
 477 foreign import ccall unsafe "sigdelset"
 478   c_sigdelset   :: Ptr CSigset -> CInt -> IO CInt
 479
 480 foreign import ccall unsafe "sigfillset"
 481   c_sigfillset  :: Ptr CSigset -> IO CInt
 482
 483 foreign import ccall unsafe "sigismember"
 484   c_sigismember :: Ptr CSigset -> CInt -> IO CInt
 485 #else
 486 foreign import ccall unsafe "__hscore_sigdelset"
 487   c_sigdelset   :: Ptr CSigset -> CInt -> IO CInt
 488
 489 foreign import ccall unsafe "__hscore_sigfillset"
 490   c_sigfillset  :: Ptr CSigset -> IO CInt
 491
 492 foreign import ccall unsafe "__hscore_sigismember"
 493   c_sigismember :: Ptr CSigset -> CInt -> IO CInt
 494 #endif /* __HUGS__ */
 495
 496 foreign import ccall unsafe "sigpending"
 497   c_sigpending :: Ptr CSigset -> IO CInt
 498
 499 #ifdef __HUGS__
 500 c_SIG_BLOCK   = (#const SIG_BLOCK)   :: CInt
 501 c_SIG_SETMASK = (#const SIG_SETMASK) :: CInt
 502 c_SIG_UNBLOCK = (#const SIG_UNBLOCK) :: CInt
 503 #else
 504 foreign import ccall unsafe "__hsposix_SIG_BLOCK"   c_SIG_BLOCK   :: CInt
 505 foreign import ccall unsafe "__hsposix_SIG_SETMASK" c_SIG_SETMASK :: CInt
 506 foreign import ccall unsafe "__hsposix_SIG_UNBLOCK" c_SIG_UNBLOCK :: CInt
 507 #endif /* __HUGS__ */
 508
 509 #endif /* mingw32_HOST_OS */
 510