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 -----------------------------------------------------------------------------
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
374 return (rc == (0::Int))
376 x = case b of {True -> 0; False -> 1}
378 -- | Queries the current state of the stopped child flag.
379 queryStoppedChildFlag :: IO Bool
380 queryStoppedChildFlag = do
382 return (rc == (0::Int))
383 #endif /* __GLASGOW_HASKELL__ */
385 -- -----------------------------------------------------------------------------
386 -- Manipulating signal sets
388 newtype SignalSet = SignalSet (ForeignPtr CSigset)
390 emptySignalSet :: SignalSet
391 emptySignalSet = unsafePerformIO $ do
392 fp <- mallocForeignPtrBytes sizeof_sigset_t
393 throwErrnoIfMinus1_ "emptySignalSet" (withForeignPtr fp $ c_sigemptyset)
394 return (SignalSet fp)
396 fullSignalSet :: SignalSet
397 fullSignalSet = unsafePerformIO $ do
398 fp <- mallocForeignPtrBytes sizeof_sigset_t
399 throwErrnoIfMinus1_ "fullSignalSet" (withForeignPtr fp $ c_sigfillset)
400 return (SignalSet fp)
402 infixr `addSignal`, `deleteSignal`
403 addSignal :: Signal -> SignalSet -> SignalSet
404 addSignal sig (SignalSet fp1) = unsafePerformIO $ do
405 fp2 <- mallocForeignPtrBytes sizeof_sigset_t
406 withForeignPtr fp1 $ \p1 ->
407 withForeignPtr fp2 $ \p2 -> do
408 copyBytes p2 p1 sizeof_sigset_t
409 throwErrnoIfMinus1_ "addSignal" (c_sigaddset p2 sig)
410 return (SignalSet fp2)
412 deleteSignal :: Signal -> SignalSet -> SignalSet
413 deleteSignal sig (SignalSet fp1) = unsafePerformIO $ do
414 fp2 <- mallocForeignPtrBytes sizeof_sigset_t
415 withForeignPtr fp1 $ \p1 ->
416 withForeignPtr fp2 $ \p2 -> do
417 copyBytes p2 p1 sizeof_sigset_t
418 throwErrnoIfMinus1_ "deleteSignal" (c_sigdelset p2 sig)
419 return (SignalSet fp2)
421 inSignalSet :: Signal -> SignalSet -> Bool
422 inSignalSet sig (SignalSet fp) = unsafePerformIO $
423 withForeignPtr fp $ \p -> do
424 r <- throwErrnoIfMinus1 "inSignalSet" (c_sigismember p sig)
427 getSignalMask :: IO SignalSet
429 fp <- mallocForeignPtrBytes sizeof_sigset_t
430 withForeignPtr fp $ \p ->
431 throwErrnoIfMinus1_ "getSignalMask" (c_sigprocmask 0 nullPtr p)
432 return (SignalSet fp)
434 sigProcMask :: String -> CInt -> SignalSet -> IO ()
435 sigProcMask fn how (SignalSet set) =
436 withForeignPtr set $ \p_set ->
437 throwErrnoIfMinus1_ fn (c_sigprocmask how p_set nullPtr)
439 setSignalMask :: SignalSet -> IO ()
440 setSignalMask set = sigProcMask "setSignalMask" c_SIG_SETMASK set
442 blockSignals :: SignalSet -> IO ()
443 blockSignals set = sigProcMask "blockSignals" c_SIG_BLOCK set
445 unblockSignals :: SignalSet -> IO ()
446 unblockSignals set = sigProcMask "unblockSignals" c_SIG_UNBLOCK set
448 getPendingSignals :: IO SignalSet
449 getPendingSignals = do
450 fp <- mallocForeignPtrBytes sizeof_sigset_t
451 withForeignPtr fp $ \p ->
452 throwErrnoIfMinus1_ "getPendingSignals" (c_sigpending p)
453 return (SignalSet fp)
455 #ifndef cygwin32_TARGET_OS
456 awaitSignal :: Maybe SignalSet -> IO ()
457 awaitSignal maybe_sigset = do
458 fp <- case maybe_sigset of
459 Nothing -> do SignalSet fp <- getSignalMask; return fp
460 Just (SignalSet fp) -> return fp
461 withForeignPtr fp $ \p -> do
464 -- ignore the return value; according to the docs it can only ever be
465 -- (-1) with errno set to EINTR.
467 foreign import ccall unsafe "sigsuspend"
468 c_sigsuspend :: Ptr CSigset -> IO CInt
472 foreign import ccall unsafe "sigdelset"
473 c_sigdelset :: Ptr CSigset -> CInt -> IO CInt
475 foreign import ccall unsafe "sigfillset"
476 c_sigfillset :: Ptr CSigset -> IO CInt
478 foreign import ccall unsafe "sigismember"
479 c_sigismember :: Ptr CSigset -> CInt -> IO CInt
481 foreign import ccall unsafe "__hscore_sigdelset"
482 c_sigdelset :: Ptr CSigset -> CInt -> IO CInt
484 foreign import ccall unsafe "__hscore_sigfillset"
485 c_sigfillset :: Ptr CSigset -> IO CInt
487 foreign import ccall unsafe "__hscore_sigismember"
488 c_sigismember :: Ptr CSigset -> CInt -> IO CInt
489 #endif /* __HUGS__ */
491 foreign import ccall unsafe "sigpending"
492 c_sigpending :: Ptr CSigset -> IO CInt
495 c_SIG_BLOCK = (#const SIG_BLOCK) :: CInt
496 c_SIG_SETMASK = (#const SIG_SETMASK) :: CInt
497 c_SIG_UNBLOCK = (#const SIG_UNBLOCK) :: CInt
499 foreign import ccall unsafe "__hsposix_SIG_BLOCK" c_SIG_BLOCK :: CInt
500 foreign import ccall unsafe "__hsposix_SIG_SETMASK" c_SIG_SETMASK :: CInt
501 foreign import ccall unsafe "__hsposix_SIG_UNBLOCK" c_SIG_UNBLOCK :: CInt
502 #endif /* __HUGS__ */
504 #endif /* mingw32_TARGET_OS */