Permalink
Browse files

Default to partial commandline matching instead of PID

  • Loading branch information...
bneijt committed Aug 9, 2014
1 parent 65bd23e commit 1c2e29e4c1345987da132652db0ac1f8b554c248
Showing with 50 additions and 6 deletions.
  1. +3 −1 after.cabal
  2. +30 −3 src/After.hs
  3. +2 −2 src/Main.hs
  4. +15 −0 src/Process.hs
@@ -23,6 +23,8 @@ executable after
build-depends: base >=4.7 && <4.8,
options ==1.*,
directory ==1.2.*,
parallel-io ==0.3.*
parallel-io ==0.3.*,
filepath ==1.3.*,
unix ==2.7.*
hs-source-dirs: src
default-language: Haskell2010
@@ -2,17 +2,44 @@ module After where

import Control.Concurrent
import System.Directory
import Data.List (isInfixOf, delete)
import Process (psCmdLine, psListing)
import System.Posix.Process (getProcessID)
import Control.Monad (filterM)

halfASecondInMicroseconds = 500000

afterPid :: String -> IO ()
afterPid pid = do
waitForPid :: String -> IO ()
waitForPid pid = do
fileExists <- doesDirectoryExist ("/proc/" ++ pid)
if fileExists
then do
threadDelay halfASecondInMicroseconds
afterPid pid
waitForPid pid
else return ()


-- afterPid will block until the given pid has exited
afterPid :: String -> IO ()
afterPid pid = do
cmdLine <- psCmdLine pid
putStrLn $ "Waiting for " ++ pid ++ ": " ++ cmdLine
waitForPid pid


pidHasPartialCommand :: String -> String -> IO Bool
pidHasPartialCommand needle pid = do
cmd <- psCmdLine pid
return $ isInfixOf needle cmd

pidsWithPartialCommand :: String -> IO [String]
pidsWithPartialCommand cmdLine = do
listing <- psListing
filterM (pidHasPartialCommand cmdLine) listing

afterPartialCmdline :: String -> IO()
afterPartialCmdline cmdLine = do
pids <- pidsWithPartialCommand cmdLine
ownPid <- getProcessID
let otherPids = delete (show ownPid) pids
mapM_ afterPid otherPids
@@ -2,7 +2,7 @@ import Control.Applicative
import Options
import Control.Concurrent.ParallelIO.Global (parallel_, stopGlobalPool)

import After (afterPid)
import After (afterPid, afterPartialCmdline)

data MainOptions = MainOptions
{ optQuiet :: Bool
@@ -18,6 +18,6 @@ main = runCommand $ \opts args -> do
if optQuiet opts
then return ()
else do
parallel_ (map afterPid args)
parallel_ (map afterPartialCmdline args)
stopGlobalPool

@@ -0,0 +1,15 @@
module Process where
import System.Directory (getDirectoryContents)
import System.FilePath ((</>))
import Data.Char (isDigit)

-- Filter directories that contain numbers
psListing :: IO [FilePath]
psListing = do
listing <- getDirectoryContents "/proc"
return $ filter (all isDigit :: FilePath -> Bool) listing

psCmdLine :: String -> IO String
psCmdLine pid = do
line <- readFile ("/proc" </> pid </> "cmdline")
return $ map (\x -> if x == '\0' then ' ' else x) line

0 comments on commit 1c2e29e

Please sign in to comment.