{-# 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 <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit)) (FilePath -> IO [FilePath]
getDirectoryContents FilePath
"/proc")
[FilePath]
cwdPids <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> FilePath -> IO Bool
isCwd FilePath
path) [FilePath]
pids
[Maybe FilePath]
exePaths <- 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
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> IO ()
kill [FilePath]
cwdPids
forall (m :: * -> *) a. Monad m => a -> m a
return (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 =
(forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
cwd) (FilePath -> IO FilePath
readSymbolicLink (FilePath
"/proc/" forall a. [a] -> [a] -> [a]
++ FilePath
pid forall a. [a] -> [a] -> [a]
++FilePath
"/cwd"))) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\ (IOError
_ :: IOError) -> 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/" forall a. [a] -> [a] -> [a]
++ FilePath
pid forall a. [a] -> [a] -> [a]
++FilePath
"/exe") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\ (IOError
_ :: IOError) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
kill :: String -> IO ()
kill :: FilePath -> IO ()
kill FilePath
pidStr = Signal -> ProcessID -> IO ()
signalProcess Signal
sigTERM (forall a. Read a => FilePath -> a
read FilePath
pidStr)