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,
66 emptySignalSet, fullSignalSet,
67 addSignal, deleteSignal, inSignalSet,
69 -- * The process signal mask
70 getSignalMask, setSignalMask, blockSignals, unblockSignals,
75 -- * Waiting for signals
76 getPendingSignals, awaitSignal,
78 -- * The @NOCLDSTOP@ flag
79 setStoppedChildFlag, queryStoppedChildFlag,
81 -- MISSING FUNCTIONALITY:
82 -- sigaction(), (inc. the sigaction structure + flags etc.)
83 -- the siginfo structure
85 -- sighold, sigignore, sigpause, sigrelse, sigset
94 import System.IO.Unsafe
95 import System.Posix.Types
96 import System.Posix.Internals
98 #ifndef mingw32_TARGET_OS
101 -- -----------------------------------------------------------------------------
109 foreign import ccall unsafe "__hsposix_SIGABRT" sigABRT :: CInt
110 foreign import ccall unsafe "__hsposix_SIGALRM" sigALRM :: CInt
111 foreign import ccall unsafe "__hsposix_SIGBUS" sigBUS :: CInt
112 foreign import ccall unsafe "__hsposix_SIGCHLD" sigCHLD :: CInt
113 foreign import ccall unsafe "__hsposix_SIGCONT" sigCONT :: CInt
114 foreign import ccall unsafe "__hsposix_SIGFPE" sigFPE :: CInt
115 foreign import ccall unsafe "__hsposix_SIGHUP" sigHUP :: CInt
116 foreign import ccall unsafe "__hsposix_SIGILL" sigILL :: CInt
117 foreign import ccall unsafe "__hsposix_SIGINT" sigINT :: CInt
118 foreign import ccall unsafe "__hsposix_SIGKILL" sigKILL :: CInt
119 foreign import ccall unsafe "__hsposix_SIGPIPE" sigPIPE :: CInt
120 foreign import ccall unsafe "__hsposix_SIGQUIT" sigQUIT :: CInt
121 foreign import ccall unsafe "__hsposix_SIGSEGV" sigSEGV :: CInt
122 foreign import ccall unsafe "__hsposix_SIGSTOP" sigSTOP :: CInt
123 foreign import ccall unsafe "__hsposix_SIGTERM" sigTERM :: CInt
124 foreign import ccall unsafe "__hsposix_SIGTSTP" sigTSTP :: CInt
125 foreign import ccall unsafe "__hsposix_SIGTTIN" sigTTIN :: CInt
126 foreign import ccall unsafe "__hsposix_SIGTTOU" sigTTOU :: CInt
127 foreign import ccall unsafe "__hsposix_SIGUSR1" sigUSR1 :: CInt
128 foreign import ccall unsafe "__hsposix_SIGUSR2" sigUSR2 :: CInt
130 foreign import ccall unsafe "__hsposix_SIGPOLL" sigPOLL :: CInt
132 foreign import ccall unsafe "__hsposix_SIGPROF" sigPROF :: CInt
133 foreign import ccall unsafe "__hsposix_SIGSYS" sigSYS :: CInt
134 foreign import ccall unsafe "__hsposix_SIGTRAP" sigTRAP :: CInt
135 foreign import ccall unsafe "__hsposix_SIGURG" sigURG :: CInt
136 foreign import ccall unsafe "__hsposix_SIGVTALRM" sigVTALRM :: CInt
137 foreign import ccall unsafe "__hsposix_SIGXCPU" sigXCPU :: CInt
138 foreign import ccall unsafe "__hsposix_SIGXFSZ" sigXFSZ :: CInt
140 internalAbort ::Signal
141 internalAbort = sigABRT
143 realTimeAlarm :: Signal
144 realTimeAlarm = sigALRM
149 processStatusChanged :: Signal
150 processStatusChanged = sigCHLD
152 #ifndef cygwin32_TARGET_OS
153 continueProcess :: Signal
154 continueProcess = sigCONT
157 floatingPointException :: Signal
158 floatingPointException = sigFPE
160 lostConnection :: Signal
161 lostConnection = sigHUP
163 illegalInstruction :: Signal
164 illegalInstruction = sigILL
166 keyboardSignal :: Signal
167 keyboardSignal = sigINT
169 killProcess :: Signal
170 killProcess = sigKILL
172 openEndedPipe :: Signal
173 openEndedPipe = sigPIPE
175 keyboardTermination :: Signal
176 keyboardTermination = sigQUIT
178 segmentationViolation :: Signal
179 segmentationViolation = sigSEGV
181 softwareStop :: Signal
182 softwareStop = sigSTOP
184 softwareTermination :: Signal
185 softwareTermination = sigTERM
187 keyboardStop :: Signal
188 keyboardStop = sigTSTP
190 backgroundRead :: Signal
191 backgroundRead = sigTTIN
193 backgroundWrite :: Signal
194 backgroundWrite = sigTTOU
196 userDefinedSignal1 :: Signal
197 userDefinedSignal1 = sigUSR1
199 userDefinedSignal2 :: Signal
200 userDefinedSignal2 = sigUSR2
203 pollableEvent :: Signal
204 pollableEvent = sigPOLL
207 profilingTimerExpired :: Signal
208 profilingTimerExpired = sigPROF
210 badSystemCall :: Signal
211 badSystemCall = sigSYS
213 breakpointTrap :: Signal
214 breakpointTrap = sigTRAP
216 urgentDataAvailable :: Signal
217 urgentDataAvailable = sigURG
219 virtualTimerExpired :: Signal
220 virtualTimerExpired = sigVTALRM
222 cpuTimeLimitExceeded :: Signal
223 cpuTimeLimitExceeded = sigXCPU
225 fileSizeLimitExceeded :: Signal
226 fileSizeLimitExceeded = sigXFSZ
228 -- -----------------------------------------------------------------------------
229 -- Signal-related functions
231 signalProcess :: Signal -> ProcessID -> IO ()
232 signalProcess sig pid
233 = throwErrnoIfMinus1_ "signalProcess" (c_kill (fromIntegral pid) sig)
235 foreign import ccall unsafe "kill"
236 c_kill :: CPid -> CInt -> IO CInt
238 signalProcessGroup :: Signal -> ProcessGroupID -> IO ()
239 signalProcessGroup sig pgid
240 = throwErrnoIfMinus1_ "signalProcessGroup" (c_killpg (fromIntegral pgid) sig)
242 foreign import ccall unsafe "killpg"
243 c_killpg :: CPid -> CInt -> IO CInt
245 raiseSignal :: Signal -> IO ()
246 raiseSignal sig = throwErrnoIfMinus1_ "raiseSignal" (c_raise sig)
248 foreign import ccall unsafe "raise"
249 c_raise :: CInt -> IO CInt
251 data Handler = Default
257 installHandler :: Signal
259 -> Maybe SignalSet -- other signals to block
260 -> IO Handler -- old handler
262 #ifdef __PARALLEL_HASKELL__
264 error "installHandler: not available for Parallel Haskell"
267 installHandler int handler maybe_mask = do
269 Nothing -> install' nullPtr
270 Just (SignalSet x) -> withForeignPtr x $ install'
275 rc <- case handler of
276 Default -> stg_sig_install int (#const STG_SIG_DFL) p_sp mask
277 Ignore -> stg_sig_install int (#const STG_SIG_IGN) p_sp mask
278 Catch m -> install'' m p_sp mask int (#const STG_SIG_HAN)
279 CatchOnce m -> install'' m p_sp mask int (#const STG_SIG_RST)
282 (#const STG_SIG_DFL) -> return Default
283 (#const STG_SIG_IGN) -> return Ignore
284 (#const STG_SIG_ERR) -> throwErrno "installHandler"
285 (#const STG_SIG_HAN) -> do
286 m <- peekHandler p_sp
288 (#const STG_SIG_RST) -> do
289 m <- peekHandler p_sp
292 install'' m p_sp mask int reset = do
293 sptr <- newStablePtr m
295 stg_sig_install int reset p_sp mask
297 peekHandler p_sp = do
301 foreign import ccall unsafe
302 stg_sig_install :: CInt -> CInt -> Ptr (StablePtr (IO ())) -> Ptr CSigset
305 #endif // !__PARALLEL_HASKELL__
307 -- -----------------------------------------------------------------------------
310 scheduleAlarm :: Int -> IO Int
311 scheduleAlarm secs = do
312 r <- c_alarm (fromIntegral secs)
313 return (fromIntegral r)
315 foreign import ccall unsafe "alarm"
316 c_alarm :: CUInt -> IO CUInt
318 -- -----------------------------------------------------------------------------
319 -- The NOCLDSTOP flag
321 foreign import ccall "&nocldstop" nocldstop :: Ptr Int
323 -- | Tells the system whether or not to set the @SA_NOCLDSTOP@ flag when
324 -- installing new signal handlers.
325 setStoppedChildFlag :: Bool -> IO Bool
326 setStoppedChildFlag b = do
329 return (rc == (0::Int))
331 x = case b of {True -> 0; False -> 1}
333 -- | Queries the current state of the stopped child flag.
334 queryStoppedChildFlag :: IO Bool
335 queryStoppedChildFlag = do
337 return (rc == (0::Int))
339 -- -----------------------------------------------------------------------------
340 -- Manipulating signal sets
342 newtype SignalSet = SignalSet (ForeignPtr CSigset)
344 emptySignalSet :: SignalSet
345 emptySignalSet = unsafePerformIO $ do
346 fp <- mallocForeignPtrBytes sizeof_sigset_t
347 throwErrnoIfMinus1_ "emptySignalSet" (withForeignPtr fp $ c_sigemptyset)
348 return (SignalSet fp)
350 fullSignalSet :: SignalSet
351 fullSignalSet = unsafePerformIO $ do
352 fp <- mallocForeignPtrBytes sizeof_sigset_t
353 throwErrnoIfMinus1_ "fullSignalSet" (withForeignPtr fp $ c_sigfillset)
354 return (SignalSet fp)
356 infixr `addSignal`, `deleteSignal`
357 addSignal :: Signal -> SignalSet -> SignalSet
358 addSignal sig (SignalSet fp1) = unsafePerformIO $ do
359 fp2 <- mallocForeignPtrBytes sizeof_sigset_t
360 withForeignPtr fp1 $ \p1 ->
361 withForeignPtr fp2 $ \p2 -> do
362 copyBytes p2 p1 sizeof_sigset_t
363 throwErrnoIfMinus1_ "addSignal" (c_sigaddset p2 sig)
364 return (SignalSet fp2)
366 deleteSignal :: Signal -> SignalSet -> SignalSet
367 deleteSignal sig (SignalSet fp1) = unsafePerformIO $ do
368 fp2 <- mallocForeignPtrBytes sizeof_sigset_t
369 withForeignPtr fp1 $ \p1 ->
370 withForeignPtr fp2 $ \p2 -> do
371 copyBytes p2 p1 sizeof_sigset_t
372 throwErrnoIfMinus1_ "deleteSignal" (c_sigdelset p2 sig)
373 return (SignalSet fp2)
375 inSignalSet :: Signal -> SignalSet -> Bool
376 inSignalSet sig (SignalSet fp) = unsafePerformIO $
377 withForeignPtr fp $ \p -> do
378 r <- throwErrnoIfMinus1 "inSignalSet" (c_sigismember p sig)
381 getSignalMask :: IO SignalSet
383 fp <- mallocForeignPtrBytes sizeof_sigset_t
384 withForeignPtr fp $ \p ->
385 throwErrnoIfMinus1_ "getSignalMask" (c_sigprocmask 0 nullPtr p)
386 return (SignalSet fp)
388 sigProcMask :: String -> CInt -> SignalSet -> IO ()
389 sigProcMask fn how (SignalSet set) =
390 withForeignPtr set $ \p_set ->
391 throwErrnoIfMinus1_ fn (c_sigprocmask how p_set nullPtr)
393 setSignalMask :: SignalSet -> IO ()
394 setSignalMask set = sigProcMask "setSignalMask" c_SIG_SETMASK set
396 blockSignals :: SignalSet -> IO ()
397 blockSignals set = sigProcMask "blockSignals" c_SIG_BLOCK set
399 unblockSignals :: SignalSet -> IO ()
400 unblockSignals set = sigProcMask "unblockSignals" c_SIG_UNBLOCK set
402 getPendingSignals :: IO SignalSet
403 getPendingSignals = do
404 fp <- mallocForeignPtrBytes sizeof_sigset_t
405 withForeignPtr fp $ \p ->
406 throwErrnoIfMinus1_ "getPendingSignals" (c_sigpending p)
407 return (SignalSet fp)
409 #ifndef cygwin32_TARGET_OS
410 awaitSignal :: Maybe SignalSet -> IO ()
411 awaitSignal maybe_sigset = do
412 fp <- case maybe_sigset of
413 Nothing -> do SignalSet fp <- getSignalMask; return fp
414 Just (SignalSet fp) -> return fp
415 withForeignPtr fp $ \p -> do
418 -- ignore the return value; according to the docs it can only ever be
419 -- (-1) with errno set to EINTR.
421 foreign import ccall unsafe "sigsuspend"
422 c_sigsuspend :: Ptr CSigset -> IO CInt
425 foreign import ccall unsafe "__hscore_sigdelset"
426 c_sigdelset :: Ptr CSigset -> CInt -> IO CInt
428 foreign import ccall unsafe "__hscore_sigfillset"
429 c_sigfillset :: Ptr CSigset -> IO CInt
431 foreign import ccall unsafe "__hscore_sigismember"
432 c_sigismember :: Ptr CSigset -> CInt -> IO CInt
434 foreign import ccall unsafe "sigpending"
435 c_sigpending :: Ptr CSigset -> IO CInt
437 foreign import ccall unsafe "__hsposix_SIG_BLOCK" c_SIG_BLOCK :: CInt
438 foreign import ccall unsafe "__hsposix_SIG_SETMASK" c_SIG_SETMASK :: CInt
439 foreign import ccall unsafe "__hsposix_SIG_UNBLOCK" c_SIG_UNBLOCK :: CInt
441 #endif /* mingw32_TARGET_OS */