diff --git a/bin/xmonad.hs b/bin/xmonad.hs index 2c8eb31..4ae5786 100644 --- a/bin/xmonad.hs +++ b/bin/xmonad.hs @@ -28,7 +28,11 @@ import qualified RIO.Text as T import System.Environment import System.Posix.Signals -import System.Process (getPid) +import System.Process + ( getPid + , getProcessExitCode + ) +import System.Process.Typed (nullStream) import XMonad import XMonad.Actions.CopyWindow @@ -189,9 +193,13 @@ features cl = FeatureSet startXmobar :: FIO (Process Handle () ()) startXmobar = do - p <- proc "xmobar" [] (startProcess . setStdin createPipe . setCreateGroup True) + p <- proc "xmobar" [] start io $ hSetBuffering (getStdin p) LineBuffering return p + where + start = startProcess + . setStdin createPipe + . setCreateGroup True startChildDaemons :: FeatureSet -> FIO [Process () () ()] startChildDaemons fs = catMaybes <$> mapM executeSometimes (fsDaemons fs) @@ -208,14 +216,14 @@ withChildDaemons fs = bracket (startChildDaemons fs) cleanup where cleanup ps = do logInfo "stopping child processes" - mapM_ stopProcess ps + mapM_ (io . killNoWait) ps withXmobar :: (Process Handle () () -> FIO a) -> FIO a withXmobar = bracket startXmobar cleanup where cleanup p = do logInfo "stopping xmobar child process" - stopProcess p + io $ killNoWait p printDeps :: FIO () printDeps = do @@ -256,15 +264,35 @@ data ThreadState = ThreadState runCleanup :: ThreadState -> DBusState -> X () runCleanup ts db = io $ do mapM_ killNoWait $ tsXmobar ts - finally (mapM_ killNoWait $ tsChildPIDs ts) $ - disconnectDBusX db - where - stopNoWait p = handleIO (\_ -> return ()) $ stopProcess p - killNoWait p = do - let ph = unsafeProcessHandle p - i <- getPid ph - forM_ i $ signalProcessGroup sigTERM - stopNoWait p + mapM_ killNoWait $ tsChildPIDs ts + disconnectDBusX db + +-- | Kill a process (group) after xmonad has already started +-- This is necessary (as opposed to 'stopProcess' from rio) because a) xmonad +-- sets the handler for sigCHLD to Ignore which breaks 'waitForProcess' (which +-- in turn will break 'stopProcess') and b) because I want to kill off entire +-- process groups since they may spawn child processes themselves. NOTE: +-- for reasons unknown I cannot just turn off/on the signal handlers here. +killNoWait :: Process a () () -> IO () +killNoWait p = do + -- this strategy is outlined/sanctioned in RIO.Process under + -- 'unsafeProcessHandle': + -- + -- get the handle (unsafely, since it breaks the semantics of RIO) + let ph = unsafeProcessHandle p + -- check if the process has already exited (if so, do nothing since trying + -- to kill it will open wormholes + ec <- getProcessExitCode ph + unless (isJust ec) $ do + -- send SIGTERM to the entire group (NOTE: 'System.Process.terminateProcess' + -- does not actually do this despite what the docs say) + i <- getPid ph + forM_ i $ signalProcessGroup sigTERM + -- actually call 'stopProcess' which will clean up associated data and + -- then try to wait for the exit, which will fail because we are assuming + -- this function is called when the handler for SIGCHLD is Ignore. Ignore + -- the failure and move on with life. + handleIO (\_ -> return ()) $ stopProcess p -------------------------------------------------------------------------------- -- | Startuphook configuration