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 -- MISSING FUNCTIONALITY:
79 -- sigaction(), (inc. the sigaction structure + flags etc.)
80 -- the siginfo structure
82 -- sighold, sigignore, sigpause, sigrelse, sigset
91 import System.IO.Unsafe
92 import System.Posix.Types
93 import System.Posix.Internals
95 #ifndef mingw32_TARGET_OS
98 -- -----------------------------------------------------------------------------
106 foreign import ccall "__hsposix_SIGABRT" sigABRT :: CInt
107 foreign import ccall "__hsposix_SIGALRM" sigALRM :: CInt
108 foreign import ccall "__hsposix_SIGBUS" sigBUS :: CInt
109 foreign import ccall "__hsposix_SIGCHLD" sigCHLD :: CInt
110 foreign import ccall "__hsposix_SIGCONT" sigCONT :: CInt
111 foreign import ccall "__hsposix_SIGFPE" sigFPE :: CInt
112 foreign import ccall "__hsposix_SIGHUP" sigHUP :: CInt
113 foreign import ccall "__hsposix_SIGILL" sigILL :: CInt
114 foreign import ccall "__hsposix_SIGINT" sigINT :: CInt
115 foreign import ccall "__hsposix_SIGKILL" sigKILL :: CInt
116 foreign import ccall "__hsposix_SIGPIPE" sigPIPE :: CInt
117 foreign import ccall "__hsposix_SIGQUIT" sigQUIT :: CInt
118 foreign import ccall "__hsposix_SIGSEGV" sigSEGV :: CInt
119 foreign import ccall "__hsposix_SIGSTOP" sigSTOP :: CInt
120 foreign import ccall "__hsposix_SIGTERM" sigTERM :: CInt
121 foreign import ccall "__hsposix_SIGTSTP" sigTSTP :: CInt
122 foreign import ccall "__hsposix_SIGTTIN" sigTTIN :: CInt
123 foreign import ccall "__hsposix_SIGTTOU" sigTTOU :: CInt
124 foreign import ccall "__hsposix_SIGUSR1" sigUSR1 :: CInt
125 foreign import ccall "__hsposix_SIGUSR2" sigUSR2 :: CInt
127 foreign import ccall "__hsposix_SIGPOLL" sigPOLL :: CInt
129 foreign import ccall "__hsposix_SIGPROF" sigPROF :: CInt
130 foreign import ccall "__hsposix_SIGSYS" sigSYS :: CInt
131 foreign import ccall "__hsposix_SIGTRAP" sigTRAP :: CInt
132 foreign import ccall "__hsposix_SIGURG" sigURG :: CInt
133 foreign import ccall "__hsposix_SIGVTALRM" sigVTALRM :: CInt
134 foreign import ccall "__hsposix_SIGXCPU" sigXCPU :: CInt
135 foreign import ccall "__hsposix_SIGXFSZ" sigXFSZ :: CInt
137 internalAbort ::Signal
138 internalAbort = sigABRT
140 realTimeAlarm :: Signal
141 realTimeAlarm = sigALRM
146 processStatusChanged :: Signal
147 processStatusChanged = sigCHLD
149 #ifndef cygwin32_TARGET_OS
150 continueProcess :: Signal
151 continueProcess = sigCONT
154 floatingPointException :: Signal
155 floatingPointException = sigFPE
157 lostConnection :: Signal
158 lostConnection = sigHUP
160 illegalInstruction :: Signal
161 illegalInstruction = sigILL
163 keyboardSignal :: Signal
164 keyboardSignal = sigINT
166 killProcess :: Signal
167 killProcess = sigKILL
169 openEndedPipe :: Signal
170 openEndedPipe = sigPIPE
172 keyboardTermination :: Signal
173 keyboardTermination = sigQUIT
175 segmentationViolation :: Signal
176 segmentationViolation = sigSEGV
178 softwareStop :: Signal
179 softwareStop = sigSTOP
181 softwareTermination :: Signal
182 softwareTermination = sigTERM
184 keyboardStop :: Signal
185 keyboardStop = sigTSTP
187 backgroundRead :: Signal
188 backgroundRead = sigTTIN
190 backgroundWrite :: Signal
191 backgroundWrite = sigTTOU
193 userDefinedSignal1 :: Signal
194 userDefinedSignal1 = sigUSR1
196 userDefinedSignal2 :: Signal
197 userDefinedSignal2 = sigUSR2
200 pollableEvent :: Signal
201 pollableEvent = sigPOLL
204 profilingTimerExpired :: Signal
205 profilingTimerExpired = sigPROF
207 badSystemCall :: Signal
208 badSystemCall = sigSYS
210 breakpointTrap :: Signal
211 breakpointTrap = sigTRAP
213 urgentDataAvailable :: Signal
214 urgentDataAvailable = sigURG
216 virtualTimerExpired :: Signal
217 virtualTimerExpired = sigVTALRM
219 cpuTimeLimitExceeded :: Signal
220 cpuTimeLimitExceeded = sigXCPU
222 fileSizeLimitExceeded :: Signal
223 fileSizeLimitExceeded = sigXFSZ
225 -- -----------------------------------------------------------------------------
226 -- Signal-related functions
228 signalProcess :: Signal -> ProcessID -> IO ()
229 signalProcess sig pid
230 = throwErrnoIfMinus1_ "signalProcess" (c_kill (fromIntegral pid) sig)
232 foreign import ccall unsafe "kill"
233 c_kill :: CPid -> CInt -> IO CInt
235 signalProcessGroup :: Signal -> ProcessGroupID -> IO ()
236 signalProcessGroup sig pgid
237 = throwErrnoIfMinus1_ "signalProcessGroup" (c_killpg (fromIntegral pgid) sig)
239 foreign import ccall unsafe "killpg"
240 c_killpg :: CPid -> CInt -> IO CInt
242 raiseSignal :: Signal -> IO ()
243 raiseSignal sig = throwErrnoIfMinus1_ "raiseSignal" (c_raise sig)
245 foreign import ccall unsafe "raise"
246 c_raise :: CInt -> IO CInt
248 data Handler = Default
254 installHandler :: Signal
256 -> Maybe SignalSet -- other signals to block
257 -> IO Handler -- old handler
259 #ifdef __PARALLEL_HASKELL__
261 error "installHandler: not available for Parallel Haskell"
264 installHandler int handler maybe_mask = do
266 Nothing -> install' nullPtr
267 Just (SignalSet x) -> withForeignPtr x $ install'
272 rc <- case handler of
273 Default -> stg_sig_install int (#const STG_SIG_DFL) p_sp mask
274 Ignore -> stg_sig_install int (#const STG_SIG_IGN) p_sp mask
275 Catch m -> install'' m p_sp mask int (#const STG_SIG_HAN)
276 CatchOnce m -> install'' m p_sp mask int (#const STG_SIG_RST)
279 (#const STG_SIG_DFL) -> return Default
280 (#const STG_SIG_IGN) -> return Ignore
281 (#const STG_SIG_ERR) -> throwErrno "installHandler"
282 (#const STG_SIG_HAN) -> do
283 m <- peekHandler p_sp
285 (#const STG_SIG_RST) -> do
286 m <- peekHandler p_sp
289 install'' m p_sp mask int reset = do
290 sptr <- newStablePtr m
292 stg_sig_install int reset p_sp mask
294 peekHandler p_sp = do
298 foreign import ccall unsafe
299 stg_sig_install :: CInt -> CInt -> Ptr (StablePtr (IO ())) -> Ptr CSigset
302 #endif // !__PARALLEL_HASKELL__
304 -- -----------------------------------------------------------------------------
307 scheduleAlarm :: Int -> IO Int
308 scheduleAlarm secs = do
309 r <- c_alarm (fromIntegral secs)
310 return (fromIntegral r)
312 foreign import ccall unsafe "alarm"
313 c_alarm :: CUInt -> IO CUInt
315 -- -----------------------------------------------------------------------------
316 -- Manipulating signal sets
318 newtype SignalSet = SignalSet (ForeignPtr CSigset)
320 emptySignalSet :: SignalSet
321 emptySignalSet = unsafePerformIO $ do
322 fp <- mallocForeignPtrBytes sizeof_sigset_t
323 throwErrnoIfMinus1_ "emptySignalSet" (withForeignPtr fp $ c_sigemptyset)
324 return (SignalSet fp)
326 fullSignalSet :: SignalSet
327 fullSignalSet = unsafePerformIO $ do
328 fp <- mallocForeignPtrBytes sizeof_sigset_t
329 throwErrnoIfMinus1_ "fullSignalSet" (withForeignPtr fp $ c_sigfillset)
330 return (SignalSet fp)
332 infixr `addSignal`, `deleteSignal`
333 addSignal :: Signal -> SignalSet -> SignalSet
334 addSignal sig (SignalSet fp1) = unsafePerformIO $ do
335 fp2 <- mallocForeignPtrBytes sizeof_sigset_t
336 withForeignPtr fp1 $ \p1 ->
337 withForeignPtr fp2 $ \p2 -> do
338 copyBytes p2 p1 sizeof_sigset_t
339 throwErrnoIfMinus1_ "addSignal" (c_sigaddset p2 sig)
340 return (SignalSet fp2)
342 deleteSignal :: Signal -> SignalSet -> SignalSet
343 deleteSignal sig (SignalSet fp1) = unsafePerformIO $ do
344 fp2 <- mallocForeignPtrBytes sizeof_sigset_t
345 withForeignPtr fp1 $ \p1 ->
346 withForeignPtr fp2 $ \p2 -> do
347 copyBytes p2 p1 sizeof_sigset_t
348 throwErrnoIfMinus1_ "deleteSignal" (c_sigdelset p2 sig)
349 return (SignalSet fp2)
351 inSignalSet :: Signal -> SignalSet -> Bool
352 inSignalSet sig (SignalSet fp) = unsafePerformIO $
353 withForeignPtr fp $ \p -> do
354 r <- throwErrnoIfMinus1 "inSignalSet" (c_sigismember p sig)
357 getSignalMask :: IO SignalSet
359 fp <- mallocForeignPtrBytes sizeof_sigset_t
360 withForeignPtr fp $ \p ->
361 throwErrnoIfMinus1_ "getSignalMask" (c_sigprocmask 0 p nullPtr)
362 return (SignalSet fp)
364 sigProcMask :: String -> CInt -> SignalSet -> IO ()
365 sigProcMask fn how (SignalSet set) =
366 withForeignPtr set $ \p_set ->
367 throwErrnoIfMinus1_ fn (c_sigprocmask how p_set nullPtr)
369 setSignalMask :: SignalSet -> IO ()
370 setSignalMask set = sigProcMask "setSignalMask" c_SIG_SETMASK set
372 blockSignals :: SignalSet -> IO ()
373 blockSignals set = sigProcMask "blockSignals" c_SIG_BLOCK set
375 unblockSignals :: SignalSet -> IO ()
376 unblockSignals set = sigProcMask "unblockSignals" c_SIG_UNBLOCK set
378 getPendingSignals :: IO SignalSet
379 getPendingSignals = do
380 fp <- mallocForeignPtrBytes sizeof_sigset_t
381 withForeignPtr fp $ \p ->
382 throwErrnoIfMinus1_ "getPendingSignals" (c_sigpending p)
383 return (SignalSet fp)
385 #ifndef cygwin32_TARGET_OS
386 awaitSignal :: Maybe SignalSet -> IO ()
387 awaitSignal maybe_sigset = do
388 fp <- case maybe_sigset of
389 Nothing -> do SignalSet fp <- getSignalMask; return fp
390 Just (SignalSet fp) -> return fp
391 withForeignPtr fp $ \p -> do
394 -- ignore the return value; according to the docs it can only ever be
395 -- (-1) with errno set to EINTR.
397 foreign import ccall unsafe "sigsuspend"
398 c_sigsuspend :: Ptr CSigset -> IO CInt
401 foreign import ccall unsafe "__hscore_sigdelset"
402 c_sigdelset :: Ptr CSigset -> CInt -> IO CInt
404 foreign import ccall unsafe "__hscore_sigfillset"
405 c_sigfillset :: Ptr CSigset -> IO CInt
407 foreign import ccall unsafe "__hscore_sigismember"
408 c_sigismember :: Ptr CSigset -> CInt -> IO CInt
410 foreign import ccall unsafe "sigpending"
411 c_sigpending :: Ptr CSigset -> IO CInt
413 foreign import ccall unsafe "__hsposix_SIG_BLOCK" c_SIG_BLOCK :: CInt
414 foreign import ccall unsafe "__hsposix_SIG_SETMASK" c_SIG_SETMASK :: CInt
415 foreign import ccall unsafe "__hsposix_SIG_UNBLOCK" c_SIG_UNBLOCK :: CInt
417 #endif /* mingw32_TARGET_OS */