From 6c4970ea293796a832ecd1b292ec99a9695bf276 Mon Sep 17 00:00:00 2001 From: Jose A Ortega Ruiz Date: Thu, 4 Feb 2010 02:54:55 +0100 Subject: New DiskU and DiskIO monitors Ignore-this: b72a9ad54c9ae478f2c3fbdcda4d26c8 New monitors for disk usage and throughput, replacing Disk. darcs-hash:20100204015455-748be-41e03ee9dff0e3e9e3725aae8a3e07c6facb70dc.gz --- Plugins/Monitors/Disk.hs | 159 +++++++++++++++++++++++++++-------------------- 1 file changed, 93 insertions(+), 66 deletions(-) (limited to 'Plugins/Monitors/Disk.hs') diff --git a/Plugins/Monitors/Disk.hs b/Plugins/Monitors/Disk.hs index 4f42218..3a9a70f 100644 --- a/Plugins/Monitors/Disk.hs +++ b/Plugins/Monitors/Disk.hs @@ -8,36 +8,41 @@ -- Stability : unstable -- Portability : unportable -- --- A disk usage monitor for Xmobar +-- Disk usage and throughput monitors for Xmobar -- ----------------------------------------------------------------------------- -module Plugins.Monitors.Disk (diskConfig, runDisk) where +module Plugins.Monitors.Disk ( diskUConfig, runDiskU + , diskIOConfig, runDiskIO + ) where -import qualified Data.ByteString.Lazy.Char8 as B import Plugins.Monitors.Common +import Plugins.Monitors.StatFS + +import Control.Monad (zipWithM) +import qualified Data.ByteString.Lazy.Char8 as B import Data.List (isPrefixOf, find, intercalate) -import Numeric (floatToDigits) -diskConfig :: IO MConfig -diskConfig = mkMConfig "" ["total", "read", "write"] +diskIOConfig :: IO MConfig +diskIOConfig = mkMConfig "" ["total", "read", "write"] + +diskUConfig :: IO MConfig +diskUConfig = mkMConfig "" ["size", "free", "used", "freep", "usedp"] type DevName = String type Path = String -mountedDevices :: IO [(DevName, Path)] -mountedDevices = do +mountedDevices :: [String] -> IO [(DevName, Path)] +mountedDevices req = do s <- B.readFile "/etc/mtab" - return (parseMountedDevices s) - -parseMountedDevices :: B.ByteString -> [(DevName, Path)] -parseMountedDevices = - map undev . filter isDev . map (firstTwo . B.words) . B.lines - where - firstTwo (a:b:_) = (B.unpack a, B.unpack b) - firstTwo _ = ("", "") - isDev (d, _) = "/dev/" `isPrefixOf` d - undev (d, f) = (drop 5 d, f) + return (parse s) + where + parse = map undev . filter isDev . map (firstTwo . B.words) . B.lines + firstTwo (a:b:_) = (B.unpack a, B.unpack b) + firstTwo _ = ("", "") + isDev (d, p) = "/dev/" `isPrefixOf` d && + (p `elem` req || drop 5 d `elem` req) + undev (d, f) = (drop 5 d, f) diskData :: IO [(DevName, [Float])] diskData = do @@ -45,51 +50,39 @@ diskData = do let extract ws = (head ws, map read (tail ws)) return $ map (extract . map B.unpack . drop 2 . B.words) (B.lines s) -mountedData :: [String] -> IO [(DevName, Path, [Float])] -mountedData xs = do - devs <- mountedDevices +mountedData :: [DevName] -> IO [(DevName, [Float])] +mountedData devs = do (dt, dt') <- doActionTwiceWithDelay 950000 diskData - return $ parseData xs devs dt dt' - -parseData :: [String] -> [(DevName, Path)] - -> [(DevName, [Float])] -> [(DevName, [Float])] - -> [(DevName, Path, [Float])] -parseData reqs mounted dat dat2 = - let rm = filter isRequested mounted - isRequested (dev, path) = dev `elem` reqs || path `elem` reqs - findDat d = find ((==d) .fst) - format (dev, path) = - let f1 = findDat dev dat - f2 = findDat dev dat2 - in - case (f1, f2) of - (Just (_, x), Just (_, y)) -> formatDev path (dev, zipWith (-) y x) - _ -> (dev, path, [0, 0, 0]) - in map format rm - -formatDev :: Path -> (DevName, [Float]) -> (DevName, Path, [Float]) -formatDev path (dev, xs) = - let rSp = speed (xs !! 2) (xs !! 3) - wSp = speed (xs !! 6) (xs !! 7) - sp = speed (xs !! 2 + xs !! 6) (xs !! 3 + xs !! 7) - speed x t = if t == 0 then 0 else 500 * x / t - dat = if length xs > 6 then [sp, rSp, wSp] else [0, 0, 0] - in (dev, path, dat) - -speedToStr :: Int -> Float -> String -speedToStr n x - | n > 2 || x < 103 = show (round x :: Int) ++ units n - | x < 1024 = "0." ++ s2 (fst (floatToDigits 10 (x/1024))) ++ units (n+1) - | otherwise = speedToStr (n+1) (x/1024) - where units = (!!) ["B", "K", "M", "T"] - s2 (a:b:_) = show a ++ show b - s2 as = show (head as) ++ "0" - -runDisk' :: String -> [Float] -> Monitor String -runDisk' tmp xs = do - setConfigValue tmp template - s <- mapM (showWithColors (speedToStr 1)) xs - parseTemplate s + return $ map (parseDev (zipWith diff dt' dt)) devs + where diff (dev, xs) (_, ys) = (dev, zipWith (-) xs ys) + +parseDev :: [(DevName, [Float])] -> DevName -> (DevName, [Float]) +parseDev dat dev = + case find ((==dev) . fst) dat of + Nothing -> (dev, [0, 0, 0]) + Just (_, xs) -> + let rSp = speed (xs !! 2) (xs !! 3) + wSp = speed (xs !! 6) (xs !! 7) + sp = speed (xs !! 2 + xs !! 6) (xs !! 3 + xs !! 7) + speed x t = if t == 0 then 0 else 500 * x / t + dat' = if length xs > 6 then [sp, rSp, wSp] else [0, 0, 0] + in (dev, dat') + +fsStats :: String -> IO [Integer] +fsStats path = do + stats <- getFileSystemStats path + case stats of + Nothing -> return [-1, -1, -1] + Just f -> let tot = fsStatByteCount f + free = fsStatBytesAvailable f + used = fsStatBytesUsed f + in return [tot, free, used] + +speedToStr :: Float -> String +speedToStr = showWithUnits 2 1 + +sizeToStr :: Integer -> String +sizeToStr = showWithUnits 3 0 . fromIntegral findTempl :: DevName -> Path -> [(String, String)] -> String findTempl dev path disks = @@ -98,8 +91,42 @@ findTempl dev path disks = Nothing -> "" where devOrPath (d, _) = d == dev || d == path -runDisk :: [(String, String)] -> [String] -> Monitor String -runDisk disks _ = do - dat <- io $ mountedData (map fst disks) - strs <- mapM (\(d, p, xs) -> runDisk' (findTempl d p disks) xs) dat +devTemplates :: [(String, String)] + -> [(DevName, Path)] + -> [(DevName, [Float])] + -> [(String, [Float])] +devTemplates disks mounted dat = + map (\(d, p) -> (findTempl d p disks, findData d)) mounted + where findData dev = case find ((==dev) . fst) dat of + Nothing -> [0, 0, 0] + Just (_, xs) -> xs + +runDiskIO' :: (String, [Float]) -> Monitor String +runDiskIO' (tmp, xs) = do + s <- mapM (showWithColors speedToStr) xs + setConfigValue tmp template + parseTemplate s + +runDiskIO :: [(String, String)] -> [String] -> Monitor String +runDiskIO disks _ = do + mounted <- io $ mountedDevices (map fst disks) + dat <- io $ mountedData (map fst mounted) + strs <- mapM runDiskIO' $ devTemplates disks mounted dat + return $ intercalate " " strs + +runDiskU' :: String -> String -> Monitor String +runDiskU' tmp path = do + setConfigValue tmp template + fstats <- io $ fsStats path + let strs = map sizeToStr fstats + freep = (fstats !! 1) * 100 `div` head fstats + fr = fromIntegral freep / 100 + s <- zipWithM showWithColors' strs [100, freep, 100 - freep] + sp <- showPercentsWithColors [fr, 1 - fr] + parseTemplate $ s ++ sp + +runDiskU :: [(String, String)] -> [String] -> Monitor String +runDiskU disks _ = do + devs <- io $ mountedDevices (map fst disks) + strs <- mapM (\(d, p) -> runDiskU' (findTempl d p disks) p) devs return $ intercalate " " strs -- cgit v1.2.3