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 #if defined(__GLASGOW_HASKELL__) && (defined(openbsd_TARGET_OS) || defined(freebsd_TARGET_OS))
291 foreign import ccall unsafe "genericRaise"
292 c_raise :: CInt -> IO CInt
294 foreign import ccall unsafe "raise"
295 c_raise :: CInt -> IO CInt
298 #ifdef __GLASGOW_HASKELL__
299 data Handler = Default
305 installHandler :: Signal
307 -> Maybe SignalSet -- other signals to block
308 -> IO Handler -- old handler
310 #ifdef __PARALLEL_HASKELL__
312 error "installHandler: not available for Parallel Haskell"
315 installHandler int handler maybe_mask = do
317 Nothing -> install' nullPtr
318 Just (SignalSet x) -> withForeignPtr x $ install'
323 rc <- case handler of
324 Default -> stg_sig_install int (#const STG_SIG_DFL) p_sp mask
325 Ignore -> stg_sig_install int (#const STG_SIG_IGN) p_sp mask
326 Catch m -> install'' m p_sp mask int (#const STG_SIG_HAN)
327 CatchOnce m -> install'' m p_sp mask int (#const STG_SIG_RST)
330 (#const STG_SIG_DFL) -> return Default
331 (#const STG_SIG_IGN) -> return Ignore
332 (#const STG_SIG_ERR) -> throwErrno "installHandler"
333 (#const STG_SIG_HAN) -> do
334 m <- peekHandler p_sp
336 (#const STG_SIG_RST) -> do
337 m <- peekHandler p_sp
340 install'' m p_sp mask int reset = do
341 sptr <- newStablePtr m
343 stg_sig_install int reset p_sp mask
345 peekHandler p_sp = do
349 foreign import ccall unsafe
350 stg_sig_install :: CInt -> CInt -> Ptr (StablePtr (IO ())) -> Ptr CSigset
353 #endif /* !__PARALLEL_HASKELL__ */
354 #endif /* __GLASGOW_HASKELL__ */
356 -- -----------------------------------------------------------------------------
359 scheduleAlarm :: Int -> IO Int
360 scheduleAlarm secs = do
361 r <- c_alarm (fromIntegral secs)
362 return (fromIntegral r)
364 foreign import ccall unsafe "alarm"
365 c_alarm :: CUInt -> IO CUInt
367 #ifdef __GLASGOW_HASKELL__
368 -- -----------------------------------------------------------------------------
369 -- The NOCLDSTOP flag
371 foreign import ccall "&nocldstop" nocldstop :: Ptr Int
373 -- | Tells the system whether or not to set the @SA_NOCLDSTOP@ flag when
374 -- installing new signal handlers.
375 setStoppedChildFlag :: Bool -> IO Bool
376 setStoppedChildFlag b = do
378 poke nocldstop $ fromEnum (not b)
379 return (rc == (0::Int))
381 -- | Queries the current state of the stopped child flag.
382 queryStoppedChildFlag :: IO Bool
383 queryStoppedChildFlag = do
385 return (rc == (0::Int))
386 #endif /* __GLASGOW_HASKELL__ */
388 -- -----------------------------------------------------------------------------
389 -- Manipulating signal sets
391 newtype SignalSet = SignalSet (ForeignPtr CSigset)
393 emptySignalSet :: SignalSet
394 emptySignalSet = unsafePerformIO $ do
395 fp <- mallocForeignPtrBytes sizeof_sigset_t
396 throwErrnoIfMinus1_ "emptySignalSet" (withForeignPtr fp $ c_sigemptyset)
397 return (SignalSet fp)
399 fullSignalSet :: SignalSet
400 fullSignalSet = unsafePerformIO $ do
401 fp <- mallocForeignPtrBytes sizeof_sigset_t
402 throwErrnoIfMinus1_ "fullSignalSet" (withForeignPtr fp $ c_sigfillset)
403 return (SignalSet fp)
405 infixr `addSignal`, `deleteSignal`
406 addSignal :: Signal -> SignalSet -> SignalSet
407 addSignal sig (SignalSet fp1) = unsafePerformIO $ do
408 fp2 <- mallocForeignPtrBytes sizeof_sigset_t
409 withForeignPtr fp1 $ \p1 ->
410 withForeignPtr fp2 $ \p2 -> do
411 copyBytes p2 p1 sizeof_sigset_t
412 throwErrnoIfMinus1_ "addSignal" (c_sigaddset p2 sig)
413 return (SignalSet fp2)
415 deleteSignal :: Signal -> SignalSet -> SignalSet
416 deleteSignal sig (SignalSet fp1) = unsafePerformIO $ do
417 fp2 <- mallocForeignPtrBytes sizeof_sigset_t
418 withForeignPtr fp1 $ \p1 ->
419 withForeignPtr fp2 $ \p2 -> do
420 copyBytes p2 p1 sizeof_sigset_t
421 throwErrnoIfMinus1_ "deleteSignal" (c_sigdelset p2 sig)
422 return (SignalSet fp2)
424 inSignalSet :: Signal -> SignalSet -> Bool
425 inSignalSet sig (SignalSet fp) = unsafePerformIO $
426 withForeignPtr fp $ \p -> do
427 r <- throwErrnoIfMinus1 "inSignalSet" (c_sigismember p sig)
430 getSignalMask :: IO SignalSet
432 fp <- mallocForeignPtrBytes sizeof_sigset_t
433 withForeignPtr fp $ \p ->
434 throwErrnoIfMinus1_ "getSignalMask" (c_sigprocmask 0 nullPtr p)
435 return (SignalSet fp)
437 sigProcMask :: String -> CInt -> SignalSet -> IO ()
438 sigProcMask fn how (SignalSet set) =
439 withForeignPtr set $ \p_set ->
440 throwErrnoIfMinus1_ fn (c_sigprocmask how p_set nullPtr)
442 setSignalMask :: SignalSet -> IO ()
443 setSignalMask set = sigProcMask "setSignalMask" c_SIG_SETMASK set
445 blockSignals :: SignalSet -> IO ()
446 blockSignals set = sigProcMask "blockSignals" c_SIG_BLOCK set
448 unblockSignals :: SignalSet -> IO ()
449 unblockSignals set = sigProcMask "unblockSignals" c_SIG_UNBLOCK set
451 getPendingSignals :: IO SignalSet
452 getPendingSignals = do
453 fp <- mallocForeignPtrBytes sizeof_sigset_t
454 withForeignPtr fp $ \p ->
455 throwErrnoIfMinus1_ "getPendingSignals" (c_sigpending p)
456 return (SignalSet fp)
458 #ifndef cygwin32_TARGET_OS
459 awaitSignal :: Maybe SignalSet -> IO ()
460 awaitSignal maybe_sigset = do
461 fp <- case maybe_sigset of
462 Nothing -> do SignalSet fp <- getSignalMask; return fp
463 Just (SignalSet fp) -> return fp
464 withForeignPtr fp $ \p -> do
467 -- ignore the return value; according to the docs it can only ever be
468 -- (-1) with errno set to EINTR.
470 foreign import ccall unsafe "sigsuspend"
471 c_sigsuspend :: Ptr CSigset -> IO CInt
475 foreign import ccall unsafe "sigdelset"
476 c_sigdelset :: Ptr CSigset -> CInt -> IO CInt
478 foreign import ccall unsafe "sigfillset"
479 c_sigfillset :: Ptr CSigset -> IO CInt
481 foreign import ccall unsafe "sigismember"
482 c_sigismember :: Ptr CSigset -> CInt -> IO CInt
484 foreign import ccall unsafe "__hscore_sigdelset"
485 c_sigdelset :: Ptr CSigset -> CInt -> IO CInt
487 foreign import ccall unsafe "__hscore_sigfillset"
488 c_sigfillset :: Ptr CSigset -> IO CInt
490 foreign import ccall unsafe "__hscore_sigismember"
491 c_sigismember :: Ptr CSigset -> CInt -> IO CInt
492 #endif /* __HUGS__ */
494 foreign import ccall unsafe "sigpending"
495 c_sigpending :: Ptr CSigset -> IO CInt
498 c_SIG_BLOCK = (#const SIG_BLOCK) :: CInt
499 c_SIG_SETMASK = (#const SIG_SETMASK) :: CInt
500 c_SIG_UNBLOCK = (#const SIG_UNBLOCK) :: CInt
502 foreign import ccall unsafe "__hsposix_SIG_BLOCK" c_SIG_BLOCK :: CInt
503 foreign import ccall unsafe "__hsposix_SIG_SETMASK" c_SIG_SETMASK :: CInt
504 foreign import ccall unsafe "__hsposix_SIG_UNBLOCK" c_SIG_UNBLOCK :: CInt
505 #endif /* __HUGS__ */
507 #endif /* mingw32_TARGET_OS */