1 -----------------------------------------------------------------------------
3 -- Module : System.Posix.Signals
4 -- Copyright : (c) The University of Glasgow 2002
5 -- License : BSD-style (see the file libraries/base/LICENSE)
7 -- Maintainer : libraries@haskell.org
8 -- Stability : provisional
9 -- Portability : non-portable (requires POSIX)
11 -- POSIX signal support
13 -----------------------------------------------------------------------------
15 #include "HsBaseConfig.h"
17 module System.Posix.Signals (
18 #ifndef mingw32_HOST_OS
24 internalAbort, sigABRT,
25 realTimeAlarm, sigALRM,
27 processStatusChanged, sigCHLD,
28 continueProcess, sigCONT,
29 floatingPointException, sigFPE,
30 lostConnection, sigHUP,
31 illegalInstruction, sigILL,
32 keyboardSignal, sigINT,
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 CONST_SIGPOLL != -1
45 pollableEvent, sigPOLL,
47 profilingTimerExpired, sigPROF,
48 badSystemCall, sigSYS,
49 breakpointTrap, sigTRAP,
50 urgentDataAvailable, sigURG,
51 virtualTimerExpired, sigVTALRM,
52 cpuTimeLimitExceeded, sigXCPU,
53 fileSizeLimitExceeded, sigXFSZ,
60 #ifdef __GLASGOW_HASKELL__
68 emptySignalSet, fullSignalSet,
69 addSignal, deleteSignal, inSignalSet,
71 -- * The process signal mask
72 getSignalMask, setSignalMask, blockSignals, unblockSignals,
77 -- * Waiting for signals
79 #ifndef cygwin32_HOST_OS
83 #ifdef __GLASGOW_HASKELL__
84 -- * The @NOCLDSTOP@ flag
85 setStoppedChildFlag, queryStoppedChildFlag,
88 -- MISSING FUNCTIONALITY:
89 -- sigaction(), (inc. the sigaction structure + flags etc.)
90 -- the siginfo structure
92 -- sighold, sigignore, sigpause, sigrelse, sigset
97 import Prelude -- necessary to get dependencies right
101 import System.IO.Unsafe
102 import System.Posix.Types
103 import System.Posix.Internals
105 #ifndef mingw32_HOST_OS
108 #ifdef __GLASGOW_HASKELL__
110 import GHC.Conc ( ensureIOManagerIsRunning )
113 -- -----------------------------------------------------------------------------
122 sigABRT = CONST_SIGABRT
124 sigALRM = CONST_SIGALRM
126 sigBUS = CONST_SIGBUS
128 sigCHLD = CONST_SIGCHLD
130 sigCONT = CONST_SIGCONT
132 sigFPE = CONST_SIGFPE
134 sigHUP = CONST_SIGHUP
136 sigILL = CONST_SIGILL
138 sigINT = CONST_SIGINT
140 sigKILL = CONST_SIGKILL
142 sigPIPE = CONST_SIGPIPE
144 sigQUIT = CONST_SIGQUIT
146 sigSEGV = CONST_SIGSEGV
148 sigSTOP = CONST_SIGSTOP
150 sigTERM = CONST_SIGTERM
152 sigTSTP = CONST_SIGTSTP
154 sigTTIN = CONST_SIGTTIN
156 sigTTOU = CONST_SIGTTOU
158 sigUSR1 = CONST_SIGUSR1
160 sigUSR2 = CONST_SIGUSR2
162 sigPOLL = CONST_SIGPOLL
164 sigPROF = CONST_SIGPROF
166 sigSYS = CONST_SIGSYS
168 sigTRAP = CONST_SIGTRAP
170 sigURG = CONST_SIGURG
172 sigVTALRM = CONST_SIGVTALRM
174 sigXCPU = CONST_SIGXCPU
176 sigXFSZ = CONST_SIGXFSZ
178 internalAbort ::Signal
179 internalAbort = sigABRT
181 realTimeAlarm :: Signal
182 realTimeAlarm = sigALRM
187 processStatusChanged :: Signal
188 processStatusChanged = sigCHLD
190 continueProcess :: Signal
191 continueProcess = sigCONT
193 floatingPointException :: Signal
194 floatingPointException = sigFPE
196 lostConnection :: Signal
197 lostConnection = sigHUP
199 illegalInstruction :: Signal
200 illegalInstruction = sigILL
202 keyboardSignal :: Signal
203 keyboardSignal = sigINT
205 killProcess :: Signal
206 killProcess = sigKILL
208 openEndedPipe :: Signal
209 openEndedPipe = sigPIPE
211 keyboardTermination :: Signal
212 keyboardTermination = sigQUIT
214 segmentationViolation :: Signal
215 segmentationViolation = sigSEGV
217 softwareStop :: Signal
218 softwareStop = sigSTOP
220 softwareTermination :: Signal
221 softwareTermination = sigTERM
223 keyboardStop :: Signal
224 keyboardStop = sigTSTP
226 backgroundRead :: Signal
227 backgroundRead = sigTTIN
229 backgroundWrite :: Signal
230 backgroundWrite = sigTTOU
232 userDefinedSignal1 :: Signal
233 userDefinedSignal1 = sigUSR1
235 userDefinedSignal2 :: Signal
236 userDefinedSignal2 = sigUSR2
238 #if CONST_SIGPOLL != -1
239 pollableEvent :: Signal
240 pollableEvent = sigPOLL
243 profilingTimerExpired :: Signal
244 profilingTimerExpired = sigPROF
246 badSystemCall :: Signal
247 badSystemCall = sigSYS
249 breakpointTrap :: Signal
250 breakpointTrap = sigTRAP
252 urgentDataAvailable :: Signal
253 urgentDataAvailable = sigURG
255 virtualTimerExpired :: Signal
256 virtualTimerExpired = sigVTALRM
258 cpuTimeLimitExceeded :: Signal
259 cpuTimeLimitExceeded = sigXCPU
261 fileSizeLimitExceeded :: Signal
262 fileSizeLimitExceeded = sigXFSZ
264 -- -----------------------------------------------------------------------------
265 -- Signal-related functions
267 -- | @signalProcess int pid@ calls @kill@ to signal process @pid@
268 -- with interrupt signal @int@.
269 signalProcess :: Signal -> ProcessID -> IO ()
270 signalProcess sig pid
271 = throwErrnoIfMinus1_ "signalProcess" (c_kill (fromIntegral pid) sig)
273 foreign import ccall unsafe "kill"
274 c_kill :: CPid -> CInt -> IO CInt
277 -- | @signalProcessGroup int pgid@ calls @kill@ to signal
278 -- all processes in group @pgid@ with interrupt signal @int@.
279 signalProcessGroup :: Signal -> ProcessGroupID -> IO ()
280 signalProcessGroup sig pgid
281 = throwErrnoIfMinus1_ "signalProcessGroup" (c_killpg (fromIntegral pgid) sig)
283 foreign import ccall unsafe "killpg"
284 c_killpg :: CPid -> CInt -> IO CInt
286 -- | @raiseSignal int@ calls @kill@ to signal the current process
287 -- with interrupt signal @int@.
288 raiseSignal :: Signal -> IO ()
289 raiseSignal sig = throwErrnoIfMinus1_ "raiseSignal" (c_raise sig)
291 #if defined(__GLASGOW_HASKELL__) && (defined(openbsd_HOST_OS) || defined(freebsd_HOST_OS))
292 foreign import ccall unsafe "genericRaise"
293 c_raise :: CInt -> IO CInt
295 foreign import ccall unsafe "raise"
296 c_raise :: CInt -> IO CInt
299 #ifdef __GLASGOW_HASKELL__
300 data Handler = Default
306 -- | @installHandler int handler iset@ calls @sigaction@ to install an
307 -- interrupt handler for signal @int@. If @handler@ is @Default@,
308 -- @SIG_DFL@ is installed; if @handler@ is @Ignore@, @SIG_IGN@ is
309 -- installed; if @handler@ is @Catch action@, a handler is installed
310 -- which will invoke @action@ in a new thread when (or shortly after) the
311 -- signal is received.
312 -- If @iset@ is @Just s@, then the @sa_mask@ of the @sigaction@ structure
313 -- is set to @s@; otherwise it is cleared. The previously installed
314 -- signal handler for @int@ is returned
315 installHandler :: Signal
317 -> Maybe SignalSet -- ^ other signals to block
318 -> IO Handler -- ^ old handler
320 #ifdef __PARALLEL_HASKELL__
322 error "installHandler: not available for Parallel Haskell"
325 installHandler int handler maybe_mask = do
326 ensureIOManagerIsRunning -- for the threaded RTS
328 Nothing -> install' nullPtr
329 Just (SignalSet x) -> withForeignPtr x $ install'
334 rc <- case handler of
335 Default -> stg_sig_install int STG_SIG_DFL p_sp mask
336 Ignore -> stg_sig_install int STG_SIG_IGN p_sp mask
337 Catch m -> hinstall m p_sp mask int STG_SIG_HAN
338 CatchOnce m -> hinstall m p_sp mask int STG_SIG_RST
341 STG_SIG_DFL -> return Default
342 STG_SIG_IGN -> return Ignore
343 STG_SIG_ERR -> throwErrno "installHandler"
345 m <- peekHandler p_sp
348 m <- peekHandler p_sp
351 error "internal error: System.Posix.Signals.installHandler"
353 hinstall m p_sp mask int reset = do
354 sptr <- newStablePtr m
356 stg_sig_install int reset p_sp mask
358 peekHandler p_sp = do
362 foreign import ccall unsafe
365 -> CInt -- action code (STG_SIG_HAN etc.)
366 -> Ptr (StablePtr (IO ())) -- (in, out) Haskell handler
367 -> Ptr CSigset -- (in, out) blocked
368 -> IO CInt -- (ret) action code
370 #endif /* !__PARALLEL_HASKELL__ */
371 #endif /* __GLASGOW_HASKELL__ */
373 -- -----------------------------------------------------------------------------
376 -- | @scheduleAlarm i@ calls @alarm@ to schedule a real time
377 -- alarm at least @i@ seconds in the future.
378 scheduleAlarm :: Int -> IO Int
379 scheduleAlarm secs = do
380 r <- c_alarm (fromIntegral secs)
381 return (fromIntegral r)
383 foreign import ccall unsafe "alarm"
384 c_alarm :: CUInt -> IO CUInt
386 #ifdef __GLASGOW_HASKELL__
387 -- -----------------------------------------------------------------------------
388 -- The NOCLDSTOP flag
390 foreign import ccall "&nocldstop" nocldstop :: Ptr Int
392 -- | Tells the system whether or not to set the @SA_NOCLDSTOP@ flag when
393 -- installing new signal handlers.
394 setStoppedChildFlag :: Bool -> IO Bool
395 setStoppedChildFlag b = do
397 poke nocldstop $ fromEnum (not b)
398 return (rc == (0::Int))
400 -- | Queries the current state of the stopped child flag.
401 queryStoppedChildFlag :: IO Bool
402 queryStoppedChildFlag = do
404 return (rc == (0::Int))
405 #endif /* __GLASGOW_HASKELL__ */
407 -- -----------------------------------------------------------------------------
408 -- Manipulating signal sets
410 newtype SignalSet = SignalSet (ForeignPtr CSigset)
412 emptySignalSet :: SignalSet
413 emptySignalSet = unsafePerformIO $ do
414 fp <- mallocForeignPtrBytes sizeof_sigset_t
415 throwErrnoIfMinus1_ "emptySignalSet" (withForeignPtr fp $ c_sigemptyset)
416 return (SignalSet fp)
418 fullSignalSet :: SignalSet
419 fullSignalSet = unsafePerformIO $ do
420 fp <- mallocForeignPtrBytes sizeof_sigset_t
421 throwErrnoIfMinus1_ "fullSignalSet" (withForeignPtr fp $ c_sigfillset)
422 return (SignalSet fp)
424 infixr `addSignal`, `deleteSignal`
425 addSignal :: Signal -> SignalSet -> SignalSet
426 addSignal sig (SignalSet fp1) = unsafePerformIO $ do
427 fp2 <- mallocForeignPtrBytes sizeof_sigset_t
428 withForeignPtr fp1 $ \p1 ->
429 withForeignPtr fp2 $ \p2 -> do
430 copyBytes p2 p1 sizeof_sigset_t
431 throwErrnoIfMinus1_ "addSignal" (c_sigaddset p2 sig)
432 return (SignalSet fp2)
434 deleteSignal :: Signal -> SignalSet -> SignalSet
435 deleteSignal sig (SignalSet fp1) = unsafePerformIO $ do
436 fp2 <- mallocForeignPtrBytes sizeof_sigset_t
437 withForeignPtr fp1 $ \p1 ->
438 withForeignPtr fp2 $ \p2 -> do
439 copyBytes p2 p1 sizeof_sigset_t
440 throwErrnoIfMinus1_ "deleteSignal" (c_sigdelset p2 sig)
441 return (SignalSet fp2)
443 inSignalSet :: Signal -> SignalSet -> Bool
444 inSignalSet sig (SignalSet fp) = unsafePerformIO $
445 withForeignPtr fp $ \p -> do
446 r <- throwErrnoIfMinus1 "inSignalSet" (c_sigismember p sig)
449 -- | @getSignalMask@ calls @sigprocmask@ to determine the
450 -- set of interrupts which are currently being blocked.
451 getSignalMask :: IO SignalSet
453 fp <- mallocForeignPtrBytes sizeof_sigset_t
454 withForeignPtr fp $ \p ->
455 throwErrnoIfMinus1_ "getSignalMask" (c_sigprocmask 0 nullPtr p)
456 return (SignalSet fp)
458 sigProcMask :: String -> CInt -> SignalSet -> IO ()
459 sigProcMask fn how (SignalSet set) =
460 withForeignPtr set $ \p_set ->
461 throwErrnoIfMinus1_ fn (c_sigprocmask how p_set nullPtr)
463 -- | @setSignalMask mask@ calls @sigprocmask@ with
464 -- @SIG_SETMASK@ to block all interrupts in @mask@.
465 setSignalMask :: SignalSet -> IO ()
466 setSignalMask set = sigProcMask "setSignalMask" (CONST_SIG_SETMASK :: CInt) set
468 -- | @blockSignals mask@ calls @sigprocmask@ with
469 -- @SIG_BLOCK@ to add all interrupts in @mask@ to the
470 -- set of blocked interrupts.
471 blockSignals :: SignalSet -> IO ()
472 blockSignals set = sigProcMask "blockSignals" (CONST_SIG_BLOCK :: CInt) set
474 -- | @unblockSignals mask@ calls @sigprocmask@ with
475 -- @SIG_UNBLOCK@ to remove all interrupts in @mask@ from the
476 -- set of blocked interrupts.
477 unblockSignals :: SignalSet -> IO ()
478 unblockSignals set = sigProcMask "unblockSignals" (CONST_SIG_UNBLOCK :: CInt) set
480 -- | @getPendingSignals@ calls @sigpending@ to obtain
481 -- the set of interrupts which have been received but are currently blocked.
482 getPendingSignals :: IO SignalSet
483 getPendingSignals = do
484 fp <- mallocForeignPtrBytes sizeof_sigset_t
485 withForeignPtr fp $ \p ->
486 throwErrnoIfMinus1_ "getPendingSignals" (c_sigpending p)
487 return (SignalSet fp)
489 #ifndef cygwin32_HOST_OS
491 -- | @awaitSignal iset@ suspends execution until an interrupt is received.
492 -- If @iset@ is @Just s@, @awaitSignal@ calls @sigsuspend@, installing
493 -- @s@ as the new signal mask before suspending execution; otherwise, it
494 -- calls @pause@. @awaitSignal@ returns on receipt of a signal. If you
495 -- have installed any signal handlers with @installHandler@, it may be
496 -- wise to call @yield@ directly after @awaitSignal@ to ensure that the
497 -- signal handler runs as promptly as possible.
498 awaitSignal :: Maybe SignalSet -> IO ()
499 awaitSignal maybe_sigset = do
500 fp <- case maybe_sigset of
501 Nothing -> do SignalSet fp <- getSignalMask; return fp
502 Just (SignalSet fp) -> return fp
503 withForeignPtr fp $ \p -> do
506 -- ignore the return value; according to the docs it can only ever be
507 -- (-1) with errno set to EINTR.
509 foreign import ccall unsafe "sigsuspend"
510 c_sigsuspend :: Ptr CSigset -> IO CInt
514 foreign import ccall unsafe "sigdelset"
515 c_sigdelset :: Ptr CSigset -> CInt -> IO CInt
517 foreign import ccall unsafe "sigfillset"
518 c_sigfillset :: Ptr CSigset -> IO CInt
520 foreign import ccall unsafe "sigismember"
521 c_sigismember :: Ptr CSigset -> CInt -> IO CInt
523 foreign import ccall unsafe "__hscore_sigdelset"
524 c_sigdelset :: Ptr CSigset -> CInt -> IO CInt
526 foreign import ccall unsafe "__hscore_sigfillset"
527 c_sigfillset :: Ptr CSigset -> IO CInt
529 foreign import ccall unsafe "__hscore_sigismember"
530 c_sigismember :: Ptr CSigset -> CInt -> IO CInt
531 #endif /* __HUGS__ */
533 foreign import ccall unsafe "sigpending"
534 c_sigpending :: Ptr CSigset -> IO CInt
536 #endif /* mingw32_HOST_OS */