diff options
Diffstat (limited to 'src/Plugins/Monitors/Disk.hs')
| -rw-r--r-- | src/Plugins/Monitors/Disk.hs | 109 |
1 files changed, 88 insertions, 21 deletions
diff --git a/src/Plugins/Monitors/Disk.hs b/src/Plugins/Monitors/Disk.hs index 73bd5b7..0019c1a 100644 --- a/src/Plugins/Monitors/Disk.hs +++ b/src/Plugins/Monitors/Disk.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Disk --- Copyright : (c) 2010, 2011, 2012 Jose A Ortega Ruiz +-- Copyright : (c) 2010, 2011, 2012, 2014 Jose A Ortega Ruiz -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A Ortega Ruiz <jao@gnu.org> @@ -23,15 +23,69 @@ import Control.Exception (SomeException, handle) import Control.Monad (zipWithM) import qualified Data.ByteString.Lazy.Char8 as B import Data.List (isPrefixOf, find) -import System.Directory (canonicalizePath) +import Data.Maybe (catMaybes) +import System.Directory (canonicalizePath, doesFileExist) +import System.Console.GetOpt + +data DiskIOOpts = DiskIOOpts + { totalIconPattern :: Maybe IconPattern + , writeIconPattern :: Maybe IconPattern + , readIconPattern :: Maybe IconPattern + } + +parseDiskIOOpts :: [String] -> IO DiskIOOpts +parseDiskIOOpts argv = + case getOpt Permute options argv of + (o, _, []) -> return $ foldr id defaultOpts o + (_, _, errs) -> ioError . userError $ concat errs + where defaultOpts = DiskIOOpts + { totalIconPattern = Nothing + , writeIconPattern = Nothing + , readIconPattern = Nothing + } + options = + [ Option "" ["total-icon-pattern"] (ReqArg (\x o -> + o { totalIconPattern = Just $ parseIconPattern x}) "") "" + , Option "" ["write-icon-pattern"] (ReqArg (\x o -> + o { writeIconPattern = Just $ parseIconPattern x}) "") "" + , Option "" ["read-icon-pattern"] (ReqArg (\x o -> + o { readIconPattern = Just $ parseIconPattern x}) "") "" + ] diskIOConfig :: IO MConfig -diskIOConfig = mkMConfig "" ["total", "read", "write", - "totalbar", "readbar", "writebar"] +diskIOConfig = mkMConfig "" ["total", "read", "write" + ,"totalbar", "readbar", "writebar" + ,"totalvbar", "readvbar", "writevbar" + ,"totalipat", "readipat", "writeipat" + ] + +data DiskUOpts = DiskUOpts + { freeIconPattern :: Maybe IconPattern + , usedIconPattern :: Maybe IconPattern + } + +parseDiskUOpts :: [String] -> IO DiskUOpts +parseDiskUOpts argv = + case getOpt Permute options argv of + (o, _, []) -> return $ foldr id defaultOpts o + (_, _, errs) -> ioError . userError $ concat errs + where defaultOpts = DiskUOpts + { freeIconPattern = Nothing + , usedIconPattern = Nothing + } + options = + [ Option "" ["free-icon-pattern"] (ReqArg (\x o -> + o { freeIconPattern = Just $ parseIconPattern x}) "") "" + , Option "" ["used-icon-pattern"] (ReqArg (\x o -> + o { usedIconPattern = Just $ parseIconPattern x}) "") "" + ] diskUConfig :: IO MConfig diskUConfig = mkMConfig "" - ["size", "free", "used", "freep", "usedp", "freebar", "usedbar"] + [ "size", "free", "used", "freep", "usedp" + , "freebar", "freevbar", "freeipat" + , "usedbar", "usedvbar", "usedipat" + ] type DevName = String type Path = String @@ -40,11 +94,15 @@ type DevDataRef = IORef [(DevName, [Float])] mountedDevices :: [String] -> IO [(DevName, Path)] mountedDevices req = do s <- B.readFile "/etc/mtab" - parse `fmap` mapM canon (devs s) + parse `fmap` mapM mbcanon (devs s) where + mbcanon (d, p) = doesFileExist d >>= \e -> + if e + then Just `fmap` canon (d,p) + else return Nothing canon (d, p) = do {d' <- canonicalizePath d; return (d', p)} devs = filter isDev . map (firstTwo . B.words) . B.lines - parse = map undev . filter isReq + parse = map undev . filter isReq . catMaybes firstTwo (a:b:_) = (B.unpack a, B.unpack b) firstTwo _ = ("", "") isDev (d, _) = "/dev/" `isPrefixOf` d @@ -56,10 +114,10 @@ diskDevices req = do s <- B.readFile "/proc/diskstats" parse `fmap` mapM canon (devs s) where - canon (d, p) = do {d' <- canonicalizePath (d); return (d', p)} + canon (d, p) = do {d' <- canonicalizePath d; return (d', p)} devs = map (third . B.words) . B.lines parse = map undev . filter isReq - third (_:_:c:_) = ("/dev/" ++ (B.unpack c), B.unpack c) + third (_:_:c:_) = ("/dev/" ++ B.unpack c, B.unpack c) third _ = ("", "") isReq (d, p) = p `elem` req || drop 5 d `elem` req undev (d, f) = (drop 5 d, f) @@ -120,18 +178,22 @@ devTemplates disks mounted dat = Nothing -> [0, 0, 0] Just (_, xs) -> xs -runDiskIO' :: (String, [Float]) -> Monitor String -runDiskIO' (tmp, xs) = do +runDiskIO' :: DiskIOOpts -> (String, [Float]) -> Monitor String +runDiskIO' opts (tmp, xs) = do s <- mapM (showWithColors speedToStr) xs b <- mapM (showLogBar 0.8) xs + vb <- mapM (showLogVBar 0.8) xs + ipat <- mapM (\(f,v) -> showLogIconPattern (f opts) 0.8 v) + $ zip [totalIconPattern, readIconPattern, writeIconPattern] xs setConfigValue tmp template - parseTemplate $ s ++ b + parseTemplate $ s ++ b ++ vb ++ ipat runDiskIO :: DevDataRef -> [(String, String)] -> [String] -> Monitor String -runDiskIO dref disks _ = do +runDiskIO dref disks argv = do + opts <- io $ parseDiskIOOpts argv dev <- io $ mountedOrDiskDevices (map fst disks) dat <- io $ mountedData dref (map fst dev) - strs <- mapM runDiskIO' $ devTemplates disks dev dat + strs <- mapM (runDiskIO' opts) $ devTemplates disks dev dat return $ unwords strs startDiskIO :: [(String, String)] -> @@ -152,23 +214,28 @@ fsStats path = do used = fsStatBytesUsed f in return [tot, free, used] -runDiskU' :: String -> String -> Monitor String -runDiskU' tmp path = do +runDiskU' :: DiskUOpts -> String -> String -> Monitor String +runDiskU' opts tmp path = do setConfigValue tmp template [total, free, diff] <- io (handle ign $ fsStats path) - let strs = map sizeToStr [total, free, diff] + let strs = map sizeToStr [free, diff] freep = if total > 0 then free * 100 `div` total else 0 fr = fromIntegral freep / 100 - s <- zipWithM showWithColors' strs [100, freep, 100 - freep] + s <- zipWithM showWithColors' strs [freep, 100 - freep] sp <- showPercentsWithColors [fr, 1 - fr] fb <- showPercentBar (fromIntegral freep) fr + fvb <- showVerticalBar (fromIntegral freep) fr + fipat <- showIconPattern (freeIconPattern opts) fr ub <- showPercentBar (fromIntegral $ 100 - freep) (1 - fr) - parseTemplate $ s ++ sp ++ [fb, ub] + uvb <- showVerticalBar (fromIntegral $ 100 - freep) (1 - fr) + uipat <- showIconPattern (usedIconPattern opts) (1 - fr) + parseTemplate $ [sizeToStr total] ++ s ++ sp ++ [fb,fvb,fipat,ub,uvb,uipat] where ign = const (return [0, 0, 0]) :: SomeException -> IO [Integer] runDiskU :: [(String, String)] -> [String] -> Monitor String -runDiskU disks _ = do +runDiskU disks argv = do devs <- io $ mountedDevices (map fst disks) - strs <- mapM (\(d, p) -> runDiskU' (findTempl d p disks) p) devs + opts <- io $ parseDiskUOpts argv + strs <- mapM (\(d, p) -> runDiskU' opts (findTempl d p disks) p) devs return $ unwords strs |