From e1a5d4b5f96a421be13935166b566ba061fed806 Mon Sep 17 00:00:00 2001 From: John Soros Date: Thu, 11 Oct 2012 18:15:20 +0200 Subject: Fix for #73: third try: retain old behaviour for diskU, use device for diskIO if device is not mounted --- src/Plugins/Monitors/Disk.hs | 50 ++++++++++++++++++++++++++------------------ 1 file 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] -- cgit v1.2.3