diff options
| -rw-r--r-- | Plugins/Monitors.hs | 2 | ||||
| -rw-r--r-- | Plugins/Monitors/Top.hs | 137 |
2 files changed, 66 insertions, 73 deletions
diff --git a/Plugins/Monitors.hs b/Plugins/Monitors.hs index 69ee869..cba7332 100644 --- a/Plugins/Monitors.hs +++ b/Plugins/Monitors.hs @@ -85,5 +85,5 @@ instance Exec Monitors where start (CoreTemp a r) = runM a coreTempConfig runCoreTemp r start (DiskU s a r) = runM a diskUConfig (runDiskU s) r start (DiskIO s a r) = runM a diskIOConfig (runDiskIO s) r - start (TopCpu a r) = runM a topCpuConfig runTopCpu r start (TopMem a r) = runM a topMemConfig runTopMem r + start (TopCpu a r) = startTopCpu a r diff --git a/Plugins/Monitors/Top.hs b/Plugins/Monitors/Top.hs index 0d9c6bd..14ccf1e 100644 --- a/Plugins/Monitors/Top.hs +++ b/Plugins/Monitors/Top.hs @@ -14,24 +14,31 @@ {-# LANGUAGE ForeignFunctionInterface #-} -module Plugins.Monitors.Top ( topCpuConfig - , runTopCpu - , topMemConfig - , runTopMem ) where +module Plugins.Monitors.Top (startTopCpu, topMemConfig, runTopMem) where import Plugins.Monitors.Common --- import Control.Monad (zipWithM) -import Control.Exception +import Control.Exception (SomeException, handle, evaluate) +import Control.Concurrent import System.Directory import System.FilePath -import System.IO +import System.Posix.Unistd (getSysVar, SysVar(ClockTick)) import Foreign.C.Types import Data.List (sortBy, foldl') -import Data.Ord (comparing) + import Data.IntMap (IntMap) import qualified Data.IntMap as M + +topMemConfig :: IO MConfig +topMemConfig = mkMConfig "<both1>" [ k ++ n | n <- map show [1..maxProc] + , k <- ["name", "rss", "both"]] + +topCpuConfig :: IO MConfig +topCpuConfig = mkMConfig "<both1>" [ k ++ n | n <- map show [1..maxProc] + , k <- ["name", "cpu", "both"]] + + foreign import ccall "unistd.h getpagesize" c_getpagesize :: CInt @@ -57,36 +64,34 @@ showInfo nm sms mms = do both <- showWithColors' (rnm ++ " " ++ sms) mms return [nm, mstr, both] -topMemConfig :: IO MConfig -topMemConfig = mkMConfig - "<both1>" - [ k ++ n | n <- map show [1::Int .. 5] - , k <- ["name", "rss", "both"]] +defHandle :: a -> SomeException -> IO a +defHandle def _ = evaluate $! def + +handlePidFile :: a -> ([String] -> IO a) -> FilePath -> IO a +handlePidFile def action pidf = + handle (defHandle def) (fmap words (readFile f) >>= action) + where f = "/proc" </> pidf </> "stat" + +maxProc :: Int +maxProc = 5 data Meminfo = MI !String !Int meminfo :: FilePath -> IO Meminfo -meminfo pidf = - handle noInfo - (do s <- readFile $ "/proc" </> pidf </> "stat" - let fs = words s - m = pageSize * read (fs !! 23) - n = drop 1 $ init (fs !! 1) - evaluate $ MI n m) - where noInfo :: SomeException -> IO Meminfo - noInfo _ = evaluate $ MI "" 0 +meminfo = handlePidFile (MI "" 0) $ \fs -> + let m = pageSize * (read $! (fs !! 23)) + n = drop 1 $! init (fs !! 1) + in evaluate $! MI n m meminfos :: IO [Meminfo] meminfos = do fs <- processes mapM meminfo fs -sortByMem :: [Meminfo] -> [Meminfo] -sortByMem ps = sortBy (flip (comparing rss)) ps - where rss (MI _ m) = m - topMemProcesses :: Int -> IO [Meminfo] -topMemProcesses n = fmap (take n . sortByMem) meminfos +topMemProcesses n = fmap (take n . sbm) meminfos + where sbm = sortBy cmp + cmp (MI _ x) (MI _ y) = compare y x showMeminfo :: Meminfo -> Monitor [String] showMeminfo (MI nm rss) = @@ -96,69 +101,57 @@ showMeminfo (MI nm rss) = runTopMem :: [String] -> Monitor String runTopMem _ = do - ps <- io $ topMemProcesses 5 + ps <- io $ topMemProcesses maxProc pstr <- mapM showMeminfo ps parseTemplate $ concat pstr -topCpuConfig :: IO MConfig -topCpuConfig = mkMConfig - "<both1>" - [ k ++ n | n <- map show [1::Int .. 5] - , k <- ["name", "cpu", "both"]] - data Timeinfo = TI !String !Float type Times = IntMap Timeinfo data TimesVal = TiV !Int !String !Float -cpuTime :: IO Integer -cpuTime = do - h <- openFile "/proc/stat" ReadMode - s <- hGetLine h - let ts = (map read . tail . words) s - hClose h - return $! sum $! ts - -nullTimesVal :: TimesVal -nullTimesVal = TiV 0 "" 0 - timeinfo :: FilePath -> IO TimesVal -timeinfo pidf = - handle ((\_ -> evaluate nullTimesVal) :: SomeException -> IO TimesVal) - (do s <- readFile $ "/proc" </> pidf </> "stat" - let fs = words s - pid = read (head fs) - rf = read . (fs!!) - n = drop 1 $ init (fs!!1) - evaluate $! TiV pid n (rf 14 + rf 15)) - -timeinfos :: IO [(Integer, Times)] +timeinfo = handlePidFile (TiV 0 "" 0) $ \fs -> + let pid = read (head fs) + rf = read . (fs!!) + n = drop 1 $ init (fs!!1) + in evaluate $! TiV pid n (rf 13 + rf 14) + +timeinfos :: IO Times timeinfos = do fs <- processes tis <- mapM timeinfo $! fs - ct <- cpuTime - return $! [(ct, foldl' acc M.empty tis)] + return $! foldl' acc M.empty tis where acc m (TiV p n t) = M.insert p (TI n t) m combineTimeInfos :: Times -> Times -> Times combineTimeInfos t0 t1 = M.intersectionWith timeDiff t1 t0 where timeDiff (TI n x1) (TI _ x0) = TI n (x1 - x0) -topTimeProcesses :: Int -> IO [Timeinfo] -topTimeProcesses n = do - ((c0, t0):_, (c1, t1):_) <- doActionTwiceWithDelay 1000000 timeinfos +type TIVar = MVar Times + +topTimeProcesses :: Int -> TIVar -> Float -> IO [Timeinfo] +topTimeProcesses n tivar lapse = do + t0 <- readMVar tivar + t1 <- timeinfos + modifyMVar_ tivar (\_ -> return $! t1) let ts = M.elems $ combineTimeInfos t0 t1 - sts = take n $ sortBy (flip (comparing tm)) (filter nzr ts) - nzr = (>0) . tm - tm (TI _ t) = t - lapse = fromIntegral (c1 - c0) + sts = take n $ sortBy cmp ts + cmp (TI _ x) (TI _ y) = compare y x norm (TI nm t) = TI nm (100 * t / lapse) - return $! map norm sts ++ replicate 5 (TI "" 0) + return $! map norm sts showTimeInfo :: Timeinfo -> Monitor [String] -showTimeInfo (TI n t) = showInfo n (showDigits 2 t) t - -runTopCpu :: [String] -> Monitor String -runTopCpu _ = do - ps <- io $ topTimeProcesses 5 - pstr <- mapM showTimeInfo ps - parseTemplate $ concat pstr +showTimeInfo (TI n t) = showInfo n (showDigits 1 t) t + +runTopCpu :: TIVar -> Float -> [String] -> Monitor String +runTopCpu tivar lapse _ = do + ps <- io $ topTimeProcesses maxProc tivar lapse + pstr <- mapM showTimeInfo ps + parseTemplate $ concat pstr + +startTopCpu :: [String] -> Int -> (String -> IO ()) -> IO () +startTopCpu a r cb = do + t <- getSysVar ClockTick + tivar <- newMVar M.empty + let lapse = (fromIntegral r * fromIntegral t) / 10 + runM a topCpuConfig (runTopCpu tivar lapse) r cb |