module System.Linux.Proc (
ProcessName,
ProcessState (..),
ProcStatus (..),
procGetProcessDirs,
procGetProcessStatus,
procGetAllProcessStatus
) where
import Control.Applicative
import Control.Exception
import Control.Monad
import Data.Char
import Data.Int
import Data.Maybe
import Data.Word
import Data.Typeable
import System.Directory
import System.FilePath
import System.Posix.Types
import System.IO.Error
import System.IO
import Text.XFormat.Read
import qualified Control.Exception as Exc
type ProcessName = String
type ProcessInfo = [String]
data ProcessState = Running
| Sleeping
| Waiting
| Zombie
| Traced
| Paging
deriving (Show, Read, Ord, Eq, Typeable)
data ProcStatus =
ProcStatus {psProcessId :: Int
,psCommand :: String
,psState :: ProcessState
,psParentProcessId:: Int
,psProcessGroupId :: Int
,psSessionId :: Int
} deriving (Show, Read, Ord, Eq, Typeable)
procPath :: FilePath
procPath = "/proc"
procStatFile :: FilePath
procStatFile = "stat"
psProcessIdBox = (0, Int, "psProcessId")
psCommandBox = (1, String, "psCommand")
psStateBox = (2, Char, "psState")
psParentProcessIdBox = (3, Int, "psParentProcessIdBox")
psProcessGroupIdBox = (4, Int, "psProcessGroupIdBox")
psSessionIdBox = (5, Int, "psSessionId")
procGetProcessDirs :: IO [FilePath]
procGetProcessDirs =
getDirectoryContents procPath
>>= filterM (\x -> doesDirectoryExist $ procPath </> x)
>>= \dirs -> return $ filter isIntegerString dirs
procGetProcessStatus :: ProcessID -> IO (Maybe ProcStatus)
procGetProcessStatus pid = do
info <- procGetProcessInfo pid
return $ case info of
Just i -> Just $ procParseStatus i
Nothing -> Nothing
procGetAllProcessStatus :: IO [ProcStatus]
procGetAllProcessStatus = do
dirs <- procGetProcessDirs
status <- mapM (\pid -> procGetProcessStatus (read pid :: ProcessID)) dirs
return $ catMaybes status
procGetProcessInfo :: ProcessID -> IO (Maybe ProcessInfo)
procGetProcessInfo pid = do
let filepath = procPath </> show pid </> procStatFile
Exc.catch
(liftM (Just . words) $ readFile filepath)
(\(_ :: IOError) -> return Nothing)
procParseStatus :: ProcessInfo -> ProcStatus
procParseStatus info =
ProcStatus pid (toProcessName comm) (toProcessState state) ppid pgid sid
where pid = procFindStatus info psProcessIdBox
comm = procFindStatus info psCommandBox
state = procFindStatus info psStateBox
ppid = procFindStatus info psParentProcessIdBox
pgid = procFindStatus info psProcessGroupIdBox
sid = procFindStatus info psSessionIdBox
procFindStatus :: Format d a => ProcessInfo -> (Int, d, String) -> a
procFindStatus infos (index, format, debugInfo) =
maybeError (case infos ?! index of
Just status -> readf format status
Nothing -> Nothing)
$ "parse error : " ++ show debugInfo
toProcessName :: String -> String
toProcessName = filter (`notElem` "()")
toProcessState :: Char -> ProcessState
toProcessState 'R' = Running
toProcessState 'S' = Sleeping
toProcessState 'D' = Waiting
toProcessState 'Z' = Zombie
toProcessState 'T' = Traced
toProcessState 'W' = Paging
toProcessState state = error $ "Miss state : " ++ show state
maybeError :: Maybe a -> String -> a
maybeError m str = fromMaybe (error str) m
(?!) :: [a] -> Int -> Maybe a
[] ?! _ = Nothing
xs ?! n
| n < 0 || n >= length xs
= Nothing
| otherwise
= listToMaybe . drop n $ xs
isIntegerString :: String -> Bool
isIntegerString [] = False
isIntegerString [x] = isDigit x
isIntegerString (x:xs) = isDigit x && isIntegerString xs