aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--Main.hs1
-rw-r--r--XMonad/Core.hs45
-rw-r--r--XMonad/Main.hsc5
3 files changed, 32 insertions, 19 deletions
diff --git a/Main.hs b/Main.hs
index 84eca32..29ae822 100644
--- a/Main.hs
+++ b/Main.hs
@@ -32,6 +32,7 @@ import qualified Properties
-- for xmonad, and if it doesn't find one, just launches the default.
main :: IO ()
main = do
+ installSignalHandlers -- important to ignore SIGCHLD to avoid zombies
args <- getArgs
let launch = catchIO buildLaunch >> xmonad defaultConfig
case args of
diff --git a/XMonad/Core.hs b/XMonad/Core.hs
index b2eb959..eedeed4 100644
--- a/XMonad/Core.hs
+++ b/XMonad/Core.hs
@@ -24,28 +24,31 @@ module XMonad.Core (
XConf(..), XConfig(..), LayoutClass(..),
Layout(..), readsLayout, Typeable, Message,
SomeMessage(..), fromMessage, LayoutMessages(..),
- runX, catchX, userCode, userCodeDef, io, catchIO, doubleFork,
+ runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers,
withDisplay, withWindowSet, isRoot, runOnWorkspaces,
- getAtom, spawn, getXMonadDir, recompile, trace, whenJust, whenX,
+ getAtom, spawn, spawnPID, getXMonadDir, recompile, trace, whenJust, whenX,
atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, ManageHook, Query(..), runQuery
) where
import XMonad.StackSet hiding (modify)
import Prelude hiding ( catch )
-import Control.Exception (catch, bracket, throw, Exception(ExitException))
+import Control.Exception (catch, try, bracket, throw, Exception(ExitException))
import Control.Applicative
import Control.Monad.State
import Control.Monad.Reader
import System.IO
import System.Info
-import System.Posix.Process (executeFile, forkProcess, getProcessStatus, createSession)
+import System.Posix.Process (executeFile, forkProcess, getAnyProcessStatus)
+import System.Posix.Signals
+import System.Posix.Types (ProcessID)
import System.Process
import System.Directory
import System.Exit
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras (Event)
import Data.Typeable
+import Data.Maybe (isJust)
import Data.Monoid
import Data.Maybe (fromMaybe)
@@ -349,17 +352,10 @@ catchIO f = io (f `catch` \e -> hPrint stderr e >> hFlush stderr)
-- | spawn. Launch an external application. Specifically, it double-forks and
-- runs the 'String' you pass as a command to /bin/sh.
spawn :: MonadIO m => String -> m ()
-spawn x = doubleFork $ executeFile "/bin/sh" False ["-c", x] Nothing
-
--- | Double fork and execute an 'IO' action (usually one of the exec family of
--- functions)
-doubleFork :: MonadIO m => IO () -> m ()
-doubleFork m = io $ do
- pid <- forkProcess $ do
- forkProcess (createSession >> m)
- exitWith ExitSuccess
- getProcessStatus True False pid
- return ()
+spawn x = spawnPID x >> return ()
+
+spawnPID :: MonadIO m => String -> m ProcessID
+spawnPID x = io $ forkProcess $ executeFile "/bin/sh" False ["-c", x] Nothing
-- | This is basically a map function, running a function in the 'X' monad on
-- each workspace with the output of that function being the modified workspace.
@@ -404,10 +400,15 @@ recompile force = io $ do
binT <- getModTime bin
if (force || srcT > binT)
then do
+ -- temporarily disable SIGCHLD ignoring:
+ installHandler sigCHLD Default Nothing
status <- bracket (openFile err WriteMode) hClose $ \h -> do
waitForProcess =<< runProcess "ghc" ["--make", "xmonad.hs", "-i", "-no-recomp", "-v0", "-o",binn] (Just dir)
Nothing Nothing Nothing (Just h)
+ -- re-enable SIGCHLD:
+ installSignalHandlers
+
-- now, if it fails, run xmessage to let the user know:
when (status /= ExitSuccess) $ do
ghcErr <- readFile err
@@ -417,7 +418,8 @@ recompile force = io $ do
-- nb, the ordering of printing, then forking, is crucial due to
-- lazy evaluation
hPutStrLn stderr msg
- doubleFork $ executeFile "xmessage" True ["-default", "okay", msg] Nothing
+ forkProcess $ executeFile "xmessage" True ["-default", "okay", msg] Nothing
+ return ()
return (status == ExitSuccess)
else return True
where getModTime f = catch (Just <$> getModificationTime f) (const $ return Nothing)
@@ -434,3 +436,14 @@ whenX a f = a >>= \b -> when b f
-- be found in your .xsession-errors file
trace :: MonadIO m => String -> m ()
trace = io . hPutStrLn stderr
+
+-- | Ignore SIGPIPE to avoid termination when a pipe is full, and SIGCHLD to
+-- avoid zombie processes, and clean up any extant zombie processes.
+installSignalHandlers :: MonadIO m => m ()
+installSignalHandlers = io $ do
+ installHandler openEndedPipe Ignore Nothing
+ installHandler sigCHLD Ignore Nothing
+ try $ fix $ \more -> do
+ x <- getAnyProcessStatus False False
+ when (isJust x) more
+ return ()
diff --git a/XMonad/Main.hsc b/XMonad/Main.hsc
index 531939e..99bc77f 100644
--- a/XMonad/Main.hsc
+++ b/XMonad/Main.hsc
@@ -27,7 +27,6 @@ import Foreign.C
import Foreign.Ptr
import System.Environment (getArgs)
-import System.Posix.Signals
import Graphics.X11.Xlib hiding (refreshKeyboardMapping)
import Graphics.X11.Xlib.Extras
@@ -57,8 +56,8 @@ xmonad :: (LayoutClass l Window, Read (l Window)) => XConfig l -> IO ()
xmonad initxmc = do
-- setup locale information from environment
withCString "" $ c_setlocale (#const LC_ALL)
- -- ignore SIGPIPE
- installHandler openEndedPipe Ignore Nothing
+ -- ignore SIGPIPE and SIGCHLD
+ installSignalHandlers
-- First, wrap the layout in an existential, to keep things pretty:
let xmc = initxmc { layoutHook = Layout $ layoutHook initxmc }
dpy <- openDisplay ""