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,
58 windowChange, sigWINCH,
66 #ifdef __GLASGOW_HASKELL__
74 emptySignalSet, fullSignalSet,
75 addSignal, deleteSignal, inSignalSet,
77 -- * The process signal mask
78 getSignalMask, setSignalMask, blockSignals, unblockSignals,
83 -- * Waiting for signals
85 #ifndef cygwin32_TARGET_OS
89 #ifdef __GLASGOW_HASKELL__
90 -- * The @NOCLDSTOP@ flag
91 setStoppedChildFlag, queryStoppedChildFlag,
94 -- MISSING FUNCTIONALITY:
95 -- sigaction(), (inc. the sigaction structure + flags etc.)
96 -- the siginfo structure
98 -- sighold, sigignore, sigpause, sigrelse, sigset
103 #ifdef __GLASGOW_HASKELL__
111 import System.IO.Unsafe
112 import System.Posix.Types
113 import System.Posix.Internals
115 #ifndef mingw32_TARGET_OS
118 -- -----------------------------------------------------------------------------
127 sigABRT = (#const SIGABRT) :: CInt
128 sigALRM = (#const SIGALRM) :: CInt
129 sigBUS = (#const SIGBUS) :: CInt
130 sigCHLD = (#const SIGCHLD) :: CInt
131 sigCONT = (#const SIGCONT) :: CInt
132 sigFPE = (#const SIGFPE) :: CInt
133 sigHUP = (#const SIGHUP) :: CInt
134 sigILL = (#const SIGILL) :: CInt
135 sigINT = (#const SIGINT) :: CInt
136 sigKILL = (#const SIGKILL) :: CInt
137 sigPIPE = (#const SIGPIPE) :: CInt
138 sigQUIT = (#const SIGQUIT) :: CInt
139 sigSEGV = (#const SIGSEGV) :: CInt
140 sigSTOP = (#const SIGSTOP) :: CInt
141 sigTERM = (#const SIGTERM) :: CInt
142 sigTSTP = (#const SIGTSTP) :: CInt
143 sigTTIN = (#const SIGTTIN) :: CInt
144 sigTTOU = (#const SIGTTOU) :: CInt
145 sigUSR1 = (#const SIGUSR1) :: CInt
146 sigUSR2 = (#const SIGUSR2) :: CInt
148 sigPOLL = (#const SIGPOLL) :: CInt
150 sigPROF = (#const SIGPROF) :: CInt
151 sigSYS = (#const SIGSYS) :: CInt
152 sigTRAP = (#const SIGTRAP) :: CInt
153 sigURG = (#const SIGURG) :: CInt
154 sigVTALRM = (#const SIGVTALRM) :: CInt
155 sigXCPU = (#const SIGXCPU) :: CInt
156 sigXFSZ = (#const SIGXFSZ) :: CInt
158 sigINFO = (#const SIGINFO) :: CInt
161 sigWINCH = (#const SIGWINCH) :: CInt
164 foreign import ccall unsafe "__hsposix_SIGABRT" sigABRT :: CInt
165 foreign import ccall unsafe "__hsposix_SIGALRM" sigALRM :: CInt
166 foreign import ccall unsafe "__hsposix_SIGBUS" sigBUS :: CInt
167 foreign import ccall unsafe "__hsposix_SIGCHLD" sigCHLD :: CInt
168 foreign import ccall unsafe "__hsposix_SIGCONT" sigCONT :: CInt
169 foreign import ccall unsafe "__hsposix_SIGFPE" sigFPE :: CInt
170 foreign import ccall unsafe "__hsposix_SIGHUP" sigHUP :: CInt
171 foreign import ccall unsafe "__hsposix_SIGILL" sigILL :: CInt
172 foreign import ccall unsafe "__hsposix_SIGINT" sigINT :: CInt
173 foreign import ccall unsafe "__hsposix_SIGKILL" sigKILL :: CInt
174 foreign import ccall unsafe "__hsposix_SIGPIPE" sigPIPE :: CInt
175 foreign import ccall unsafe "__hsposix_SIGQUIT" sigQUIT :: CInt
176 foreign import ccall unsafe "__hsposix_SIGSEGV" sigSEGV :: CInt
177 foreign import ccall unsafe "__hsposix_SIGSTOP" sigSTOP :: CInt
178 foreign import ccall unsafe "__hsposix_SIGTERM" sigTERM :: CInt
179 foreign import ccall unsafe "__hsposix_SIGTSTP" sigTSTP :: CInt
180 foreign import ccall unsafe "__hsposix_SIGTTIN" sigTTIN :: CInt
181 foreign import ccall unsafe "__hsposix_SIGTTOU" sigTTOU :: CInt
182 foreign import ccall unsafe "__hsposix_SIGUSR1" sigUSR1 :: CInt
183 foreign import ccall unsafe "__hsposix_SIGUSR2" sigUSR2 :: CInt
185 foreign import ccall unsafe "__hsposix_SIGPOLL" sigPOLL :: CInt
187 foreign import ccall unsafe "__hsposix_SIGPROF" sigPROF :: CInt
188 foreign import ccall unsafe "__hsposix_SIGSYS" sigSYS :: CInt
189 foreign import ccall unsafe "__hsposix_SIGTRAP" sigTRAP :: CInt
190 foreign import ccall unsafe "__hsposix_SIGURG" sigURG :: CInt
191 foreign import ccall unsafe "__hsposix_SIGVTALRM" sigVTALRM :: CInt
192 foreign import ccall unsafe "__hsposix_SIGXCPU" sigXCPU :: CInt
193 foreign import ccall unsafe "__hsposix_SIGXFSZ" sigXFSZ :: CInt
195 foreign import ccall unsafe "__hsposix_SIGINFO" sigINFO :: CInt
198 foreign import ccall unsafe "__hsposix_SIGWINCH" sigWINCH :: CInt
200 #endif /* __HUGS__ */
202 internalAbort ::Signal
203 internalAbort = sigABRT
205 realTimeAlarm :: Signal
206 realTimeAlarm = sigALRM
211 processStatusChanged :: Signal
212 processStatusChanged = sigCHLD
214 continueProcess :: Signal
215 continueProcess = sigCONT
217 floatingPointException :: Signal
218 floatingPointException = sigFPE
220 lostConnection :: Signal
221 lostConnection = sigHUP
223 illegalInstruction :: Signal
224 illegalInstruction = sigILL
226 keyboardSignal :: Signal
227 keyboardSignal = sigINT
229 killProcess :: Signal
230 killProcess = sigKILL
232 openEndedPipe :: Signal
233 openEndedPipe = sigPIPE
235 keyboardTermination :: Signal
236 keyboardTermination = sigQUIT
238 segmentationViolation :: Signal
239 segmentationViolation = sigSEGV
241 softwareStop :: Signal
242 softwareStop = sigSTOP
244 softwareTermination :: Signal
245 softwareTermination = sigTERM
247 keyboardStop :: Signal
248 keyboardStop = sigTSTP
250 backgroundRead :: Signal
251 backgroundRead = sigTTIN
253 backgroundWrite :: Signal
254 backgroundWrite = sigTTOU
256 userDefinedSignal1 :: Signal
257 userDefinedSignal1 = sigUSR1
259 userDefinedSignal2 :: Signal
260 userDefinedSignal2 = sigUSR2
263 pollableEvent :: Signal
264 pollableEvent = sigPOLL
267 profilingTimerExpired :: Signal
268 profilingTimerExpired = sigPROF
270 badSystemCall :: Signal
271 badSystemCall = sigSYS
273 breakpointTrap :: Signal
274 breakpointTrap = sigTRAP
276 urgentDataAvailable :: Signal
277 urgentDataAvailable = sigURG
279 virtualTimerExpired :: Signal
280 virtualTimerExpired = sigVTALRM
282 cpuTimeLimitExceeded :: Signal
283 cpuTimeLimitExceeded = sigXCPU
285 fileSizeLimitExceeded :: Signal
286 fileSizeLimitExceeded = sigXFSZ
294 windowChange :: Signal
295 windowChange = sigWINCH
298 -- -----------------------------------------------------------------------------
299 -- Signal-related functions
301 signalProcess :: Signal -> ProcessID -> IO ()
302 signalProcess sig pid
303 = throwErrnoIfMinus1_ "signalProcess" (c_kill (fromIntegral pid) sig)
305 foreign import ccall unsafe "kill"
306 c_kill :: CPid -> CInt -> IO CInt
308 signalProcessGroup :: Signal -> ProcessGroupID -> IO ()
309 signalProcessGroup sig pgid
310 = throwErrnoIfMinus1_ "signalProcessGroup" (c_killpg (fromIntegral pgid) sig)
312 foreign import ccall unsafe "killpg"
313 c_killpg :: CPid -> CInt -> IO CInt
315 raiseSignal :: Signal -> IO ()
316 raiseSignal sig = throwErrnoIfMinus1_ "raiseSignal" (c_raise sig)
318 foreign import ccall unsafe "raise"
319 c_raise :: CInt -> IO CInt
321 #ifdef __GLASGOW_HASKELL__
322 data Handler = Default
328 installHandler :: Signal
330 -> Maybe SignalSet -- other signals to block
331 -> IO Handler -- old handler
333 #ifdef __PARALLEL_HASKELL__
335 error "installHandler: not available for Parallel Haskell"
338 installHandler int handler maybe_mask = do
340 Nothing -> install' nullPtr
341 Just (SignalSet x) -> withForeignPtr x $ install'
346 rc <- case handler of
347 Default -> stg_sig_install int (#const STG_SIG_DFL) p_sp mask
348 Ignore -> stg_sig_install int (#const STG_SIG_IGN) p_sp mask
349 Catch m -> install'' m p_sp mask int (#const STG_SIG_HAN)
350 CatchOnce m -> install'' m p_sp mask int (#const STG_SIG_RST)
353 (#const STG_SIG_DFL) -> return Default
354 (#const STG_SIG_IGN) -> return Ignore
355 (#const STG_SIG_ERR) -> throwErrno "installHandler"
356 (#const STG_SIG_HAN) -> do
357 m <- peekHandler p_sp
359 (#const STG_SIG_RST) -> do
360 m <- peekHandler p_sp
363 install'' m p_sp mask int reset = do
364 sptr <- newStablePtr m
366 stg_sig_install int reset p_sp mask
368 peekHandler p_sp = do
372 foreign import ccall unsafe
373 stg_sig_install :: CInt -> CInt -> Ptr (StablePtr (IO ())) -> Ptr CSigset
376 #endif /* !__PARALLEL_HASKELL__ */
377 #endif /* __GLASGOW_HASKELL__ */
379 -- -----------------------------------------------------------------------------
382 scheduleAlarm :: Int -> IO Int
383 scheduleAlarm secs = do
384 r <- c_alarm (fromIntegral secs)
385 return (fromIntegral r)
387 foreign import ccall unsafe "alarm"
388 c_alarm :: CUInt -> IO CUInt
390 #ifdef __GLASGOW_HASKELL__
391 -- -----------------------------------------------------------------------------
392 -- The NOCLDSTOP flag
394 foreign import ccall "&nocldstop" nocldstop :: Ptr Int
396 -- | Tells the system whether or not to set the @SA_NOCLDSTOP@ flag when
397 -- installing new signal handlers.
398 setStoppedChildFlag :: Bool -> IO Bool
399 setStoppedChildFlag b = do
401 poke nocldstop $ fromEnum (not b)
402 return (rc == (0::Int))
404 -- | Queries the current state of the stopped child flag.
405 queryStoppedChildFlag :: IO Bool
406 queryStoppedChildFlag = do
408 return (rc == (0::Int))
409 #endif /* __GLASGOW_HASKELL__ */
411 -- -----------------------------------------------------------------------------
412 -- Manipulating signal sets
414 newtype SignalSet = SignalSet (ForeignPtr CSigset)
416 emptySignalSet :: SignalSet
417 emptySignalSet = unsafePerformIO $ do
418 fp <- mallocForeignPtrBytes sizeof_sigset_t
419 throwErrnoIfMinus1_ "emptySignalSet" (withForeignPtr fp $ c_sigemptyset)
420 return (SignalSet fp)
422 fullSignalSet :: SignalSet
423 fullSignalSet = unsafePerformIO $ do
424 fp <- mallocForeignPtrBytes sizeof_sigset_t
425 throwErrnoIfMinus1_ "fullSignalSet" (withForeignPtr fp $ c_sigfillset)
426 return (SignalSet fp)
428 infixr `addSignal`, `deleteSignal`
429 addSignal :: Signal -> SignalSet -> SignalSet
430 addSignal sig (SignalSet fp1) = unsafePerformIO $ do
431 fp2 <- mallocForeignPtrBytes sizeof_sigset_t
432 withForeignPtr fp1 $ \p1 ->
433 withForeignPtr fp2 $ \p2 -> do
434 copyBytes p2 p1 sizeof_sigset_t
435 throwErrnoIfMinus1_ "addSignal" (c_sigaddset p2 sig)
436 return (SignalSet fp2)
438 deleteSignal :: Signal -> SignalSet -> SignalSet
439 deleteSignal sig (SignalSet fp1) = unsafePerformIO $ do
440 fp2 <- mallocForeignPtrBytes sizeof_sigset_t
441 withForeignPtr fp1 $ \p1 ->
442 withForeignPtr fp2 $ \p2 -> do
443 copyBytes p2 p1 sizeof_sigset_t
444 throwErrnoIfMinus1_ "deleteSignal" (c_sigdelset p2 sig)
445 return (SignalSet fp2)
447 inSignalSet :: Signal -> SignalSet -> Bool
448 inSignalSet sig (SignalSet fp) = unsafePerformIO $
449 withForeignPtr fp $ \p -> do
450 r <- throwErrnoIfMinus1 "inSignalSet" (c_sigismember p sig)
453 getSignalMask :: IO SignalSet
455 fp <- mallocForeignPtrBytes sizeof_sigset_t
456 withForeignPtr fp $ \p ->
457 throwErrnoIfMinus1_ "getSignalMask" (c_sigprocmask 0 nullPtr p)
458 return (SignalSet fp)
460 sigProcMask :: String -> CInt -> SignalSet -> IO ()
461 sigProcMask fn how (SignalSet set) =
462 withForeignPtr set $ \p_set ->
463 throwErrnoIfMinus1_ fn (c_sigprocmask how p_set nullPtr)
465 setSignalMask :: SignalSet -> IO ()
466 setSignalMask set = sigProcMask "setSignalMask" c_SIG_SETMASK set
468 blockSignals :: SignalSet -> IO ()
469 blockSignals set = sigProcMask "blockSignals" c_SIG_BLOCK set
471 unblockSignals :: SignalSet -> IO ()
472 unblockSignals set = sigProcMask "unblockSignals" c_SIG_UNBLOCK set
474 getPendingSignals :: IO SignalSet
475 getPendingSignals = do
476 fp <- mallocForeignPtrBytes sizeof_sigset_t
477 withForeignPtr fp $ \p ->
478 throwErrnoIfMinus1_ "getPendingSignals" (c_sigpending p)
479 return (SignalSet fp)
481 #ifndef cygwin32_TARGET_OS
482 awaitSignal :: Maybe SignalSet -> IO ()
483 awaitSignal maybe_sigset = do
484 fp <- case maybe_sigset of
485 Nothing -> do SignalSet fp <- getSignalMask; return fp
486 Just (SignalSet fp) -> return fp
487 withForeignPtr fp $ \p -> do
490 -- ignore the return value; according to the docs it can only ever be
491 -- (-1) with errno set to EINTR.
493 foreign import ccall unsafe "sigsuspend"
494 c_sigsuspend :: Ptr CSigset -> IO CInt
498 foreign import ccall unsafe "sigdelset"
499 c_sigdelset :: Ptr CSigset -> CInt -> IO CInt
501 foreign import ccall unsafe "sigfillset"
502 c_sigfillset :: Ptr CSigset -> IO CInt
504 foreign import ccall unsafe "sigismember"
505 c_sigismember :: Ptr CSigset -> CInt -> IO CInt
507 foreign import ccall unsafe "__hscore_sigdelset"
508 c_sigdelset :: Ptr CSigset -> CInt -> IO CInt
510 foreign import ccall unsafe "__hscore_sigfillset"
511 c_sigfillset :: Ptr CSigset -> IO CInt
513 foreign import ccall unsafe "__hscore_sigismember"
514 c_sigismember :: Ptr CSigset -> CInt -> IO CInt
515 #endif /* __HUGS__ */
517 foreign import ccall unsafe "sigpending"
518 c_sigpending :: Ptr CSigset -> IO CInt
521 c_SIG_BLOCK = (#const SIG_BLOCK) :: CInt
522 c_SIG_SETMASK = (#const SIG_SETMASK) :: CInt
523 c_SIG_UNBLOCK = (#const SIG_UNBLOCK) :: CInt
525 foreign import ccall unsafe "__hsposix_SIG_BLOCK" c_SIG_BLOCK :: CInt
526 foreign import ccall unsafe "__hsposix_SIG_SETMASK" c_SIG_SETMASK :: CInt
527 foreign import ccall unsafe "__hsposix_SIG_UNBLOCK" c_SIG_UNBLOCK :: CInt
528 #endif /* __HUGS__ */
530 #endif /* mingw32_TARGET_OS */