proc 0.0.4 → 0.0.5
raw patch · 2 files changed
+263/−39 lines, 2 filesdep +containersdep +processdep +regex-tdfadep ~base
Dependencies added: containers, process, regex-tdfa, split, strict
Dependency ranges changed: base
Files
- System/Linux/Proc.hs +260/−37
- proc.cabal +3/−2
System/Linux/Proc.hs view
@@ -5,11 +5,14 @@ ProcessName, ProcessState (..), ProcStatus (..),+ UID,+ UserName,+ UserDatabase, -- * Methods procGetProcessDirs,- procGetProcessStatus,- procGetAllProcessStatus+ procGetAllProcessStatus,+ getUserDatabase, ) where import Control.Applicative@@ -17,17 +20,24 @@ import Control.Monad import Data.Char import Data.Int+import Data.List+import Data.List.Split+import Data.Map (Map) import Data.Maybe-import Data.Word import Data.Typeable+import Data.Word import System.Directory+import System.Exit import System.FilePath-import System.Posix.Types import System.IO.Error-import System.IO+import System.Posix.Types+import System.Process+import Text.Regex.TDFA import Text.XFormat.Read import qualified Control.Exception as Exc+import qualified Data.Map as M+import qualified System.IO.Strict as IO type ProcessName = String type ProcessInfo = [String]@@ -38,14 +48,27 @@ | Traced | Paging deriving (Show, Read, Ord, Eq, Typeable)+type UID = Int+type UserName = String+type UserDatabase = Map UID UserName+type CPUTime = (Int, Int, Int, Int, Int)+type CPUTimeDatabase = Map Int (Maybe CPUTime) data ProcStatus = ProcStatus {psProcessId :: Int -- The process ID.- ,psCommand :: String -- The filename of the executable+ ,psCommand :: String -- The filename of the executable ,psState :: ProcessState -- Process state ,psParentProcessId:: Int -- The PID of the parent ,psProcessGroupId :: Int -- The process group ID of the process ,psSessionId :: Int -- The session ID of the process+ ,psNice :: Int -- The nice value from range 19 (low priority) to -20 (high priority)+ ,psNumThreads :: Int -- Number of threads in this process+ ,psVirtualMem :: Int -- peak virtual memory size in bytes+ ,psResidentMem :: Int -- resident size in bytes+ ,psUID :: Int -- UID of process+ ,psUsername :: String -- user name of process+ ,psCmdline :: String -- the complete command-line of process, unless the process is a zombie.+ ,psCpuPercent :: Double -- CPU percent } deriving (Show, Read, Ord, Eq, Typeable) -- | Path for /proc.@@ -56,13 +79,27 @@ procStatFile :: FilePath procStatFile = "stat" +-- | Status file.+procStatusFile :: FilePath+procStatusFile = "status"++-- | Cmdline file.+procCmdlineFile :: FilePath+procCmdlineFile = "cmdline"+ -- | Information Box to find status.-psProcessIdBox = (0, Int, "psProcessId")-psCommandBox = (1, String, "psCommand")-psStateBox = (2, Char, "psState")-psParentProcessIdBox = (3, Int, "psParentProcessIdBox")-psProcessGroupIdBox = (4, Int, "psProcessGroupIdBox")-psSessionIdBox = (5, Int, "psSessionId")+psCommandBox = (1, String, "psCommandBox")+psStateBox = (2, Char, "psStateBox")+psParentProcessIdBox = (3, Int, "psParentProcessIdBox")+psProcessGroupIdBox = (4, Int, "psProcessGroupIdBox")+psSessionIdBox = (5, Int, "psSessionIdBox")+psUtimeBox = (13, Int, "psUtimeBox")+psStimeBox = (14, Int, "psStimeBox")+psCutimeBox = (15, Int, "psCutimeBox")+psCstimeBox = (16, Int, "psCstimeBox")+psNiceBox = (18, Int, "psNiceBox")+psNumThreadsBox = (19, Int, "psNumThreadsBox")+psProcessorBox = (38, Int, "psProcessorBox") -- | Get process directories. procGetProcessDirs :: IO [FilePath]@@ -74,44 +111,195 @@ -- Filter integer directories. >>= \dirs -> return $ filter isIntegerString dirs +-- | Get process id.+procGetProcessIDs :: IO [Int]+procGetProcessIDs = + liftM (map (\x -> read x :: Int)) procGetProcessDirs + -- | Get process status with given process id.-procGetProcessStatus :: ProcessID -> IO (Maybe ProcStatus)-procGetProcessStatus pid = do- info <- procGetProcessInfo pid- return $ case info of - Just i -> Just $ procParseStatus i- Nothing -> Nothing+procGetProcessStatus :: Int -> UserDatabase -> IO (Maybe (String, ProcessState, Int, Int, Int, Int, Int, Int, Int, Int, String, String, Int))+procGetProcessStatus pid database = do+ info <- procGetStatInfo pid+ case info of + Just i -> do+ -- Get status from /proc/pid/stat file.+ let (cmd, state, ppid, pgid, sid, nice, threads, processor) = procParseStatInfo i + -- Get command line from /proc/pid/cmdline file.+ cmdline <- procGetCmdlineInfo pid++ -- Get command name.+ let cmdStr = head $ splitOn "\0" cmdline -- split with null separated string+ command = + -- Because name in /proc/pid/stat has number limit,+ -- so we try to use name in /proc/pid/cmdline.+ if null cmdStr+ -- Use name in /proc/pid/stat file if /proc/pid/cmdline is empty+ then cmd+ -- Otherwise take file name of cmdline.+ else takeFileName cmdStr++ -- Get status from /proc/pid/status file.+ (vSize, vRss, uid) <- procGetStatusInfo pid++ -- Find username with UID.+ let filterMap = M.filterWithKey (\ id _ -> id == uid) database+ username = if M.null filterMap+ then ""+ else snd $ M.findMin filterMap++ return $ Just (command, state, ppid, pgid, sid, nice, threads, vSize, vRss, uid, username, cmdline, processor)+ Nothing -> return Nothing+ -- | Get information for all running processes. procGetAllProcessStatus :: IO [ProcStatus] procGetAllProcessStatus = do- dirs <- procGetProcessDirs- status <- mapM (\pid -> procGetProcessStatus (read pid :: ProcessID)) dirs- return $ catMaybes status+ -- Get process ids.+ ids <- procGetProcessIDs --- | Get process status with given process id.-procGetProcessInfo :: ProcessID -> IO (Maybe ProcessInfo)-procGetProcessInfo pid = do+ -- Get before cpu time database.+ beforeDatabase <- procGetCPUTimeDatabase ids M.empty++ -- Get user database.+ userDatabase <- getUserDatabase++ -- Get status.+ statusList <- mapM (\pid -> do+ status <- procGetProcessStatus pid userDatabase+ return (pid, status)+ ) ids++ -- Get after cpu time database.+ afterDatabase <- procGetCPUTimeDatabase ids M.empty++ -- Get process status.+ let procStatusList = + map (\ (pid, status) -> + case status of+ Just (command, state, ppid, pgid, sid, nice, threads, vSize, vRss, uid, username, cmdline, processor) ->+ let cpuPercent = procGetCPUPercent pid processor beforeDatabase afterDatabase+ in Just $ ProcStatus pid command state + ppid pgid sid nice + threads vSize vRss + uid username cmdline + cpuPercent+ Nothing -> Nothing+ ) statusList++ return $ catMaybes procStatusList++-- | Get CPU percent.+procGetCPUPercent :: Int -> Int -> CPUTimeDatabase -> CPUTimeDatabase -> Double+procGetCPUPercent pid processor beforeDatabase afterDatabase = + let bDatabase = (M.filterWithKey (\ id _ -> id == pid) beforeDatabase)+ aDatabase = M.filterWithKey (\ id _ -> id == pid) afterDatabase + in if M.null bDatabase || M.null aDatabase+ then 0+ else + let beforeTimes = snd $ M.findMin bDatabase+ afterTimes = snd $ M.findMin aDatabase+ in + if isNothing beforeTimes || isNothing afterTimes+ -- Return 0 if any time database is empty.+ then 0+ else + let (beforeUtime, beforeStime, beforeCutime, beforeCstime, beforeTotalTime) = fromJust beforeTimes+ (afterUtime, afterStime, afterCutime, afterCstime, afterTotalTime) = fromJust afterTimes+ -- Get process cpu time different.+ processCPUTimeDiff = + fromIntegral + (sum [afterUtime, afterStime, afterCutime, afterCstime] -+ sum [beforeUtime, beforeStime, beforeCutime, beforeCstime])+ -- Get total cpu time different.+ totalCPUTimeDiff = fromIntegral (afterTotalTime - beforeTotalTime)+ -- Get cpu number.+ cpuNumber = fromIntegral processor+ in if totalCPUTimeDiff == 0+ then 0+ else formatFloatN ((processCPUTimeDiff * 100) / totalCPUTimeDiff * cpuNumber) 2++-- | Get information of /proc/pid/stat.+procGetStatInfo :: Int -> IO (Maybe ProcessInfo)+procGetStatInfo pid = do let filepath = procPath </> show pid </> procStatFile Exc.catch - (liftM (Just . words) $ readFile filepath)+ (liftM (Just . words) $ IO.readFile filepath) (\(_ :: IOError) -> return Nothing) -- skip current file if failed with `readFile` --- | Parse status from given info.-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 +-- | Get memory information of /proc/pid/status.+procGetStatusInfo :: Int -> IO (Int, Int, Int) +procGetStatusInfo pid = do+ let filepath = procPath </> show pid </> procStatusFile+ Exc.catch + (do+ lns <- liftM lines $ IO.readFile filepath+ let pickFirstInt match list = + let matchList = filter (\x -> match `isInfixOf` x) list+ in if null matchList+ then 0+ else + let (_, value, _) = head matchList =~ "[0-9]+" :: (String, String, String)+ in if null value+ then 0+ else read value :: Int+ size = pickFirstInt "VmSize" lns+ rss = pickFirstInt "VmRSS" lns+ uid = pickFirstInt "Uid" lns+ return (1024 * size, 1024 * rss, uid) -- convert Kb to byte+ )+ (\(_ :: IOError) -> do+ putStrLn $ "procGetStatusInfo : read " ++ filepath ++ " failed."+ return (0, 0, 0)) +-- | Get information from /proc/pid/cmdline.+procGetCmdlineInfo :: Int -> IO String+procGetCmdlineInfo pid = do+ let filepath = procPath </> show pid </> procCmdlineFile+ Exc.catch+ (IO.readFile filepath)+ (\(_ :: IOError) -> do+ putStrLn $ "procGetCmdlineInfo : read " ++ filepath ++ " failed."+ return "")++-- | Parse status information from /proc/pid/stat.+procParseStatInfo :: ProcessInfo -> (String, ProcessState, Int, Int, Int, Int, Int, Int)+procParseStatInfo info = + (toProcessName $ procPickStat info psCommandBox + ,toProcessState $ procPickStat info psStateBox + ,procPickStat info psParentProcessIdBox+ ,procPickStat info psProcessGroupIdBox+ ,procPickStat info psSessionIdBox+ ,procPickStat info psNiceBox+ ,procPickStat info psNumThreadsBox+ ,procPickStat info psProcessorBox)++-- | Get database of cpu time.+procGetCPUTimeDatabase :: [Int] -> CPUTimeDatabase -> IO CPUTimeDatabase+procGetCPUTimeDatabase [] database = return database+procGetCPUTimeDatabase (x:xs) database = do+ cpuTime <- procGetProcessCPUTime x+ procGetCPUTimeDatabase xs $ M.insert x cpuTime database++-- | Parse status time information from /proc/pid/stat.+procGetProcessCPUTime :: Int -> IO (Maybe (Int, Int, Int, Int, Int))+procGetProcessCPUTime pid = do+ info <- procGetStatInfo pid+ case info of + Just i -> do+ cpuTotalTime <- getTotalCPUTime+ return $ Just + (procPickStat i psUtimeBox+ ,procPickStat i psStimeBox+ ,procPickStat i psCutimeBox+ ,procPickStat i psCstimeBox+ ,cpuTotalTime)+ Nothing -> + return Nothing+ -- | Find status from given info. -- Throw error if parse failed.-procFindStatus :: Format d a => ProcessInfo -> (Int, d, String) -> a -procFindStatus infos (index, format, debugInfo) = +procPickStat :: Format d a => ProcessInfo -> (Int, d, String) -> a +procPickStat infos (index, format, debugInfo) = maybeError (case infos ?! index of Just status -> readf format status Nothing -> Nothing)@@ -152,3 +340,38 @@ isIntegerString [] = False isIntegerString [x] = isDigit x isIntegerString (x:xs) = isDigit x && isIntegerString xs++-- | Get user database for search username with UID.+getUserDatabase :: IO UserDatabase+getUserDatabase = do+ (exitCode, result, _) <- readProcessWithExitCode "getent" ["passwd"] ""+ return $ case exitCode of+ ExitFailure _ -> M.empty+ ExitSuccess -> + M.fromList $ + map (\str -> + let (username, rest) = break (== ':') str+ (_, uid, _) = rest =~ "[0-9]+" :: (String, String, String)+ in (read uid :: Int, username)+ ) $ lines result++-- | Get total cpu time.+getTotalCPUTime :: IO Int+getTotalCPUTime = do+ let filepath = procPath </> procStatFile+ Exc.catch + (do+ list <- liftM lines $ IO.readFile filepath+ if null list+ then return 0+ else do+ let strList = tail $ words $ head list+ num = sum $ map (\x -> read x :: Int) strList+ return num)+ (\(_ :: IOError) -> return 0)++-- | Format float with specify precision.+formatFloatN :: Double -> Int -> Double+formatFloatN n d =+ fromIntegral (floor $ n * 10 ^ d) / 10 ^ d+
proc.cabal view
@@ -1,5 +1,5 @@ name: proc-version: 0.0.4+version: 0.0.5 Cabal-Version: >= 1.8 license: GPL-3 license-file: LICENSE@@ -17,4 +17,5 @@ Library Exposed-Modules: System.Linux.Proc- Build-depends: base >= 4 && < 5, xformat >= 0.1, filepath >= 1.1.0.3, directory >= 1.0.1.0+ Build-depends: base >= 4 && < 5, xformat >= 0.1, filepath >= 1.1.0.3, directory >= 1.0.1.0, + regex-tdfa >= 1.1.4, process >= 1.0.1.3, containers >= 0.3.0.0, strict >= 0.3.2, split