    {-# 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 :: FilePath -> IO [(FilePath, Maybe FilePath)]
    killByCwd FilePath
    path =
        do 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")
           cwdPids <- filterM (isCwd path) pids
           exePaths <- mapM exePath cwdPids
           mapM_ kill cwdPids
           return (zip cwdPids 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 a. a -> IO a
    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 a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Maybe FilePath -> IO (Maybe FilePath)
    forall a. a -> IO a
    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 a. a -> IO a
    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)