FIX properly kill processes after xmonad has started

This commit is contained in:
Nathan Dwarshuis 2022-12-28 14:18:39 -05:00
parent a6ef4c8c50
commit f3b0fb6ec5
1 changed files with 41 additions and 13 deletions

View File

@ -28,7 +28,11 @@ import qualified RIO.Text as T
import System.Environment import System.Environment
import System.Posix.Signals import System.Posix.Signals
import System.Process (getPid) import System.Process
( getPid
, getProcessExitCode
)
import System.Process.Typed (nullStream)
import XMonad import XMonad
import XMonad.Actions.CopyWindow import XMonad.Actions.CopyWindow
@ -189,9 +193,13 @@ features cl = FeatureSet
startXmobar :: FIO (Process Handle () ()) startXmobar :: FIO (Process Handle () ())
startXmobar = do startXmobar = do
p <- proc "xmobar" [] (startProcess . setStdin createPipe . setCreateGroup True) p <- proc "xmobar" [] start
io $ hSetBuffering (getStdin p) LineBuffering io $ hSetBuffering (getStdin p) LineBuffering
return p return p
where
start = startProcess
. setStdin createPipe
. setCreateGroup True
startChildDaemons :: FeatureSet -> FIO [Process () () ()] startChildDaemons :: FeatureSet -> FIO [Process () () ()]
startChildDaemons fs = catMaybes <$> mapM executeSometimes (fsDaemons fs) startChildDaemons fs = catMaybes <$> mapM executeSometimes (fsDaemons fs)
@ -208,14 +216,14 @@ withChildDaemons fs = bracket (startChildDaemons fs) cleanup
where where
cleanup ps = do cleanup ps = do
logInfo "stopping child processes" logInfo "stopping child processes"
mapM_ stopProcess ps mapM_ (io . killNoWait) ps
withXmobar :: (Process Handle () () -> FIO a) -> FIO a withXmobar :: (Process Handle () () -> FIO a) -> FIO a
withXmobar = bracket startXmobar cleanup withXmobar = bracket startXmobar cleanup
where where
cleanup p = do cleanup p = do
logInfo "stopping xmobar child process" logInfo "stopping xmobar child process"
stopProcess p io $ killNoWait p
printDeps :: FIO () printDeps :: FIO ()
printDeps = do printDeps = do
@ -256,15 +264,35 @@ data ThreadState = ThreadState
runCleanup :: ThreadState -> DBusState -> X () runCleanup :: ThreadState -> DBusState -> X ()
runCleanup ts db = io $ do runCleanup ts db = io $ do
mapM_ killNoWait $ tsXmobar ts mapM_ killNoWait $ tsXmobar ts
finally (mapM_ killNoWait $ tsChildPIDs ts) $ mapM_ killNoWait $ tsChildPIDs ts
disconnectDBusX db disconnectDBusX db
where
stopNoWait p = handleIO (\_ -> return ()) $ stopProcess p -- | Kill a process (group) after xmonad has already started
killNoWait p = do -- This is necessary (as opposed to 'stopProcess' from rio) because a) xmonad
let ph = unsafeProcessHandle p -- sets the handler for sigCHLD to Ignore which breaks 'waitForProcess' (which
i <- getPid ph -- in turn will break 'stopProcess') and b) because I want to kill off entire
forM_ i $ signalProcessGroup sigTERM -- process groups since they may spawn child processes themselves. NOTE:
stopNoWait p -- 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 -- | Startuphook configuration