{-# 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 [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)