diff options
| -rw-r--r-- | Plugins/Monitors/StatFS.hsc | 9 | ||||
| -rw-r--r-- | Plugins/Monitors/Top.hs | 78 |
2 files changed, 53 insertions, 34 deletions
diff --git a/Plugins/Monitors/StatFS.hsc b/Plugins/Monitors/StatFS.hsc index ad3b659..9c1972c 100644 --- a/Plugins/Monitors/StatFS.hsc +++ b/Plugins/Monitors/StatFS.hsc @@ -15,12 +15,12 @@ {-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-} -module Plugins.Monitors.StatFS (FileSystemStats(..), getFileSystemStats) where +module Plugins.Monitors.StatFS ( FileSystemStats(..) + , getFileSystemStats ) where import Foreign import Foreign.C.Types import Foreign.C.String -import Foreign.Storable import Data.ByteString (useAsCString) import Data.ByteString.Char8 (pack) @@ -54,9 +54,8 @@ getFileSystemStats path = allocaBytes (#size struct statfs) $ \vfs -> useAsCString (pack path) $ \cpath -> do res <- c_statfs cpath vfs - case res of - -1 -> return Nothing - _ -> do + if res == -1 then return Nothing + else do bsize <- (#peek struct statfs, f_bsize) vfs bcount <- (#peek struct statfs, f_blocks) vfs bfree <- (#peek struct statfs, f_bfree) vfs diff --git a/Plugins/Monitors/Top.hs b/Plugins/Monitors/Top.hs index 38686f6..6ca75c7 100644 --- a/Plugins/Monitors/Top.hs +++ b/Plugins/Monitors/Top.hs @@ -21,6 +21,7 @@ import Plugins.Monitors.Common import Control.Exception (SomeException, handle, evaluate) import System.Directory import System.FilePath +import System.IO import System.Posix.Unistd (getSysVar, SysVar(ClockTick)) import Foreign.C.Types import Data.List (sortBy) @@ -40,19 +41,13 @@ topCpuConfig = mkMConfig "<both1>" [ k ++ n | n <- map show [1..maxProc] , k <- ["name", "cpu", "both"]] + 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 @@ -65,29 +60,53 @@ showInfo nm sms mms = do both <- showWithColors' (rnm ++ " " ++ sms) mms return [nm, mstr, both] -defHandle :: a -> SomeException -> IO a -defHandle def _ = evaluate def +strictReadFile :: FilePath -> IO String +strictReadFile f = + do hdl <- openFile f ReadMode + xs <- getc hdl + hClose hdl + return xs + where getc hdl = do e <- hIsEOF hdl + if e then return [] + else do c <- hGetChar hdl + cs <- getc hdl + return (c:cs) + +getProcessData :: FilePath -> IO [String] +getProcessData pidf = + handle ((\_ -> evaluate []) :: SomeException -> IO [String]) + (do s <- strictReadFile $ "/proc" </> pidf </> "stat" + evaluate $ words $! s) -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" +processes :: IO [FilePath] +processes = do + fs <- getDirectoryContents "/proc" + return $! filter isPid $! fs + where + isPid (x:_) = x `elem` ['0'..'9'] + isPid _ = False + +handleProcesses :: a -> ([String] -> a) -> IO [a] +handleProcesses def f = do + ps <- processes + pd <- mapM getProcessData $! ps + return $! map (\x -> if x == [] then def else f x) pd + +processName :: [String] -> String +processName = drop 1 . init . (!!1) maxProc :: Int maxProc = 5 type Meminfo = (String, Int) -meminfo :: FilePath -> IO Meminfo -meminfo = handlePidFile ("", 0) $ \fs -> - let !m = pageSize * read (fs !! 23) - !n = drop 1 $ init (fs !! 1) - in evaluate (n, m) +meminfo :: [String] -> Meminfo +meminfo fs = (n, r) + where !n = processName fs + !r = pageSize * (read (fs!!23)) meminfos :: IO [Meminfo] -meminfos = do - fs <- processes - mapM meminfo fs +meminfos = handleProcesses ("", 0) meminfo topMemProcesses :: Int -> IO [Meminfo] topMemProcesses n = fmap (take n . sbm) meminfos @@ -111,16 +130,17 @@ type TimeEntry = (Pid, TimeInfo) type Times = IntMap TimeInfo type TimesRef = IORef Times -timeEntry :: FilePath -> IO TimeEntry -timeEntry = handlePidFile (0, ("", 0)) $ \fs -> - let rf = read . (fs!!) - !pid = read (head fs) - !n = drop 1 $ init (fs!!1) - !t = rf 13 + rf 14 - in evaluate (pid, (n, t)) +timeEntry :: [String] -> TimeEntry +timeEntry fs = (p, (n, t)) + where !p = read (head fs) + !n = processName fs + !t = read (fs!!13) + read (fs!!14) + +timeEntries :: IO [TimeEntry] +timeEntries = handleProcesses (0, ("", 0)) timeEntry timeinfos :: IO Times -timeinfos = fmap M.fromList (processes >>= mapM timeEntry) +timeinfos = fmap M.fromList timeEntries combineTimeInfos :: Times -> Times -> Times combineTimeInfos !t0 !t1 = M.intersectionWith timeDiff t1 t0 |