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 -- -----------------------------------------------------------------------------
120 sigABRT = CONST_SIGABRT :: CInt
121 sigALRM = CONST_SIGALRM :: CInt
122 sigBUS = CONST_SIGBUS :: CInt
123 sigCHLD = CONST_SIGCHLD :: CInt
124 sigCONT = CONST_SIGCONT :: CInt
125 sigFPE = CONST_SIGFPE :: CInt
126 sigHUP = CONST_SIGHUP :: CInt
127 sigILL = CONST_SIGILL :: CInt
128 sigINT = CONST_SIGINT :: CInt
129 sigKILL = CONST_SIGKILL :: CInt
130 sigPIPE = CONST_SIGPIPE :: CInt
131 sigQUIT = CONST_SIGQUIT :: CInt
132 sigSEGV = CONST_SIGSEGV :: CInt
133 sigSTOP = CONST_SIGSTOP :: CInt
134 sigTERM = CONST_SIGTERM :: CInt
135 sigTSTP = CONST_SIGTSTP :: CInt
136 sigTTIN = CONST_SIGTTIN :: CInt
137 sigTTOU = CONST_SIGTTOU :: CInt
138 sigUSR1 = CONST_SIGUSR1 :: CInt
139 sigUSR2 = CONST_SIGUSR2 :: CInt
140 sigPOLL = CONST_SIGPOLL :: CInt
141 sigPROF = CONST_SIGPROF :: CInt
142 sigSYS = CONST_SIGSYS :: CInt
143 sigTRAP = CONST_SIGTRAP :: CInt
144 sigURG = CONST_SIGURG :: CInt
145 sigVTALRM = CONST_SIGVTALRM :: CInt
146 sigXCPU = CONST_SIGXCPU :: CInt
147 sigXFSZ = CONST_SIGXFSZ :: CInt
149 internalAbort ::Signal
150 internalAbort = sigABRT
152 realTimeAlarm :: Signal
153 realTimeAlarm = sigALRM
158 processStatusChanged :: Signal
159 processStatusChanged = sigCHLD
161 continueProcess :: Signal
162 continueProcess = sigCONT
164 floatingPointException :: Signal
165 floatingPointException = sigFPE
167 lostConnection :: Signal
168 lostConnection = sigHUP
170 illegalInstruction :: Signal
171 illegalInstruction = sigILL
173 keyboardSignal :: Signal
174 keyboardSignal = sigINT
176 killProcess :: Signal
177 killProcess = sigKILL
179 openEndedPipe :: Signal
180 openEndedPipe = sigPIPE
182 keyboardTermination :: Signal
183 keyboardTermination = sigQUIT
185 segmentationViolation :: Signal
186 segmentationViolation = sigSEGV
188 softwareStop :: Signal
189 softwareStop = sigSTOP
191 softwareTermination :: Signal
192 softwareTermination = sigTERM
194 keyboardStop :: Signal
195 keyboardStop = sigTSTP
197 backgroundRead :: Signal
198 backgroundRead = sigTTIN
200 backgroundWrite :: Signal
201 backgroundWrite = sigTTOU
203 userDefinedSignal1 :: Signal
204 userDefinedSignal1 = sigUSR1
206 userDefinedSignal2 :: Signal
207 userDefinedSignal2 = sigUSR2
209 #if CONST_SIGPOLL != -1
210 pollableEvent :: Signal
211 pollableEvent = sigPOLL
214 profilingTimerExpired :: Signal
215 profilingTimerExpired = sigPROF
217 badSystemCall :: Signal
218 badSystemCall = sigSYS
220 breakpointTrap :: Signal
221 breakpointTrap = sigTRAP
223 urgentDataAvailable :: Signal
224 urgentDataAvailable = sigURG
226 virtualTimerExpired :: Signal
227 virtualTimerExpired = sigVTALRM
229 cpuTimeLimitExceeded :: Signal
230 cpuTimeLimitExceeded = sigXCPU
232 fileSizeLimitExceeded :: Signal
233 fileSizeLimitExceeded = sigXFSZ
235 -- -----------------------------------------------------------------------------
236 -- Signal-related functions
238 signalProcess :: Signal -> ProcessID -> IO ()
239 signalProcess sig pid
240 = throwErrnoIfMinus1_ "signalProcess" (c_kill (fromIntegral pid) sig)
242 foreign import ccall unsafe "kill"
243 c_kill :: CPid -> CInt -> IO CInt
245 signalProcessGroup :: Signal -> ProcessGroupID -> IO ()
246 signalProcessGroup sig pgid
247 = throwErrnoIfMinus1_ "signalProcessGroup" (c_killpg (fromIntegral pgid) sig)
249 foreign import ccall unsafe "killpg"
250 c_killpg :: CPid -> CInt -> IO CInt
252 raiseSignal :: Signal -> IO ()
253 raiseSignal sig = throwErrnoIfMinus1_ "raiseSignal" (c_raise sig)
255 #if defined(__GLASGOW_HASKELL__) && (defined(openbsd_HOST_OS) || defined(freebsd_HOST_OS))
256 foreign import ccall unsafe "genericRaise"
257 c_raise :: CInt -> IO CInt
259 foreign import ccall unsafe "raise"
260 c_raise :: CInt -> IO CInt
263 #ifdef __GLASGOW_HASKELL__
264 data Handler = Default
270 installHandler :: Signal
272 -> Maybe SignalSet -- other signals to block
273 -> IO Handler -- old handler
275 #ifdef __PARALLEL_HASKELL__
277 error "installHandler: not available for Parallel Haskell"
280 installHandler int handler maybe_mask = do
282 Nothing -> install' nullPtr
283 Just (SignalSet x) -> withForeignPtr x $ install'
288 rc <- case handler of
289 Default -> stg_sig_install int STG_SIG_DFL p_sp mask
290 Ignore -> stg_sig_install int STG_SIG_IGN p_sp mask
291 Catch m -> hinstall m p_sp mask int STG_SIG_HAN
292 CatchOnce m -> hinstall m p_sp mask int STG_SIG_RST
295 STG_SIG_DFL -> return Default
296 STG_SIG_IGN -> return Ignore
297 STG_SIG_ERR -> throwErrno "installHandler"
299 m <- peekHandler p_sp
302 m <- peekHandler p_sp
305 error "internal error: System.Posix.Signals.installHandler"
307 hinstall m p_sp mask int reset = do
308 sptr <- newStablePtr m
310 stg_sig_install int reset p_sp mask
312 peekHandler p_sp = do
316 foreign import ccall unsafe
319 -> CInt -- action code (STG_SIG_HAN etc.)
320 -> Ptr (StablePtr (IO ())) -- (in, out) Haskell handler
321 -> Ptr CSigset -- (in, out) blocked
322 -> IO CInt -- (ret) action code
324 #endif /* !__PARALLEL_HASKELL__ */
325 #endif /* __GLASGOW_HASKELL__ */
327 -- -----------------------------------------------------------------------------
330 scheduleAlarm :: Int -> IO Int
331 scheduleAlarm secs = do
332 r <- c_alarm (fromIntegral secs)
333 return (fromIntegral r)
335 foreign import ccall unsafe "alarm"
336 c_alarm :: CUInt -> IO CUInt
338 #ifdef __GLASGOW_HASKELL__
339 -- -----------------------------------------------------------------------------
340 -- The NOCLDSTOP flag
342 foreign import ccall "&nocldstop" nocldstop :: Ptr Int
344 -- | Tells the system whether or not to set the @SA_NOCLDSTOP@ flag when
345 -- installing new signal handlers.
346 setStoppedChildFlag :: Bool -> IO Bool
347 setStoppedChildFlag b = do
349 poke nocldstop $ fromEnum (not b)
350 return (rc == (0::Int))
352 -- | Queries the current state of the stopped child flag.
353 queryStoppedChildFlag :: IO Bool
354 queryStoppedChildFlag = do
356 return (rc == (0::Int))
357 #endif /* __GLASGOW_HASKELL__ */
359 -- -----------------------------------------------------------------------------
360 -- Manipulating signal sets
362 newtype SignalSet = SignalSet (ForeignPtr CSigset)
364 emptySignalSet :: SignalSet
365 emptySignalSet = unsafePerformIO $ do
366 fp <- mallocForeignPtrBytes sizeof_sigset_t
367 throwErrnoIfMinus1_ "emptySignalSet" (withForeignPtr fp $ c_sigemptyset)
368 return (SignalSet fp)
370 fullSignalSet :: SignalSet
371 fullSignalSet = unsafePerformIO $ do
372 fp <- mallocForeignPtrBytes sizeof_sigset_t
373 throwErrnoIfMinus1_ "fullSignalSet" (withForeignPtr fp $ c_sigfillset)
374 return (SignalSet fp)
376 infixr `addSignal`, `deleteSignal`
377 addSignal :: Signal -> SignalSet -> SignalSet
378 addSignal sig (SignalSet fp1) = unsafePerformIO $ do
379 fp2 <- mallocForeignPtrBytes sizeof_sigset_t
380 withForeignPtr fp1 $ \p1 ->
381 withForeignPtr fp2 $ \p2 -> do
382 copyBytes p2 p1 sizeof_sigset_t
383 throwErrnoIfMinus1_ "addSignal" (c_sigaddset p2 sig)
384 return (SignalSet fp2)
386 deleteSignal :: Signal -> SignalSet -> SignalSet
387 deleteSignal sig (SignalSet fp1) = unsafePerformIO $ do
388 fp2 <- mallocForeignPtrBytes sizeof_sigset_t
389 withForeignPtr fp1 $ \p1 ->
390 withForeignPtr fp2 $ \p2 -> do
391 copyBytes p2 p1 sizeof_sigset_t
392 throwErrnoIfMinus1_ "deleteSignal" (c_sigdelset p2 sig)
393 return (SignalSet fp2)
395 inSignalSet :: Signal -> SignalSet -> Bool
396 inSignalSet sig (SignalSet fp) = unsafePerformIO $
397 withForeignPtr fp $ \p -> do
398 r <- throwErrnoIfMinus1 "inSignalSet" (c_sigismember p sig)
401 getSignalMask :: IO SignalSet
403 fp <- mallocForeignPtrBytes sizeof_sigset_t
404 withForeignPtr fp $ \p ->
405 throwErrnoIfMinus1_ "getSignalMask" (c_sigprocmask 0 nullPtr p)
406 return (SignalSet fp)
408 sigProcMask :: String -> CInt -> SignalSet -> IO ()
409 sigProcMask fn how (SignalSet set) =
410 withForeignPtr set $ \p_set ->
411 throwErrnoIfMinus1_ fn (c_sigprocmask how p_set nullPtr)
413 setSignalMask :: SignalSet -> IO ()
414 setSignalMask set = sigProcMask "setSignalMask" (CONST_SIG_SETMASK :: CInt) set
416 blockSignals :: SignalSet -> IO ()
417 blockSignals set = sigProcMask "blockSignals" (CONST_SIG_BLOCK :: CInt) set
419 unblockSignals :: SignalSet -> IO ()
420 unblockSignals set = sigProcMask "unblockSignals" (CONST_SIG_UNBLOCK :: CInt) set
422 getPendingSignals :: IO SignalSet
423 getPendingSignals = do
424 fp <- mallocForeignPtrBytes sizeof_sigset_t
425 withForeignPtr fp $ \p ->
426 throwErrnoIfMinus1_ "getPendingSignals" (c_sigpending p)
427 return (SignalSet fp)
429 #ifndef cygwin32_HOST_OS
430 awaitSignal :: Maybe SignalSet -> IO ()
431 awaitSignal maybe_sigset = do
432 fp <- case maybe_sigset of
433 Nothing -> do SignalSet fp <- getSignalMask; return fp
434 Just (SignalSet fp) -> return fp
435 withForeignPtr fp $ \p -> do
438 -- ignore the return value; according to the docs it can only ever be
439 -- (-1) with errno set to EINTR.
441 foreign import ccall unsafe "sigsuspend"
442 c_sigsuspend :: Ptr CSigset -> IO CInt
446 foreign import ccall unsafe "sigdelset"
447 c_sigdelset :: Ptr CSigset -> CInt -> IO CInt
449 foreign import ccall unsafe "sigfillset"
450 c_sigfillset :: Ptr CSigset -> IO CInt
452 foreign import ccall unsafe "sigismember"
453 c_sigismember :: Ptr CSigset -> CInt -> IO CInt
455 foreign import ccall unsafe "__hscore_sigdelset"
456 c_sigdelset :: Ptr CSigset -> CInt -> IO CInt
458 foreign import ccall unsafe "__hscore_sigfillset"
459 c_sigfillset :: Ptr CSigset -> IO CInt
461 foreign import ccall unsafe "__hscore_sigismember"
462 c_sigismember :: Ptr CSigset -> CInt -> IO CInt
463 #endif /* __HUGS__ */
465 foreign import ccall unsafe "sigpending"
466 c_sigpending :: Ptr CSigset -> IO CInt
468 #endif /* mingw32_HOST_OS */