1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
|
{-# LANGUAGE ScopedTypeVariables #-}
-- |A place to collect and hopefully retire all the random ways of
-- running shell commands that have accumulated over the years.
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)
{-
NOTE:
+ We should make sure this works if we are inside a chroot.
+ path needs to be absolute or we might kill processes living in
similarly named, but different directories.
+ path is an canoncialised, absolute path, such as what realpath returns
-}
-- | Kill the processes whose working directory is in or under the
-- given directory.
killByCwd :: FilePath -> IO [(String, Maybe String)]
killByCwd path =
do pids <- liftM (filter (all isDigit)) (getDirectoryContents "/proc")
cwdPids <- filterM (isCwd path) pids
exePaths <- mapM exePath cwdPids
mapM_ kill cwdPids
return (zip cwdPids exePaths)
where
isCwd :: FilePath -> String -> IO Bool
isCwd cwd pid =
(liftM (isPrefixOf cwd) (readSymbolicLink ("/proc/" ++ pid ++"/cwd"))) `catch` (\ (_ :: IOError) -> return False)
exePath :: String -> IO (Maybe String)
exePath pid = (readSymbolicLink ("/proc/" ++ pid ++"/exe") >>= return . Just) `catch` (\ (_ :: IOError) -> return Nothing)
kill :: String -> IO ()
kill pidStr = signalProcess sigTERM (read pidStr)
|
