diff --git a/System/Linux/Proc.hs b/System/Linux/Proc.hs --- a/System/Linux/Proc.hs +++ b/System/Linux/Proc.hs @@ -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 + diff --git a/proc.cabal b/proc.cabal --- a/proc.cabal +++ b/proc.cabal @@ -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