diff --git a/System/Unix/KillByCwd.hs b/System/Unix/KillByCwd.hs new file mode 100644 --- /dev/null +++ b/System/Unix/KillByCwd.hs @@ -0,0 +1,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) diff --git a/System/Unix/Misc.hs b/System/Unix/Misc.hs --- a/System/Unix/Misc.hs +++ b/System/Unix/Misc.hs @@ -18,6 +18,7 @@ import System.Posix.Files import System.Process +-- | Deprecated: Use @Data.ByteString.Lazy.Char8.readFile path >>= return . show . Data.Digest.Pure.MD5.md5@ {-# DEPRECATED md5sum "Use Data.ByteString.Lazy.Char8.readFile path >>= return . show . Data.Digest.Pure.MD5.md5" #-} md5sum :: FilePath -> IO String md5sum path = Data.ByteString.Lazy.Char8.readFile path >>= return . show . md5 @@ -33,6 +34,7 @@ _ -> error ("Error running 'md5sum " ++ path ++ "'") -} +-- | Deprecated: Use @Data.ByteString.Lazy.Char8.readFile path >>= Data.ByteString.Lazy.Char8.writeFile (path ++ \".gz\")@ {-# DEPRECATED gzip "Use Data.ByteString.Lazy.Char8.readFile path >>= Data.ByteString.Lazy.Char8.writeFile (path ++ \".gz\")" #-} gzip :: FilePath -> IO () gzip path = Data.ByteString.Lazy.Char8.readFile path >>= Data.ByteString.Lazy.Char8.writeFile (path ++ ".gz") diff --git a/System/Unix/Process.hs b/System/Unix/Process.hs deleted file mode 100644 --- a/System/Unix/Process.hs +++ /dev/null @@ -1,89 +0,0 @@ --- | Variations of the readProcess and readProcessWithExitCode functions --- from System.Process which read and write ByteStrings and have an --- extra argument to modify the CreateProcess value before the process --- is started. -module System.Unix.Process - ( readProcess - , readProcessWithExitCode - ) where - -import Control.Concurrent (newEmptyMVar, forkIO, putMVar, takeMVar) -import qualified Control.Exception as C -import Control.Monad (when) -import qualified Data.ByteString.Lazy.Char8 as B -import GHC.IO.Exception (IOErrorType(OtherError)) -import System.Exit (ExitCode(..)) -import System.IO (hFlush, hClose) -import System.IO.Error (mkIOError) -import System.Process (CreateProcess(std_in, std_out, std_err, cwd), createProcess, waitForProcess, proc, StdStream(CreatePipe, Inherit), showCommandForUser) - -readProcessWithExitCode - :: FilePath -- ^ command to run - -> [String] -- ^ any arguments - -> (CreateProcess -> CreateProcess) -- ^ Modify process with this - use id for System.Process.readProcessWithExitCode behavior - -> B.ByteString -- ^ standard input - -> IO (ExitCode, B.ByteString, B.ByteString) -- ^ exitcode, stdout, stderr -readProcessWithExitCode cmd args modify input = do - let modify' p = modify (p {std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe }) - - (Just inh, Just outh, Just errh, pid) <- - createProcess (modify' (proc cmd args)) - - outMVar <- newEmptyMVar - - -- fork off a thread to start consuming stdout - out <- B.hGetContents outh - _ <- forkIO $ C.evaluate (B.length out) >> putMVar outMVar () - - -- fork off a thread to start consuming stderr - err <- B.hGetContents errh - _ <- forkIO $ C.evaluate (B.length err) >> putMVar outMVar () - - -- now write and flush any input - when (not (B.null input)) $ do B.hPutStr inh input; hFlush inh - hClose inh -- done with stdin - - -- wait on the output - takeMVar outMVar - takeMVar outMVar - hClose outh - hClose errh - - -- wait on the process - ex <- waitForProcess pid - - return (ex, out, err) - -readProcess - :: FilePath -- ^ command to run - -> [String] -- ^ any arguments - -> (CreateProcess -> CreateProcess) -- ^ modifies CreateProcess before passing to createProcess - -> B.ByteString -- ^ standard input - -> IO B.ByteString -- ^ stdout -readProcess cmd args modify input = do - let modify' p = modify (p {std_in = CreatePipe, std_out = CreatePipe, std_err = Inherit }) - (Just inh, Just outh, _, pid) <- - createProcess (modify' (proc cmd args)) - - -- fork off a thread to start consuming the output - output <- B.hGetContents outh - outMVar <- newEmptyMVar - _ <- forkIO $ C.evaluate (B.length output) >> putMVar outMVar () - - -- now write and flush any input - when (not (B.null input)) $ do B.hPutStr inh input; hFlush inh - hClose inh -- done with stdin - - -- wait on the output - takeMVar outMVar - hClose outh - - -- wait on the process - ex <- waitForProcess pid - - case ex of - ExitSuccess -> return output - ExitFailure r -> - ioError (mkIOError OtherError ("readProcess: " ++ showCommandForUser cmd args ++ - " (exit " ++ show r ++ ")") - Nothing Nothing) diff --git a/Unixutils.cabal b/Unixutils.cabal --- a/Unixutils.cabal +++ b/Unixutils.cabal @@ -1,5 +1,5 @@ Name: Unixutils -Version: 1.50 +Version: 1.52 License: BSD3 License-File: COPYING Author: Jeremy Shaw, David Fox @@ -21,9 +21,9 @@ System.Unix.Crypt, System.Unix.Directory, System.Unix.FilePath, + System.Unix.KillByCwd, System.Unix.Misc, System.Unix.Mount, - System.Unix.Process, System.Unix.SpecialDevice, System.Unix.Files if !os(darwin)