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
99 #ifdef __GLASGOW_HASKELL__
101 import GHC.Conc ( ensureIOManagerIsRunning )
106 import System.IO.Unsafe
107 import System.Posix.Types
108 import System.Posix.Internals
110 #ifndef mingw32_HOST_OS
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 :: Signal -> ProcessID -> IO ()
268 signalProcess sig pid
269 = throwErrnoIfMinus1_ "signalProcess" (c_kill (fromIntegral pid) sig)
271 foreign import ccall unsafe "kill"
272 c_kill :: CPid -> CInt -> IO CInt
274 signalProcessGroup :: Signal -> ProcessGroupID -> IO ()
275 signalProcessGroup sig pgid
276 = throwErrnoIfMinus1_ "signalProcessGroup" (c_killpg (fromIntegral pgid) sig)
278 foreign import ccall unsafe "killpg"
279 c_killpg :: CPid -> CInt -> IO CInt
281 raiseSignal :: Signal -> IO ()
282 raiseSignal sig = throwErrnoIfMinus1_ "raiseSignal" (c_raise sig)
284 #if defined(__GLASGOW_HASKELL__) && (defined(openbsd_HOST_OS) || defined(freebsd_HOST_OS))
285 foreign import ccall unsafe "genericRaise"
286 c_raise :: CInt -> IO CInt
288 foreign import ccall unsafe "raise"
289 c_raise :: CInt -> IO CInt
292 #ifdef __GLASGOW_HASKELL__
293 data Handler = Default
299 installHandler :: Signal
301 -> Maybe SignalSet -- other signals to block
302 -> IO Handler -- old handler
304 #ifdef __PARALLEL_HASKELL__
306 error "installHandler: not available for Parallel Haskell"
309 installHandler int handler maybe_mask = do
310 ensureIOManagerIsRunning -- for the threaded RTS
312 Nothing -> install' nullPtr
313 Just (SignalSet x) -> withForeignPtr x $ install'
318 rc <- case handler of
319 Default -> stg_sig_install int STG_SIG_DFL p_sp mask
320 Ignore -> stg_sig_install int STG_SIG_IGN p_sp mask
321 Catch m -> hinstall m p_sp mask int STG_SIG_HAN
322 CatchOnce m -> hinstall m p_sp mask int STG_SIG_RST
325 STG_SIG_DFL -> return Default
326 STG_SIG_IGN -> return Ignore
327 STG_SIG_ERR -> throwErrno "installHandler"
329 m <- peekHandler p_sp
332 m <- peekHandler p_sp
335 error "internal error: System.Posix.Signals.installHandler"
337 hinstall m p_sp mask int reset = do
338 sptr <- newStablePtr m
340 stg_sig_install int reset p_sp mask
342 peekHandler p_sp = do
346 foreign import ccall unsafe
349 -> CInt -- action code (STG_SIG_HAN etc.)
350 -> Ptr (StablePtr (IO ())) -- (in, out) Haskell handler
351 -> Ptr CSigset -- (in, out) blocked
352 -> IO CInt -- (ret) action code
354 #endif /* !__PARALLEL_HASKELL__ */
355 #endif /* __GLASGOW_HASKELL__ */
357 -- -----------------------------------------------------------------------------
360 scheduleAlarm :: Int -> IO Int
361 scheduleAlarm secs = do
362 r <- c_alarm (fromIntegral secs)
363 return (fromIntegral r)
365 foreign import ccall unsafe "alarm"
366 c_alarm :: CUInt -> IO CUInt
368 #ifdef __GLASGOW_HASKELL__
369 -- -----------------------------------------------------------------------------
370 -- The NOCLDSTOP flag
372 foreign import ccall "&nocldstop" nocldstop :: Ptr Int
374 -- | Tells the system whether or not to set the @SA_NOCLDSTOP@ flag when
375 -- installing new signal handlers.
376 setStoppedChildFlag :: Bool -> IO Bool
377 setStoppedChildFlag b = do
379 poke nocldstop $ fromEnum (not b)
380 return (rc == (0::Int))
382 -- | Queries the current state of the stopped child flag.
383 queryStoppedChildFlag :: IO Bool
384 queryStoppedChildFlag = do
386 return (rc == (0::Int))
387 #endif /* __GLASGOW_HASKELL__ */
389 -- -----------------------------------------------------------------------------
390 -- Manipulating signal sets
392 newtype SignalSet = SignalSet (ForeignPtr CSigset)
394 emptySignalSet :: SignalSet
395 emptySignalSet = unsafePerformIO $ do
396 fp <- mallocForeignPtrBytes sizeof_sigset_t
397 throwErrnoIfMinus1_ "emptySignalSet" (withForeignPtr fp $ c_sigemptyset)
398 return (SignalSet fp)
400 fullSignalSet :: SignalSet
401 fullSignalSet = unsafePerformIO $ do
402 fp <- mallocForeignPtrBytes sizeof_sigset_t
403 throwErrnoIfMinus1_ "fullSignalSet" (withForeignPtr fp $ c_sigfillset)
404 return (SignalSet fp)
406 infixr `addSignal`, `deleteSignal`
407 addSignal :: Signal -> SignalSet -> SignalSet
408 addSignal sig (SignalSet fp1) = unsafePerformIO $ do
409 fp2 <- mallocForeignPtrBytes sizeof_sigset_t
410 withForeignPtr fp1 $ \p1 ->
411 withForeignPtr fp2 $ \p2 -> do
412 copyBytes p2 p1 sizeof_sigset_t
413 throwErrnoIfMinus1_ "addSignal" (c_sigaddset p2 sig)
414 return (SignalSet fp2)
416 deleteSignal :: Signal -> SignalSet -> SignalSet
417 deleteSignal sig (SignalSet fp1) = unsafePerformIO $ do
418 fp2 <- mallocForeignPtrBytes sizeof_sigset_t
419 withForeignPtr fp1 $ \p1 ->
420 withForeignPtr fp2 $ \p2 -> do
421 copyBytes p2 p1 sizeof_sigset_t
422 throwErrnoIfMinus1_ "deleteSignal" (c_sigdelset p2 sig)
423 return (SignalSet fp2)
425 inSignalSet :: Signal -> SignalSet -> Bool
426 inSignalSet sig (SignalSet fp) = unsafePerformIO $
427 withForeignPtr fp $ \p -> do
428 r <- throwErrnoIfMinus1 "inSignalSet" (c_sigismember p sig)
431 getSignalMask :: IO SignalSet
433 fp <- mallocForeignPtrBytes sizeof_sigset_t
434 withForeignPtr fp $ \p ->
435 throwErrnoIfMinus1_ "getSignalMask" (c_sigprocmask 0 nullPtr p)
436 return (SignalSet fp)
438 sigProcMask :: String -> CInt -> SignalSet -> IO ()
439 sigProcMask fn how (SignalSet set) =
440 withForeignPtr set $ \p_set ->
441 throwErrnoIfMinus1_ fn (c_sigprocmask how p_set nullPtr)
443 setSignalMask :: SignalSet -> IO ()
444 setSignalMask set = sigProcMask "setSignalMask" (CONST_SIG_SETMASK :: CInt) set
446 blockSignals :: SignalSet -> IO ()
447 blockSignals set = sigProcMask "blockSignals" (CONST_SIG_BLOCK :: CInt) set
449 unblockSignals :: SignalSet -> IO ()
450 unblockSignals set = sigProcMask "unblockSignals" (CONST_SIG_UNBLOCK :: CInt) set
452 getPendingSignals :: IO SignalSet
453 getPendingSignals = do
454 fp <- mallocForeignPtrBytes sizeof_sigset_t
455 withForeignPtr fp $ \p ->
456 throwErrnoIfMinus1_ "getPendingSignals" (c_sigpending p)
457 return (SignalSet fp)
459 #ifndef cygwin32_HOST_OS
460 awaitSignal :: Maybe SignalSet -> IO ()
461 awaitSignal maybe_sigset = do
462 fp <- case maybe_sigset of
463 Nothing -> do SignalSet fp <- getSignalMask; return fp
464 Just (SignalSet fp) -> return fp
465 withForeignPtr fp $ \p -> do
468 -- ignore the return value; according to the docs it can only ever be
469 -- (-1) with errno set to EINTR.
471 foreign import ccall unsafe "sigsuspend"
472 c_sigsuspend :: Ptr CSigset -> IO CInt
476 foreign import ccall unsafe "sigdelset"
477 c_sigdelset :: Ptr CSigset -> CInt -> IO CInt
479 foreign import ccall unsafe "sigfillset"
480 c_sigfillset :: Ptr CSigset -> IO CInt
482 foreign import ccall unsafe "sigismember"
483 c_sigismember :: Ptr CSigset -> CInt -> IO CInt
485 foreign import ccall unsafe "__hscore_sigdelset"
486 c_sigdelset :: Ptr CSigset -> CInt -> IO CInt
488 foreign import ccall unsafe "__hscore_sigfillset"
489 c_sigfillset :: Ptr CSigset -> IO CInt
491 foreign import ccall unsafe "__hscore_sigismember"
492 c_sigismember :: Ptr CSigset -> CInt -> IO CInt
493 #endif /* __HUGS__ */
495 foreign import ccall unsafe "sigpending"
496 c_sigpending :: Ptr CSigset -> IO CInt
498 #endif /* mingw32_HOST_OS */