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 "ghcconfig.h"
17 module System.Posix.Signals (
18 #ifndef mingw32_TARGET_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,
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_TARGET_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__
107 import System.IO.Unsafe
108 import System.Posix.Types
109 import System.Posix.Internals
111 #ifndef mingw32_TARGET_OS
114 -- -----------------------------------------------------------------------------
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
144 sigPOLL = (#const SIGPOLL) :: CInt
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
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
175 foreign import ccall unsafe "__hsposix_SIGPOLL" sigPOLL :: CInt
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__ */
186 internalAbort ::Signal
187 internalAbort = sigABRT
189 realTimeAlarm :: Signal
190 realTimeAlarm = sigALRM
195 processStatusChanged :: Signal
196 processStatusChanged = sigCHLD
198 continueProcess :: Signal
199 continueProcess = sigCONT
201 floatingPointException :: Signal
202 floatingPointException = sigFPE
204 lostConnection :: Signal
205 lostConnection = sigHUP
207 illegalInstruction :: Signal
208 illegalInstruction = sigILL
210 keyboardSignal :: Signal
211 keyboardSignal = sigINT
213 killProcess :: Signal
214 killProcess = sigKILL
216 openEndedPipe :: Signal
217 openEndedPipe = sigPIPE
219 keyboardTermination :: Signal
220 keyboardTermination = sigQUIT
222 segmentationViolation :: Signal
223 segmentationViolation = sigSEGV
225 softwareStop :: Signal
226 softwareStop = sigSTOP
228 softwareTermination :: Signal
229 softwareTermination = sigTERM
231 keyboardStop :: Signal
232 keyboardStop = sigTSTP
234 backgroundRead :: Signal
235 backgroundRead = sigTTIN
237 backgroundWrite :: Signal
238 backgroundWrite = sigTTOU
240 userDefinedSignal1 :: Signal
241 userDefinedSignal1 = sigUSR1
243 userDefinedSignal2 :: Signal
244 userDefinedSignal2 = sigUSR2
247 pollableEvent :: Signal
248 pollableEvent = sigPOLL
251 profilingTimerExpired :: Signal
252 profilingTimerExpired = sigPROF
254 badSystemCall :: Signal
255 badSystemCall = sigSYS
257 breakpointTrap :: Signal
258 breakpointTrap = sigTRAP
260 urgentDataAvailable :: Signal
261 urgentDataAvailable = sigURG
263 virtualTimerExpired :: Signal
264 virtualTimerExpired = sigVTALRM
266 cpuTimeLimitExceeded :: Signal
267 cpuTimeLimitExceeded = sigXCPU
269 fileSizeLimitExceeded :: Signal
270 fileSizeLimitExceeded = sigXFSZ
272 -- -----------------------------------------------------------------------------
273 -- Signal-related functions
275 signalProcess :: Signal -> ProcessID -> IO ()
276 signalProcess sig pid
277 = throwErrnoIfMinus1_ "signalProcess" (c_kill (fromIntegral pid) sig)
279 foreign import ccall unsafe "kill"
280 c_kill :: CPid -> CInt -> IO CInt
282 signalProcessGroup :: Signal -> ProcessGroupID -> IO ()
283 signalProcessGroup sig pgid
284 = throwErrnoIfMinus1_ "signalProcessGroup" (c_killpg (fromIntegral pgid) sig)
286 foreign import ccall unsafe "killpg"
287 c_killpg :: CPid -> CInt -> IO CInt
289 raiseSignal :: Signal -> IO ()
290 raiseSignal sig = throwErrnoIfMinus1_ "raiseSignal" (c_raise sig)
292 #if defined(__GLASGOW_HASKELL__) && (defined(openbsd_TARGET_OS) || defined(freebsd_TARGET_OS))
293 foreign import ccall unsafe "genericRaise"
294 c_raise :: CInt -> IO CInt
296 foreign import ccall unsafe "raise"
297 c_raise :: CInt -> IO CInt
300 #ifdef __GLASGOW_HASKELL__
301 data Handler = Default
307 installHandler :: Signal
309 -> Maybe SignalSet -- other signals to block
310 -> IO Handler -- old handler
312 #ifdef __PARALLEL_HASKELL__
314 error "installHandler: not available for Parallel Haskell"
317 installHandler int handler maybe_mask = do
319 Nothing -> install' nullPtr
320 Just (SignalSet x) -> withForeignPtr x $ install'
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)
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
338 (#const STG_SIG_RST) -> do
339 m <- peekHandler p_sp
342 install'' m p_sp mask int reset = do
343 sptr <- newStablePtr m
345 stg_sig_install int reset p_sp mask
347 peekHandler p_sp = do
351 foreign import ccall unsafe
352 stg_sig_install :: CInt -> CInt -> Ptr (StablePtr (IO ())) -> Ptr CSigset
355 #endif /* !__PARALLEL_HASKELL__ */
356 #endif /* __GLASGOW_HASKELL__ */
358 -- -----------------------------------------------------------------------------
361 scheduleAlarm :: Int -> IO Int
362 scheduleAlarm secs = do
363 r <- c_alarm (fromIntegral secs)
364 return (fromIntegral r)
366 foreign import ccall unsafe "alarm"
367 c_alarm :: CUInt -> IO CUInt
369 #ifdef __GLASGOW_HASKELL__
370 -- -----------------------------------------------------------------------------
371 -- The NOCLDSTOP flag
373 foreign import ccall "&nocldstop" nocldstop :: Ptr Int
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
380 poke nocldstop $ fromEnum (not b)
381 return (rc == (0::Int))
383 -- | Queries the current state of the stopped child flag.
384 queryStoppedChildFlag :: IO Bool
385 queryStoppedChildFlag = do
387 return (rc == (0::Int))
388 #endif /* __GLASGOW_HASKELL__ */
390 -- -----------------------------------------------------------------------------
391 -- Manipulating signal sets
393 newtype SignalSet = SignalSet (ForeignPtr CSigset)
395 emptySignalSet :: SignalSet
396 emptySignalSet = unsafePerformIO $ do
397 fp <- mallocForeignPtrBytes sizeof_sigset_t
398 throwErrnoIfMinus1_ "emptySignalSet" (withForeignPtr fp $ c_sigemptyset)
399 return (SignalSet fp)
401 fullSignalSet :: SignalSet
402 fullSignalSet = unsafePerformIO $ do
403 fp <- mallocForeignPtrBytes sizeof_sigset_t
404 throwErrnoIfMinus1_ "fullSignalSet" (withForeignPtr fp $ c_sigfillset)
405 return (SignalSet fp)
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)
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)
426 inSignalSet :: Signal -> SignalSet -> Bool
427 inSignalSet sig (SignalSet fp) = unsafePerformIO $
428 withForeignPtr fp $ \p -> do
429 r <- throwErrnoIfMinus1 "inSignalSet" (c_sigismember p sig)
432 getSignalMask :: IO SignalSet
434 fp <- mallocForeignPtrBytes sizeof_sigset_t
435 withForeignPtr fp $ \p ->
436 throwErrnoIfMinus1_ "getSignalMask" (c_sigprocmask 0 nullPtr p)
437 return (SignalSet fp)
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)
444 setSignalMask :: SignalSet -> IO ()
445 setSignalMask set = sigProcMask "setSignalMask" c_SIG_SETMASK set
447 blockSignals :: SignalSet -> IO ()
448 blockSignals set = sigProcMask "blockSignals" c_SIG_BLOCK set
450 unblockSignals :: SignalSet -> IO ()
451 unblockSignals set = sigProcMask "unblockSignals" c_SIG_UNBLOCK set
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)
460 #ifndef cygwin32_TARGET_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
469 -- ignore the return value; according to the docs it can only ever be
470 -- (-1) with errno set to EINTR.
472 foreign import ccall unsafe "sigsuspend"
473 c_sigsuspend :: Ptr CSigset -> IO CInt
477 foreign import ccall unsafe "sigdelset"
478 c_sigdelset :: Ptr CSigset -> CInt -> IO CInt
480 foreign import ccall unsafe "sigfillset"
481 c_sigfillset :: Ptr CSigset -> IO CInt
483 foreign import ccall unsafe "sigismember"
484 c_sigismember :: Ptr CSigset -> CInt -> IO CInt
486 foreign import ccall unsafe "__hscore_sigdelset"
487 c_sigdelset :: Ptr CSigset -> CInt -> IO CInt
489 foreign import ccall unsafe "__hscore_sigfillset"
490 c_sigfillset :: Ptr CSigset -> IO CInt
492 foreign import ccall unsafe "__hscore_sigismember"
493 c_sigismember :: Ptr CSigset -> CInt -> IO CInt
494 #endif /* __HUGS__ */
496 foreign import ccall unsafe "sigpending"
497 c_sigpending :: Ptr CSigset -> IO CInt
500 c_SIG_BLOCK = (#const SIG_BLOCK) :: CInt
501 c_SIG_SETMASK = (#const SIG_SETMASK) :: CInt
502 c_SIG_UNBLOCK = (#const SIG_UNBLOCK) :: CInt
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__ */
509 #endif /* mingw32_TARGET_OS */