diff options
| -rw-r--r-- | src/Plugins/Monitors/Disk.hs | 50 | 
1 files changed, 30 insertions, 20 deletions
| diff --git a/src/Plugins/Monitors/Disk.hs b/src/Plugins/Monitors/Disk.hs index 3c8ea04..73bd5b7 100644 --- a/src/Plugins/Monitors/Disk.hs +++ b/src/Plugins/Monitors/Disk.hs @@ -39,27 +39,37 @@ type DevDataRef = IORef [(DevName, [Float])]  mountedDevices :: [String] -> IO [(DevName, Path)]  mountedDevices req = do -  sm <- B.readFile "/etc/mtab" -  sd <- B.readFile "/proc/diskstats" -  parse `fmap` mapM canon (devs [sm, sd]) +  s <- B.readFile "/etc/mtab" +  parse `fmap` mapM canon (devs s)    where      canon (d, p) = do {d' <- canonicalizePath d; return (d', p)} -    devs fs = concatMap devs' fs -              where -                devs' f = case (devsm f) of -                               [] -> devsd f -                               d  -> d -                firstTwo (a:b:_) = (B.unpack a, B.unpack b) -                firstTwo _ = ("", "") -                third (_:_:c:_) = ("/dev/"++(B.unpack c), B.unpack c) -                third _ = ("", "") -                devsm = filter isDev . map (firstTwo . B.words) . B.lines -                devsd = filter isDev . map (third . B.words) . B.lines +    devs = filter isDev . map (firstTwo . B.words) . B.lines      parse = map undev . filter isReq +    firstTwo (a:b:_) = (B.unpack a, B.unpack b) +    firstTwo _ = ("", "")      isDev (d, _) = "/dev/" `isPrefixOf` d      isReq (d, p) = p `elem` req || drop 5 d `elem` req      undev (d, f) = (drop 5 d, f) +diskDevices :: [String] -> IO [(DevName, Path)] +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)} +    devs = map (third . B.words) . B.lines +    parse = map undev . filter isReq +    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) + +mountedOrDiskDevices :: [String] -> IO [(DevName, Path)] +mountedOrDiskDevices req = do +  mnt <- mountedDevices req +  case mnt of +       []    -> diskDevices req +       other -> return other  diskData :: IO [(DevName, [Float])]  diskData = do @@ -119,17 +129,17 @@ runDiskIO' (tmp, xs) = do  runDiskIO :: DevDataRef -> [(String, String)] -> [String] -> Monitor String  runDiskIO dref disks _ = do -  mounted <- io $ mountedDevices (map fst disks) -  dat <- io $ mountedData dref (map fst mounted) -  strs <- mapM runDiskIO' $ devTemplates disks mounted dat +  dev <- io $ mountedOrDiskDevices (map fst disks) +  dat <- io $ mountedData dref (map fst dev) +  strs <- mapM runDiskIO' $ devTemplates disks dev dat    return $ unwords strs  startDiskIO :: [(String, String)] ->                 [String] -> Int -> (String -> IO ()) -> IO ()  startDiskIO disks args rate cb = do -  mounted <- mountedDevices (map fst disks) -  dref <- newIORef (map (\d -> (fst d, repeat 0)) mounted) -  _ <- mountedData dref (map fst mounted) +  dev <- mountedOrDiskDevices (map fst disks) +  dref <- newIORef (map (\d -> (fst d, repeat 0)) dev) +  _ <- mountedData dref (map fst dev)    runM args diskIOConfig (runDiskIO dref disks) rate cb  fsStats :: String -> IO [Integer] | 
