{-# LANGUAGE ScopedTypeVariables #-}
module System.Unix.KillByCwd
( killByCwd
) where
import Control.Exception (catch)
import Control.Monad (liftM, filterM)
import Data.Char (isDigit)
import Data.List (isPrefixOf)
import Prelude hiding (catch)
import System.Directory (getDirectoryContents)
import System.Posix.Files (readSymbolicLink)
import System.Posix.Signals (signalProcess, sigTERM)
killByCwd :: FilePath -> IO [(String, Maybe String)]
killByCwd :: FilePath -> IO [(FilePath, Maybe FilePath)]
killByCwd FilePath
path =
do [FilePath]
pids <- ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit)) (FilePath -> IO [FilePath]
getDirectoryContents FilePath
"/proc")
[FilePath]
cwdPids <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> FilePath -> IO Bool
isCwd FilePath
path) [FilePath]
pids
[Maybe FilePath]
exePaths <- (FilePath -> IO (Maybe FilePath))
-> [FilePath] -> IO [Maybe FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO (Maybe FilePath)
exePath [FilePath]
cwdPids
(FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> IO ()
kill [FilePath]
cwdPids
[(FilePath, Maybe FilePath)] -> IO [(FilePath, Maybe FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> [Maybe FilePath] -> [(FilePath, Maybe FilePath)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
cwdPids [Maybe FilePath]
exePaths)
where
isCwd :: FilePath -> String -> IO Bool
isCwd :: FilePath -> FilePath -> IO Bool
isCwd FilePath
cwd FilePath
pid =
((FilePath -> Bool) -> IO FilePath -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
cwd) (FilePath -> IO FilePath
readSymbolicLink (FilePath
"/proc/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
pid FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"/cwd"))) IO Bool -> (IOError -> IO Bool) -> IO Bool
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\ (IOError
_ :: IOError) -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
exePath :: String -> IO (Maybe String)
exePath :: FilePath -> IO (Maybe FilePath)
exePath FilePath
pid = (FilePath -> IO FilePath
readSymbolicLink (FilePath
"/proc/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
pid FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"/exe") IO FilePath
-> (FilePath -> IO (Maybe FilePath)) -> IO (Maybe FilePath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> IO (Maybe FilePath))
-> (FilePath -> Maybe FilePath) -> FilePath -> IO (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just) IO (Maybe FilePath)
-> (IOError -> IO (Maybe FilePath)) -> IO (Maybe FilePath)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\ (IOError
_ :: IOError) -> Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing)
kill :: String -> IO ()
kill :: FilePath -> IO ()
kill FilePath
pidStr = Signal -> ProcessID -> IO ()
signalProcess Signal
sigTERM (FilePath -> ProcessID
forall a. Read a => FilePath -> a
read FilePath
pidStr)