xmonad-config/lib/Process.hs

45 lines
1.6 KiB
Haskell

{-# LANGUAGE LambdaCase #-}
module Process where
import Control.Concurrent
import Control.Exception
import Control.Monad
import System.Directory
import System.Exit
import System.Posix.Signals
import System.Posix.Types
import System.Process (waitForProcess)
import System.Process.Internals
( ProcessHandle__ (ClosedHandle, OpenHandle)
, mkProcessHandle
, withProcessHandle
)
-- | Block until a PID has exited (in any form)
-- ASSUMPTION on linux PIDs will always increase until they overflow, in which
-- case they will start to recycle. Barring any fork bombs, this code should
-- work because we can reasonably expect that no processes will spawn with the
-- same PID within the delay limit
-- TODO this will not work if the process is a zombie (maybe I care...)
waitUntilExit :: Show t => t -> IO ()
waitUntilExit pid = do
res <- doesDirectoryExist $ "/proc/" ++ show pid
when res $ threadDelay 100000 >> waitUntilExit pid
killPID :: ProcessID -> IO ()
killPID pid = do
h <- mkProcessHandle pid False
-- this may fail of the PID does not exist
_ <- try $ sendSIGTERM h :: IO (Either IOException ())
-- this may fail if the process exits instantly and the handle
-- is destroyed by the time we get to this line (I think?)
_ <- try $ waitForProcess h :: IO (Either IOException ExitCode)
return ()
where
sendSIGTERM h = withProcessHandle h $ \case
OpenHandle _ -> signalProcess sigTERM pid
ClosedHandle _ -> return ()
_ -> return () -- this should never happen