From ae61c95ee8e4ff85ee6c39f610b670401b6e8d53 Mon Sep 17 00:00:00 2001 From: John Soros Date: Mon, 8 Oct 2012 13:36:14 +0200 Subject: Enable the monitoring of non-mounted disks and partitions in DiskIO --- src/Plugins/Monitors/Disk.hs | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) (limited to 'src/Plugins/Monitors/Disk.hs') diff --git a/src/Plugins/Monitors/Disk.hs b/src/Plugins/Monitors/Disk.hs index 554be05..d52dce2 100644 --- a/src/Plugins/Monitors/Disk.hs +++ b/src/Plugins/Monitors/Disk.hs @@ -51,6 +51,20 @@ mountedDevices req = do isReq (d, p) = p `elem` req || drop 5 d `elem` req undev (d, f) = (drop 5 d, f) +availDevices :: [String] -> IO [(DevName, Path)] +availDevices req = do + s <- B.readFile "/proc/diskstats" + parse `fmap` mapM canon (devs s) + where + canon (d, p) = do {d' <- canonicalizePath ("/dev/"++d); return (d', p)} + devs = map (third . B.words) . B.lines + parse = map undev . filter isReq + third (_:_:c:_) = (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) + + diskData :: IO [(DevName, [Float])] diskData = do s <- B.readFile "/proc/diskstats" @@ -109,7 +123,7 @@ runDiskIO' (tmp, xs) = do runDiskIO :: DevDataRef -> [(String, String)] -> [String] -> Monitor String runDiskIO dref disks _ = do - mounted <- io $ mountedDevices (map fst disks) + mounted <- io $ availDevices (map fst disks) dat <- io $ mountedData dref (map fst mounted) strs <- mapM runDiskIO' $ devTemplates disks mounted dat return $ unwords strs @@ -117,7 +131,7 @@ runDiskIO dref disks _ = do startDiskIO :: [(String, String)] -> [String] -> Int -> (String -> IO ()) -> IO () startDiskIO disks args rate cb = do - mounted <- mountedDevices (map fst disks) + mounted <- availDevices (map fst disks) dref <- newIORef (map (\d -> (fst d, repeat 0)) mounted) _ <- mountedData dref (map fst mounted) runM args diskIOConfig (runDiskIO dref disks) rate cb -- cgit v1.2.3 From b683b474fa5b8cbb29704f88f7a43f8084dd8070 Mon Sep 17 00:00:00 2001 From: John Soros Date: Thu, 11 Oct 2012 15:01:10 +0200 Subject: Second try at fixing #73 and #74: enable io monitoring for non-mounted disks --- src/Plugins/Monitors/Disk.hs | 36 ++++++++++++++++-------------------- 1 file changed, 16 insertions(+), 20 deletions(-) (limited to 'src/Plugins/Monitors/Disk.hs') diff --git a/src/Plugins/Monitors/Disk.hs b/src/Plugins/Monitors/Disk.hs index d52dce2..3c8ea04 100644 --- a/src/Plugins/Monitors/Disk.hs +++ b/src/Plugins/Monitors/Disk.hs @@ -39,31 +39,27 @@ type DevDataRef = IORef [(DevName, [Float])] mountedDevices :: [String] -> IO [(DevName, Path)] mountedDevices req = do - s <- B.readFile "/etc/mtab" - parse `fmap` mapM canon (devs s) + sm <- B.readFile "/etc/mtab" + sd <- B.readFile "/proc/diskstats" + parse `fmap` mapM canon (devs [sm, sd]) where canon (d, p) = do {d' <- canonicalizePath d; return (d', p)} - devs = filter isDev . map (firstTwo . B.words) . B.lines + 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 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) -availDevices :: [String] -> IO [(DevName, Path)] -availDevices req = do - s <- B.readFile "/proc/diskstats" - parse `fmap` mapM canon (devs s) - where - canon (d, p) = do {d' <- canonicalizePath ("/dev/"++d); return (d', p)} - devs = map (third . B.words) . B.lines - parse = map undev . filter isReq - third (_:_:c:_) = (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) - diskData :: IO [(DevName, [Float])] diskData = do @@ -123,7 +119,7 @@ runDiskIO' (tmp, xs) = do runDiskIO :: DevDataRef -> [(String, String)] -> [String] -> Monitor String runDiskIO dref disks _ = do - mounted <- io $ availDevices (map fst disks) + mounted <- io $ mountedDevices (map fst disks) dat <- io $ mountedData dref (map fst mounted) strs <- mapM runDiskIO' $ devTemplates disks mounted dat return $ unwords strs @@ -131,7 +127,7 @@ runDiskIO dref disks _ = do startDiskIO :: [(String, String)] -> [String] -> Int -> (String -> IO ()) -> IO () startDiskIO disks args rate cb = do - mounted <- availDevices (map fst disks) + mounted <- mountedDevices (map fst disks) dref <- newIORef (map (\d -> (fst d, repeat 0)) mounted) _ <- mountedData dref (map fst mounted) runM args diskIOConfig (runDiskIO dref disks) rate cb -- cgit v1.2.3 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(-) (limited to 'src/Plugins/Monitors/Disk.hs') 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