module System.Linux.Proc (
ProcessName,
ProcessState (..),
ProcStatus (..),
procGetProcessDirs,
procGetProcessStatus,
procGetAllProcessStatus
) where
import Control.Applicative
import Control.Monad
import Data.Char
import Data.Word
import Data.Int
import Data.Maybe
import System.Directory
import System.FilePath
import Text.XFormat.Read
import System.Posix.Types
type ProcessName = String
type ProcessInfo = [String]
data ProcessState = Running
| Sleeping
| Waiting
| Zombie
| Traced
| Paging
deriving (Show, Read, Ord, Eq)
data ProcStatus =
ProcStatus {psProcessId :: Int
,psCommand :: String
,psState :: ProcessState
,psParentProcessId:: Int
,psProcessGroupId :: Int
,psSessionId :: Int
} deriving (Show, Read, Ord, Eq)
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 ProcStatus
procGetProcessStatus pid = liftM procParseStatus $ procGetProcessInfo pid
procGetAllProcessStatus :: IO [ProcStatus]
procGetAllProcessStatus =
procGetProcessDirs
>>= mapM (\pid -> procGetProcessStatus (read pid :: ProcessID))
procGetProcessInfo :: ProcessID -> IO ProcessInfo
procGetProcessInfo pid =
liftM words $ readFile $ procPath </> show pid </> procStatFile
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