diff options
| -rw-r--r-- | Plugins/Monitors.hs | 11 | ||||
| -rw-r--r-- | Plugins/Monitors/Common.hs | 3 | ||||
| -rw-r--r-- | Plugins/Monitors/Top.hs | 161 |
3 files changed, 172 insertions, 3 deletions
diff --git a/Plugins/Monitors.hs b/Plugins/Monitors.hs index c8d7e83..69ee869 100644 --- a/Plugins/Monitors.hs +++ b/Plugins/Monitors.hs @@ -28,6 +28,7 @@ import Plugins.Monitors.Thermal import Plugins.Monitors.CpuFreq import Plugins.Monitors.CoreTemp import Plugins.Monitors.Disk +import Plugins.Monitors.Top data Monitors = Weather Station Args Rate | Network Interface Args Rate @@ -42,6 +43,8 @@ data Monitors = Weather Station Args Rate | Thermal Zone Args Rate | CpuFreq Args Rate | CoreTemp Args Rate + | TopCpu Args Rate + | TopMem Args Rate deriving (Show,Read,Eq) type Args = [String] @@ -64,6 +67,8 @@ instance Exec Monitors where alias (Battery _ _) = "battery" alias (BatteryP _ _ _)= "battery" alias (CpuFreq _ _) = "cpufreq" + alias (TopCpu _ _) = "top" + alias (TopMem _ _) = "topmem" alias (CoreTemp _ _) = "coretemp" alias (DiskU _ _ _) = "disku" alias (DiskIO _ _ _) = "diskio" @@ -78,5 +83,7 @@ instance Exec Monitors where start (BatteryP s a r) = runM a battConfig (runBatt' s) r start (CpuFreq a r) = runM a cpuFreqConfig runCpuFreq r 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 (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 diff --git a/Plugins/Monitors/Common.hs b/Plugins/Monitors/Common.hs index a102036..6729397 100644 --- a/Plugins/Monitors/Common.hs +++ b/Plugins/Monitors/Common.hs @@ -35,6 +35,7 @@ module Plugins.Monitors.Common ( , parseTemplate -- ** String Manipulation -- $strings + , padString , showWithColors , showWithColors' , showPercentsWithColors @@ -296,7 +297,7 @@ showDigits d n = showWithUnits :: Int -> Int -> Float -> String showWithUnits d n x | x < 0 = "-" ++ showWithUnits d n (-x) - | n > 3 || x < 10^d = show (round x :: Int) ++ units n + | n > 3 || x < 10^(d + 1) = show (round x :: Int) ++ units n | x <= 1024 = showDigits d (x/1024) ++ units (n+1) | otherwise = showWithUnits d (n+1) (x/1024) where units = (!!) ["B", "K", "M", "G", "T"] diff --git a/Plugins/Monitors/Top.hs b/Plugins/Monitors/Top.hs new file mode 100644 index 0000000..1c9443f --- /dev/null +++ b/Plugins/Monitors/Top.hs @@ -0,0 +1,161 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.Monitors.Top +-- Copyright : (c) Jose A Ortega Ruiz +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Jose A Ortega Ruiz <jao@gnu.org> +-- Stability : unstable +-- Portability : unportable +-- +-- Process activity and memory consumption monitors +-- +----------------------------------------------------------------------------- + +{-# LANGUAGE ForeignFunctionInterface #-} + +module Plugins.Monitors.Top ( topCpuConfig + , runTopCpu + , topMemConfig + , runTopMem ) where + +import Plugins.Monitors.Common + +-- import Control.Monad (zipWithM) +import Control.Exception +import System.Directory +import System.FilePath +import Foreign.C.Types +import Data.List (sortBy, foldl') +import Data.Ord (comparing) +import Data.IntMap (IntMap) +import qualified Data.IntMap as M + +foreign import ccall "unistd.h getpagesize" + c_getpagesize :: CInt + +pageSize :: Int +pageSize = fromIntegral c_getpagesize `div` 1024 + +processes :: IO [FilePath] +processes = + fmap (filter isPid) $ getDirectoryContents "/proc" + where + isPid (x:_) = x `elem` ['0'..'9'] + isPid _ = False + +showInfo :: String -> String -> Float -> Monitor [String] +showInfo nm sms mms = do + mnw <- getConfigValue maxWidth + mxw <- getConfigValue minWidth + let lsms = length sms + nmw = mnw - lsms - 1 + nmx = mxw - lsms - 1 + rnm = if nmw > 0 then padString nmw nmx " " True nm else nm + mstr <- showWithColors' sms mms + 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"]] + +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 + +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 + +showMeminfo :: Meminfo -> Monitor [String] +showMeminfo (MI nm rss) = + showInfo nm sms (ms / 1024) + where ms = fromIntegral rss + sms = showWithUnits 2 1 ms + +runTopMem :: [String] -> Monitor String +runTopMem _ = do + ps <- io $ topMemProcesses 5 + 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 + s <- readFile "/proc/stat" + let ts = map read . tail . words . (!!0) . lines + return $ sum (ts s) + +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 [Times] +timeinfos = do + fs <- processes + tis <- mapM timeinfo fs + return [foldl' acc M.empty tis] + where acc m (TiV p n t) = if p > 10 then M.insert p (TI n t) m else 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 <- cpuTime + (t0:_, t1:_) <- doActionTwiceWithDelay 500000 timeinfos + c1 <- cpuTime + let ts = M.elems $ combineTimeInfos t0 t1 + sts = take n $ sortBy (flip (comparing tm)) ts + tm (TI _ t) = t + lapse = fromIntegral (c1 - c0) / 100 + norm (TI nm t) = TI nm (t/lapse) + return $ if lapse > 0 then map norm sts else 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 |