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 #ifdef __GLASGOW_HASKELL__
105 import System.IO.Unsafe
106 import System.Posix.Types
107 import System.Posix.Internals
109 #ifndef mingw32_TARGET_OS
112 -- -----------------------------------------------------------------------------
121 sigABRT = (#const SIGABRT) :: CInt
122 sigALRM = (#const SIGALRM) :: CInt
123 sigBUS = (#const SIGBUS) :: CInt
124 sigCHLD = (#const SIGCHLD) :: CInt
125 sigCONT = (#const SIGCONT) :: CInt
126 sigFPE = (#const SIGFPE) :: CInt
127 sigHUP = (#const SIGHUP) :: CInt
128 sigILL = (#const SIGILL) :: CInt
129 sigINT = (#const SIGINT) :: CInt
130 sigKILL = (#const SIGKILL) :: CInt
131 sigPIPE = (#const SIGPIPE) :: CInt
132 sigQUIT = (#const SIGQUIT) :: CInt
133 sigSEGV = (#const SIGSEGV) :: CInt
134 sigSTOP = (#const SIGSTOP) :: CInt
135 sigTERM = (#const SIGTERM) :: CInt
136 sigTSTP = (#const SIGTSTP) :: CInt
137 sigTTIN = (#const SIGTTIN) :: CInt
138 sigTTOU = (#const SIGTTOU) :: CInt
139 sigUSR1 = (#const SIGUSR1) :: CInt
140 sigUSR2 = (#const SIGUSR2) :: CInt
142 sigPOLL = (#const SIGPOLL) :: CInt
144 sigPROF = (#const SIGPROF) :: CInt
145 sigSYS = (#const SIGSYS) :: CInt
146 sigTRAP = (#const SIGTRAP) :: CInt
147 sigURG = (#const SIGURG) :: CInt
148 sigVTALRM = (#const SIGVTALRM) :: CInt
149 sigXCPU = (#const SIGXCPU) :: CInt
150 sigXFSZ = (#const SIGXFSZ) :: CInt
152 foreign import ccall unsafe "__hsposix_SIGABRT" sigABRT :: CInt
153 foreign import ccall unsafe "__hsposix_SIGALRM" sigALRM :: CInt
154 foreign import ccall unsafe "__hsposix_SIGBUS" sigBUS :: CInt
155 foreign import ccall unsafe "__hsposix_SIGCHLD" sigCHLD :: CInt
156 foreign import ccall unsafe "__hsposix_SIGCONT" sigCONT :: CInt
157 foreign import ccall unsafe "__hsposix_SIGFPE" sigFPE :: CInt
158 foreign import ccall unsafe "__hsposix_SIGHUP" sigHUP :: CInt
159 foreign import ccall unsafe "__hsposix_SIGILL" sigILL :: CInt
160 foreign import ccall unsafe "__hsposix_SIGINT" sigINT :: CInt
161 foreign import ccall unsafe "__hsposix_SIGKILL" sigKILL :: CInt
162 foreign import ccall unsafe "__hsposix_SIGPIPE" sigPIPE :: CInt
163 foreign import ccall unsafe "__hsposix_SIGQUIT" sigQUIT :: CInt
164 foreign import ccall unsafe "__hsposix_SIGSEGV" sigSEGV :: CInt
165 foreign import ccall unsafe "__hsposix_SIGSTOP" sigSTOP :: CInt
166 foreign import ccall unsafe "__hsposix_SIGTERM" sigTERM :: CInt
167 foreign import ccall unsafe "__hsposix_SIGTSTP" sigTSTP :: CInt
168 foreign import ccall unsafe "__hsposix_SIGTTIN" sigTTIN :: CInt
169 foreign import ccall unsafe "__hsposix_SIGTTOU" sigTTOU :: CInt
170 foreign import ccall unsafe "__hsposix_SIGUSR1" sigUSR1 :: CInt
171 foreign import ccall unsafe "__hsposix_SIGUSR2" sigUSR2 :: CInt
173 foreign import ccall unsafe "__hsposix_SIGPOLL" sigPOLL :: CInt
175 foreign import ccall unsafe "__hsposix_SIGPROF" sigPROF :: CInt
176 foreign import ccall unsafe "__hsposix_SIGSYS" sigSYS :: CInt
177 foreign import ccall unsafe "__hsposix_SIGTRAP" sigTRAP :: CInt
178 foreign import ccall unsafe "__hsposix_SIGURG" sigURG :: CInt
179 foreign import ccall unsafe "__hsposix_SIGVTALRM" sigVTALRM :: CInt
180 foreign import ccall unsafe "__hsposix_SIGXCPU" sigXCPU :: CInt
181 foreign import ccall unsafe "__hsposix_SIGXFSZ" sigXFSZ :: CInt
182 #endif /* __HUGS__ */
184 internalAbort ::Signal
185 internalAbort = sigABRT
187 realTimeAlarm :: Signal
188 realTimeAlarm = sigALRM
193 processStatusChanged :: Signal
194 processStatusChanged = sigCHLD
196 continueProcess :: Signal
197 continueProcess = sigCONT
199 floatingPointException :: Signal
200 floatingPointException = sigFPE
202 lostConnection :: Signal
203 lostConnection = sigHUP
205 illegalInstruction :: Signal
206 illegalInstruction = sigILL
208 keyboardSignal :: Signal
209 keyboardSignal = sigINT
211 killProcess :: Signal
212 killProcess = sigKILL
214 openEndedPipe :: Signal
215 openEndedPipe = sigPIPE
217 keyboardTermination :: Signal
218 keyboardTermination = sigQUIT
220 segmentationViolation :: Signal
221 segmentationViolation = sigSEGV
223 softwareStop :: Signal
224 softwareStop = sigSTOP
226 softwareTermination :: Signal
227 softwareTermination = sigTERM
229 keyboardStop :: Signal
230 keyboardStop = sigTSTP
232 backgroundRead :: Signal
233 backgroundRead = sigTTIN
235 backgroundWrite :: Signal
236 backgroundWrite = sigTTOU
238 userDefinedSignal1 :: Signal
239 userDefinedSignal1 = sigUSR1
241 userDefinedSignal2 :: Signal
242 userDefinedSignal2 = sigUSR2
245 pollableEvent :: Signal
246 pollableEvent = sigPOLL
249 profilingTimerExpired :: Signal
250 profilingTimerExpired = sigPROF
252 badSystemCall :: Signal
253 badSystemCall = sigSYS
255 breakpointTrap :: Signal
256 breakpointTrap = sigTRAP
258 urgentDataAvailable :: Signal
259 urgentDataAvailable = sigURG
261 virtualTimerExpired :: Signal
262 virtualTimerExpired = sigVTALRM
264 cpuTimeLimitExceeded :: Signal
265 cpuTimeLimitExceeded = sigXCPU
267 fileSizeLimitExceeded :: Signal
268 fileSizeLimitExceeded = sigXFSZ
270 -- -----------------------------------------------------------------------------
271 -- Signal-related functions
273 signalProcess :: Signal -> ProcessID -> IO ()
274 signalProcess sig pid
275 = throwErrnoIfMinus1_ "signalProcess" (c_kill (fromIntegral pid) sig)
277 foreign import ccall unsafe "kill"
278 c_kill :: CPid -> CInt -> IO CInt
280 signalProcessGroup :: Signal -> ProcessGroupID -> IO ()
281 signalProcessGroup sig pgid
282 = throwErrnoIfMinus1_ "signalProcessGroup" (c_killpg (fromIntegral pgid) sig)
284 foreign import ccall unsafe "killpg"
285 c_killpg :: CPid -> CInt -> IO CInt
287 raiseSignal :: Signal -> IO ()
288 raiseSignal sig = throwErrnoIfMinus1_ "raiseSignal" (c_raise sig)
290 foreign import ccall unsafe "raise"
291 c_raise :: CInt -> IO CInt
293 #ifdef __GLASGOW_HASKELL__
294 data Handler = Default
300 installHandler :: Signal
302 -> Maybe SignalSet -- other signals to block
303 -> IO Handler -- old handler
305 #ifdef __PARALLEL_HASKELL__
307 error "installHandler: not available for Parallel Haskell"
310 installHandler int handler maybe_mask = do
312 Nothing -> install' nullPtr
313 Just (SignalSet x) -> withForeignPtr x $ install'
318 rc <- case handler of
319 Default -> stg_sig_install int (#const STG_SIG_DFL) p_sp mask
320 Ignore -> stg_sig_install int (#const STG_SIG_IGN) p_sp mask
321 Catch m -> install'' m p_sp mask int (#const STG_SIG_HAN)
322 CatchOnce m -> install'' m p_sp mask int (#const STG_SIG_RST)
325 (#const STG_SIG_DFL) -> return Default
326 (#const STG_SIG_IGN) -> return Ignore
327 (#const STG_SIG_ERR) -> throwErrno "installHandler"
328 (#const STG_SIG_HAN) -> do
329 m <- peekHandler p_sp
331 (#const STG_SIG_RST) -> do
332 m <- peekHandler p_sp
335 install'' m p_sp mask int reset = do
336 sptr <- newStablePtr m
338 stg_sig_install int reset p_sp mask
340 peekHandler p_sp = do
344 foreign import ccall unsafe
345 stg_sig_install :: CInt -> CInt -> Ptr (StablePtr (IO ())) -> Ptr CSigset
348 #endif /* !__PARALLEL_HASKELL__ */
349 #endif /* __GLASGOW_HASKELL__ */
351 -- -----------------------------------------------------------------------------
354 scheduleAlarm :: Int -> IO Int
355 scheduleAlarm secs = do
356 r <- c_alarm (fromIntegral secs)
357 return (fromIntegral r)
359 foreign import ccall unsafe "alarm"
360 c_alarm :: CUInt -> IO CUInt
362 #ifdef __GLASGOW_HASKELL__
363 -- -----------------------------------------------------------------------------
364 -- The NOCLDSTOP flag
366 foreign import ccall "&nocldstop" nocldstop :: Ptr Int
368 -- | Tells the system whether or not to set the @SA_NOCLDSTOP@ flag when
369 -- installing new signal handlers.
370 setStoppedChildFlag :: Bool -> IO Bool
371 setStoppedChildFlag b = do
373 poke nocldstop $ fromEnum (not b)
374 return (rc == (0::Int))
376 -- | Queries the current state of the stopped child flag.
377 queryStoppedChildFlag :: IO Bool
378 queryStoppedChildFlag = do
380 return (rc == (0::Int))
381 #endif /* __GLASGOW_HASKELL__ */
383 -- -----------------------------------------------------------------------------
384 -- Manipulating signal sets
386 newtype SignalSet = SignalSet (ForeignPtr CSigset)
388 emptySignalSet :: SignalSet
389 emptySignalSet = unsafePerformIO $ do
390 fp <- mallocForeignPtrBytes sizeof_sigset_t
391 throwErrnoIfMinus1_ "emptySignalSet" (withForeignPtr fp $ c_sigemptyset)
392 return (SignalSet fp)
394 fullSignalSet :: SignalSet
395 fullSignalSet = unsafePerformIO $ do
396 fp <- mallocForeignPtrBytes sizeof_sigset_t
397 throwErrnoIfMinus1_ "fullSignalSet" (withForeignPtr fp $ c_sigfillset)
398 return (SignalSet fp)
400 infixr `addSignal`, `deleteSignal`
401 addSignal :: Signal -> SignalSet -> SignalSet
402 addSignal sig (SignalSet fp1) = unsafePerformIO $ do
403 fp2 <- mallocForeignPtrBytes sizeof_sigset_t
404 withForeignPtr fp1 $ \p1 ->
405 withForeignPtr fp2 $ \p2 -> do
406 copyBytes p2 p1 sizeof_sigset_t
407 throwErrnoIfMinus1_ "addSignal" (c_sigaddset p2 sig)
408 return (SignalSet fp2)
410 deleteSignal :: Signal -> SignalSet -> SignalSet
411 deleteSignal sig (SignalSet fp1) = unsafePerformIO $ do
412 fp2 <- mallocForeignPtrBytes sizeof_sigset_t
413 withForeignPtr fp1 $ \p1 ->
414 withForeignPtr fp2 $ \p2 -> do
415 copyBytes p2 p1 sizeof_sigset_t
416 throwErrnoIfMinus1_ "deleteSignal" (c_sigdelset p2 sig)
417 return (SignalSet fp2)
419 inSignalSet :: Signal -> SignalSet -> Bool
420 inSignalSet sig (SignalSet fp) = unsafePerformIO $
421 withForeignPtr fp $ \p -> do
422 r <- throwErrnoIfMinus1 "inSignalSet" (c_sigismember p sig)
425 getSignalMask :: IO SignalSet
427 fp <- mallocForeignPtrBytes sizeof_sigset_t
428 withForeignPtr fp $ \p ->
429 throwErrnoIfMinus1_ "getSignalMask" (c_sigprocmask 0 nullPtr p)
430 return (SignalSet fp)
432 sigProcMask :: String -> CInt -> SignalSet -> IO ()
433 sigProcMask fn how (SignalSet set) =
434 withForeignPtr set $ \p_set ->
435 throwErrnoIfMinus1_ fn (c_sigprocmask how p_set nullPtr)
437 setSignalMask :: SignalSet -> IO ()
438 setSignalMask set = sigProcMask "setSignalMask" c_SIG_SETMASK set
440 blockSignals :: SignalSet -> IO ()
441 blockSignals set = sigProcMask "blockSignals" c_SIG_BLOCK set
443 unblockSignals :: SignalSet -> IO ()
444 unblockSignals set = sigProcMask "unblockSignals" c_SIG_UNBLOCK set
446 getPendingSignals :: IO SignalSet
447 getPendingSignals = do
448 fp <- mallocForeignPtrBytes sizeof_sigset_t
449 withForeignPtr fp $ \p ->
450 throwErrnoIfMinus1_ "getPendingSignals" (c_sigpending p)
451 return (SignalSet fp)
453 #ifndef cygwin32_TARGET_OS
454 awaitSignal :: Maybe SignalSet -> IO ()
455 awaitSignal maybe_sigset = do
456 fp <- case maybe_sigset of
457 Nothing -> do SignalSet fp <- getSignalMask; return fp
458 Just (SignalSet fp) -> return fp
459 withForeignPtr fp $ \p -> do
462 -- ignore the return value; according to the docs it can only ever be
463 -- (-1) with errno set to EINTR.
465 foreign import ccall unsafe "sigsuspend"
466 c_sigsuspend :: Ptr CSigset -> IO CInt
470 foreign import ccall unsafe "sigdelset"
471 c_sigdelset :: Ptr CSigset -> CInt -> IO CInt
473 foreign import ccall unsafe "sigfillset"
474 c_sigfillset :: Ptr CSigset -> IO CInt
476 foreign import ccall unsafe "sigismember"
477 c_sigismember :: Ptr CSigset -> CInt -> IO CInt
479 foreign import ccall unsafe "__hscore_sigdelset"
480 c_sigdelset :: Ptr CSigset -> CInt -> IO CInt
482 foreign import ccall unsafe "__hscore_sigfillset"
483 c_sigfillset :: Ptr CSigset -> IO CInt
485 foreign import ccall unsafe "__hscore_sigismember"
486 c_sigismember :: Ptr CSigset -> CInt -> IO CInt
487 #endif /* __HUGS__ */
489 foreign import ccall unsafe "sigpending"
490 c_sigpending :: Ptr CSigset -> IO CInt
493 c_SIG_BLOCK = (#const SIG_BLOCK) :: CInt
494 c_SIG_SETMASK = (#const SIG_SETMASK) :: CInt
495 c_SIG_UNBLOCK = (#const SIG_UNBLOCK) :: CInt
497 foreign import ccall unsafe "__hsposix_SIG_BLOCK" c_SIG_BLOCK :: CInt
498 foreign import ccall unsafe "__hsposix_SIG_SETMASK" c_SIG_SETMASK :: CInt
499 foreign import ccall unsafe "__hsposix_SIG_UNBLOCK" c_SIG_UNBLOCK :: CInt
500 #endif /* __HUGS__ */
502 #endif /* mingw32_TARGET_OS */