1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
|
{-# LANGUAGE DeriveDataTypeable, CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module : Signal
-- Copyright : (c) Andrea Rosatto
-- : (c) Jose A. Ortega Ruiz
-- : (c) Jochen Keil
-- License : BSD-style (see LICENSE)
--
-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>
-- Stability : unstable
-- Portability : unportable
--
-- Signal handling, including DBUS when available
--
-----------------------------------------------------------------------------
module Xmobar.System.Signal where
import Data.Foldable (for_)
import Data.Typeable (Typeable)
import Control.Concurrent
import Control.Concurrent.STM
import Control.Exception
import System.Posix.Signals
import Graphics.X11.Types (Button)
import Graphics.X11.Xlib.Types (Position)
import System.IO
#ifdef DBUS
import DBus (IsVariant(..))
import Control.Monad ((>=>))
#endif
safeHead :: [a] -> Maybe a
safeHead [] = Nothing
safeHead (x:_) = Just x
data WakeUp = WakeUp deriving (Show,Typeable)
instance Exception WakeUp
data SignalType = Wakeup
| Reposition
| ChangeScreen
| Hide Int
| Reveal Int
| Toggle Int
| TogglePersistent
| Action Button Position
deriving (Read, Show)
#ifdef DBUS
instance IsVariant SignalType where
toVariant = toVariant . show
fromVariant = fromVariant >=> parseSignalType
#endif
parseSignalType :: String -> Maybe SignalType
parseSignalType = fmap fst . safeHead . reads
-- | Signal handling
setupSignalHandler :: IO (TMVar SignalType)
setupSignalHandler = do
tid <- newEmptyTMVarIO
installHandler sigUSR2 (Catch $ updatePosHandler tid) Nothing
installHandler sigUSR1 (Catch $ changeScreenHandler tid) Nothing
return tid
updatePosHandler :: TMVar SignalType -> IO ()
updatePosHandler sig = do
atomically $ putTMVar sig Reposition
return ()
changeScreenHandler :: TMVar SignalType -> IO ()
changeScreenHandler sig = do
atomically $ putTMVar sig ChangeScreen
return ()
-- | Ensures that the given IO action runs its cleanup actions ('bracket' etc.),
-- even if a signal is caught.
--
-- An exception will be thrown on the thread that called this function when a
-- signal is caught.
withDeferSignals :: IO a -> IO a
withDeferSignals thing = do
threadId <- myThreadId
caughtSignal <- newEmptyMVar
let signals =
filter (not . flip inSignalSet reservedSignals)
[ sigQUIT
, sigTERM
--, sigINT -- Handler already installed by GHC
--, sigPIPE -- Handler already installed by GHC
--, sigUSR1 -- Handled by setupSignalHandler
--, sigUSR2 -- Handled by setupSignalHandler
-- One of the following appears to cause instability, see #360
--, sigHUP
--, sigILL
--, sigABRT
--, sigFPE
--, sigSEGV
--, sigALRM
--, sigBUS
--, sigPOLL
--, sigPROF
--, sigSYS
--, sigTRAP
--, sigVTALRM
--, sigXCPU
--, sigXFSZ
]
for_ signals $ \s ->
installHandler s
(Catch $ do
tryPutMVar caughtSignal s
hPutStrLn stderr ("xmobar: Caught signal "++show s++"; exiting...")
throwTo threadId ThreadKilled)
Nothing
thing `finally` do
s0 <- tryReadMVar caughtSignal
case s0 of
Nothing -> pure ()
Just s -> do
-- Run the default handler for the signal
-- hPutStrLn stderr ("xmobar: Running default handler for signal "++show s)
installHandler s Default Nothing
raiseSignal s
|
