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__
105 import System.IO.Unsafe
106 import System.Posix.Types
107 import System.Posix.Internals
109 #ifndef mingw32_HOST_OS
112 -- -----------------------------------------------------------------------------
121 sigABRT = CONST_SIGABRT
123 sigALRM = CONST_SIGALRM
125 sigBUS = CONST_SIGBUS
127 sigCHLD = CONST_SIGCHLD
129 sigCONT = CONST_SIGCONT
131 sigFPE = CONST_SIGFPE
133 sigHUP = CONST_SIGHUP
135 sigILL = CONST_SIGILL
137 sigINT = CONST_SIGINT
139 sigKILL = CONST_SIGKILL
141 sigPIPE = CONST_SIGPIPE
143 sigQUIT = CONST_SIGQUIT
145 sigSEGV = CONST_SIGSEGV
147 sigSTOP = CONST_SIGSTOP
149 sigTERM = CONST_SIGTERM
151 sigTSTP = CONST_SIGTSTP
153 sigTTIN = CONST_SIGTTIN
155 sigTTOU = CONST_SIGTTOU
157 sigUSR1 = CONST_SIGUSR1
159 sigUSR2 = CONST_SIGUSR2
161 sigPOLL = CONST_SIGPOLL
163 sigPROF = CONST_SIGPROF
165 sigSYS = CONST_SIGSYS
167 sigTRAP = CONST_SIGTRAP
169 sigURG = CONST_SIGURG
171 sigVTALRM = CONST_SIGVTALRM
173 sigXCPU = CONST_SIGXCPU
175 sigXFSZ = CONST_SIGXFSZ
177 internalAbort ::Signal
178 internalAbort = sigABRT
180 realTimeAlarm :: Signal
181 realTimeAlarm = sigALRM
186 processStatusChanged :: Signal
187 processStatusChanged = sigCHLD
189 continueProcess :: Signal
190 continueProcess = sigCONT
192 floatingPointException :: Signal
193 floatingPointException = sigFPE
195 lostConnection :: Signal
196 lostConnection = sigHUP
198 illegalInstruction :: Signal
199 illegalInstruction = sigILL
201 keyboardSignal :: Signal
202 keyboardSignal = sigINT
204 killProcess :: Signal
205 killProcess = sigKILL
207 openEndedPipe :: Signal
208 openEndedPipe = sigPIPE
210 keyboardTermination :: Signal
211 keyboardTermination = sigQUIT
213 segmentationViolation :: Signal
214 segmentationViolation = sigSEGV
216 softwareStop :: Signal
217 softwareStop = sigSTOP
219 softwareTermination :: Signal
220 softwareTermination = sigTERM
222 keyboardStop :: Signal
223 keyboardStop = sigTSTP
225 backgroundRead :: Signal
226 backgroundRead = sigTTIN
228 backgroundWrite :: Signal
229 backgroundWrite = sigTTOU
231 userDefinedSignal1 :: Signal
232 userDefinedSignal1 = sigUSR1
234 userDefinedSignal2 :: Signal
235 userDefinedSignal2 = sigUSR2
237 #if CONST_SIGPOLL != -1
238 pollableEvent :: Signal
239 pollableEvent = sigPOLL
242 profilingTimerExpired :: Signal
243 profilingTimerExpired = sigPROF
245 badSystemCall :: Signal
246 badSystemCall = sigSYS
248 breakpointTrap :: Signal
249 breakpointTrap = sigTRAP
251 urgentDataAvailable :: Signal
252 urgentDataAvailable = sigURG
254 virtualTimerExpired :: Signal
255 virtualTimerExpired = sigVTALRM
257 cpuTimeLimitExceeded :: Signal
258 cpuTimeLimitExceeded = sigXCPU
260 fileSizeLimitExceeded :: Signal
261 fileSizeLimitExceeded = sigXFSZ
263 -- -----------------------------------------------------------------------------
264 -- Signal-related functions
266 signalProcess :: Signal -> ProcessID -> IO ()
267 signalProcess sig pid
268 = throwErrnoIfMinus1_ "signalProcess" (c_kill (fromIntegral pid) sig)
270 foreign import ccall unsafe "kill"
271 c_kill :: CPid -> CInt -> IO CInt
273 signalProcessGroup :: Signal -> ProcessGroupID -> IO ()
274 signalProcessGroup sig pgid
275 = throwErrnoIfMinus1_ "signalProcessGroup" (c_killpg (fromIntegral pgid) sig)
277 foreign import ccall unsafe "killpg"
278 c_killpg :: CPid -> CInt -> IO CInt
280 raiseSignal :: Signal -> IO ()
281 raiseSignal sig = throwErrnoIfMinus1_ "raiseSignal" (c_raise sig)
283 #if defined(__GLASGOW_HASKELL__) && (defined(openbsd_HOST_OS) || defined(freebsd_HOST_OS))
284 foreign import ccall unsafe "genericRaise"
285 c_raise :: CInt -> IO CInt
287 foreign import ccall unsafe "raise"
288 c_raise :: CInt -> IO CInt
291 #ifdef __GLASGOW_HASKELL__
292 data Handler = Default
298 installHandler :: Signal
300 -> Maybe SignalSet -- other signals to block
301 -> IO Handler -- old handler
303 #ifdef __PARALLEL_HASKELL__
305 error "installHandler: not available for Parallel Haskell"
308 installHandler int handler maybe_mask = do
310 Nothing -> install' nullPtr
311 Just (SignalSet x) -> withForeignPtr x $ install'
316 rc <- case handler of
317 Default -> stg_sig_install int STG_SIG_DFL p_sp mask
318 Ignore -> stg_sig_install int STG_SIG_IGN p_sp mask
319 Catch m -> hinstall m p_sp mask int STG_SIG_HAN
320 CatchOnce m -> hinstall m p_sp mask int STG_SIG_RST
323 STG_SIG_DFL -> return Default
324 STG_SIG_IGN -> return Ignore
325 STG_SIG_ERR -> throwErrno "installHandler"
327 m <- peekHandler p_sp
330 m <- peekHandler p_sp
333 error "internal error: System.Posix.Signals.installHandler"
335 hinstall 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
347 -> CInt -- action code (STG_SIG_HAN etc.)
348 -> Ptr (StablePtr (IO ())) -- (in, out) Haskell handler
349 -> Ptr CSigset -- (in, out) blocked
350 -> IO CInt -- (ret) action code
352 #endif /* !__PARALLEL_HASKELL__ */
353 #endif /* __GLASGOW_HASKELL__ */
355 -- -----------------------------------------------------------------------------
358 scheduleAlarm :: Int -> IO Int
359 scheduleAlarm secs = do
360 r <- c_alarm (fromIntegral secs)
361 return (fromIntegral r)
363 foreign import ccall unsafe "alarm"
364 c_alarm :: CUInt -> IO CUInt
366 #ifdef __GLASGOW_HASKELL__
367 -- -----------------------------------------------------------------------------
368 -- The NOCLDSTOP flag
370 foreign import ccall "&nocldstop" nocldstop :: Ptr Int
372 -- | Tells the system whether or not to set the @SA_NOCLDSTOP@ flag when
373 -- installing new signal handlers.
374 setStoppedChildFlag :: Bool -> IO Bool
375 setStoppedChildFlag b = do
377 poke nocldstop $ fromEnum (not b)
378 return (rc == (0::Int))
380 -- | Queries the current state of the stopped child flag.
381 queryStoppedChildFlag :: IO Bool
382 queryStoppedChildFlag = do
384 return (rc == (0::Int))
385 #endif /* __GLASGOW_HASKELL__ */
387 -- -----------------------------------------------------------------------------
388 -- Manipulating signal sets
390 newtype SignalSet = SignalSet (ForeignPtr CSigset)
392 emptySignalSet :: SignalSet
393 emptySignalSet = unsafePerformIO $ do
394 fp <- mallocForeignPtrBytes sizeof_sigset_t
395 throwErrnoIfMinus1_ "emptySignalSet" (withForeignPtr fp $ c_sigemptyset)
396 return (SignalSet fp)
398 fullSignalSet :: SignalSet
399 fullSignalSet = unsafePerformIO $ do
400 fp <- mallocForeignPtrBytes sizeof_sigset_t
401 throwErrnoIfMinus1_ "fullSignalSet" (withForeignPtr fp $ c_sigfillset)
402 return (SignalSet fp)
404 infixr `addSignal`, `deleteSignal`
405 addSignal :: Signal -> SignalSet -> SignalSet
406 addSignal sig (SignalSet fp1) = unsafePerformIO $ do
407 fp2 <- mallocForeignPtrBytes sizeof_sigset_t
408 withForeignPtr fp1 $ \p1 ->
409 withForeignPtr fp2 $ \p2 -> do
410 copyBytes p2 p1 sizeof_sigset_t
411 throwErrnoIfMinus1_ "addSignal" (c_sigaddset p2 sig)
412 return (SignalSet fp2)
414 deleteSignal :: Signal -> SignalSet -> SignalSet
415 deleteSignal sig (SignalSet fp1) = unsafePerformIO $ do
416 fp2 <- mallocForeignPtrBytes sizeof_sigset_t
417 withForeignPtr fp1 $ \p1 ->
418 withForeignPtr fp2 $ \p2 -> do
419 copyBytes p2 p1 sizeof_sigset_t
420 throwErrnoIfMinus1_ "deleteSignal" (c_sigdelset p2 sig)
421 return (SignalSet fp2)
423 inSignalSet :: Signal -> SignalSet -> Bool
424 inSignalSet sig (SignalSet fp) = unsafePerformIO $
425 withForeignPtr fp $ \p -> do
426 r <- throwErrnoIfMinus1 "inSignalSet" (c_sigismember p sig)
429 getSignalMask :: IO SignalSet
431 fp <- mallocForeignPtrBytes sizeof_sigset_t
432 withForeignPtr fp $ \p ->
433 throwErrnoIfMinus1_ "getSignalMask" (c_sigprocmask 0 nullPtr p)
434 return (SignalSet fp)
436 sigProcMask :: String -> CInt -> SignalSet -> IO ()
437 sigProcMask fn how (SignalSet set) =
438 withForeignPtr set $ \p_set ->
439 throwErrnoIfMinus1_ fn (c_sigprocmask how p_set nullPtr)
441 setSignalMask :: SignalSet -> IO ()
442 setSignalMask set = sigProcMask "setSignalMask" (CONST_SIG_SETMASK :: CInt) set
444 blockSignals :: SignalSet -> IO ()
445 blockSignals set = sigProcMask "blockSignals" (CONST_SIG_BLOCK :: CInt) set
447 unblockSignals :: SignalSet -> IO ()
448 unblockSignals set = sigProcMask "unblockSignals" (CONST_SIG_UNBLOCK :: CInt) set
450 getPendingSignals :: IO SignalSet
451 getPendingSignals = do
452 fp <- mallocForeignPtrBytes sizeof_sigset_t
453 withForeignPtr fp $ \p ->
454 throwErrnoIfMinus1_ "getPendingSignals" (c_sigpending p)
455 return (SignalSet fp)
457 #ifndef cygwin32_HOST_OS
458 awaitSignal :: Maybe SignalSet -> IO ()
459 awaitSignal maybe_sigset = do
460 fp <- case maybe_sigset of
461 Nothing -> do SignalSet fp <- getSignalMask; return fp
462 Just (SignalSet fp) -> return fp
463 withForeignPtr fp $ \p -> do
466 -- ignore the return value; according to the docs it can only ever be
467 -- (-1) with errno set to EINTR.
469 foreign import ccall unsafe "sigsuspend"
470 c_sigsuspend :: Ptr CSigset -> IO CInt
474 foreign import ccall unsafe "sigdelset"
475 c_sigdelset :: Ptr CSigset -> CInt -> IO CInt
477 foreign import ccall unsafe "sigfillset"
478 c_sigfillset :: Ptr CSigset -> IO CInt
480 foreign import ccall unsafe "sigismember"
481 c_sigismember :: Ptr CSigset -> CInt -> IO CInt
483 foreign import ccall unsafe "__hscore_sigdelset"
484 c_sigdelset :: Ptr CSigset -> CInt -> IO CInt
486 foreign import ccall unsafe "__hscore_sigfillset"
487 c_sigfillset :: Ptr CSigset -> IO CInt
489 foreign import ccall unsafe "__hscore_sigismember"
490 c_sigismember :: Ptr CSigset -> CInt -> IO CInt
491 #endif /* __HUGS__ */
493 foreign import ccall unsafe "sigpending"
494 c_sigpending :: Ptr CSigset -> IO CInt
496 #endif /* mingw32_HOST_OS */