New disk i/o monitor

Ignore-this: f12c861c05fbaa80271f577dee952c69

darcs-hash:20100125023112-748be-7222c7e7371ef2fab07ef3fe2fe60b48a4f735f4.gz

2 files changed, 132 insertions, 11 deletions

diff --git a/Plugins/Monitors.hs b/Plugins/Monitors.hs
index 72e0d50..4943b69 100644
--- a/Plugins/Monitors.hs
+++ b/Plugins/Monitors.hs
@@ -27,18 +27,20 @@ import Plugins.Monitors.Batt
 import Plugins.Monitors.Thermal
 import Plugins.Monitors.CpuFreq
 import Plugins.Monitors.CoreTemp
+import Plugins.Monitors.Disk
 
-data Monitors = Weather Station   Args Rate
-              | Network Interface Args Rate
-              | Memory            Args Rate
-              | Swap              Args Rate
-              | Cpu               Args Rate
-              | MultiCpu          Args Rate
-              | Battery           Args Rate
-              | BatteryP [String] Args Rate
-              | Thermal   Zone    Args Rate
-              | CpuFreq           Args Rate
-              | CoreTemp          Args Rate
+data Monitors = Weather  Station    Args Rate
+              | Network  Interface  Args Rate
+              | Memory   Args       Rate
+              | Swap     Args       Rate
+              | Cpu      Args       Rate
+              | MultiCpu Args       Rate
+              | Battery  Args       Rate
+              | BatteryP [String]   Args Rate
+              | Disk     DiskSpec   Args Rate
+              | Thermal  Zone       Args Rate
+              | CpuFreq  Args       Rate
+              | CoreTemp Args       Rate
                 deriving (Show,Read,Eq)
 
 type Args      = [String]
@@ -48,6 +50,7 @@ type Station   = String
 type Zone      = String
 type Interface = String
 type Rate      = Int
+type DiskSpec  = [(String, String)]
 
 instance Exec Monitors where
     alias (Weather  s _ _) = s
@@ -61,6 +64,7 @@ instance Exec Monitors where
     alias (BatteryP  _ _ _)= "battery"
     alias (CpuFreq    _ _) = "cpufreq"
     alias (CoreTemp   _ _) = "coretemp"
+    alias (Disk     _ _ _) = "disk"
     start (Weather  s a r) = runM (a ++ [s]) weatherConfig  runWeather  r
     start (Network  i a r) = runM (a ++ [i]) netConfig      runNet      r
     start (Thermal  z a r) = runM (a ++ [z]) thermalConfig  runThermal  r
@@ -72,3 +76,4 @@ 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 (Disk     s a r) = runM a          diskConfig     (runDisk s) r
diff --git a/Plugins/Monitors/Disk.hs b/Plugins/Monitors/Disk.hs
new file mode 100644
index 0000000..64a0e7b
--- /dev/null
+++ b/Plugins/Monitors/Disk.hs
@@ -0,0 +1,116 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Plugins.Monitors.Disk
+-- Copyright   :  (c) Jose A Ortega Ruiz
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Jose A Ortega Ruiz <jao@gnu.org>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A disk usage monitor for Xmobar
+--
+-----------------------------------------------------------------------------
+
+module Plugins.Monitors.Disk (diskConfig, runDisk) where
+
+import qualified Data.ByteString.Lazy.Char8 as B
+import Plugins.Monitors.Common
+import Data.List (isPrefixOf, find, intercalate)
+import Numeric (floatToDigits)
+
+diskConfig :: IO MConfig
+diskConfig = mkMConfig "" ["total", "read", "write"]
+
+type DevName = String
+type Path = String
+
+mountedDevices :: IO [(DevName, Path)]
+mountedDevices = 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 _ = error "Unexpected mtab format"
+      isDev (d, _) = "/dev/" `isPrefixOf` d
+      undev (d, f) = (drop 5 d, f)
+
+diskData :: IO [(DevName, [Float])]
+diskData = do
+  s <- B.readFile "/proc/diskstats"
+  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
+  (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)
+          _ -> error $ "Device " ++ dev ++ "not found in diskstats"
+  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
+  in
+   (dev, path, [sp, rSp, wSp])
+
+speedToStr :: Int -> Float -> String
+speedToStr n x =
+  let units = ["B", "K", "M", "T"]
+      toI = round :: Float -> Integer
+      s y j = y ++ units !! j ++ "/s"
+  in
+   if n > 2 || x < 103 then
+     s (show $ toI x) n
+   else
+     if x < 1024 then
+       let (ds, _) = floatToDigits 10 (x / 1024)
+           tr = if (length ds) > 1 then show $ ds !! 1 else "0"
+       in s ("0." ++ (show $ ds !! 0) ++ tr) (n + 1)
+     else
+       speedToStr (n + 1) (x / 1024)
+
+runDisk' :: String -> [Float] -> Monitor String
+runDisk' tmp xs = do
+  setConfigValue tmp template
+  s <- mapM (showWithColors (speedToStr 1)) xs
+  parseTemplate s
+
+findTempl :: DevName -> Path -> [(String, String)] -> String
+findTempl dev path disks =
+  case find devOrPath disks of
+    Just (_, t) -> t
+    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
+  return $ intercalate " " strs
+
+
+
+