diff --git a/ridley-extras.cabal b/ridley-extras.cabal --- a/ridley-extras.cabal +++ b/ridley-extras.cabal @@ -1,5 +1,5 @@ name: ridley-extras -version: 0.1.3.0 +version: 0.1.4.0 synopsis: Handy metrics that don't belong to ridley. description: See README.md homepage: https://github.com/iconnect/ridley/ridley-extras#readme @@ -27,6 +27,7 @@ build-depends: base >= 4.7 && < 5, text, prometheus < 3, + katip < 0.9.0.0, shelly < 1.9.0.0, microlens, ekg-prometheus-adapter < 0.3.0.0, diff --git a/src/System/Metrics/Prometheus/Ridley/Metrics/FD.hs b/src/System/Metrics/Prometheus/Ridley/Metrics/FD.hs --- a/src/System/Metrics/Prometheus/Ridley/Metrics/FD.hs +++ b/src/System/Metrics/Prometheus/Ridley/Metrics/FD.hs @@ -1,5 +1,7 @@ +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} module System.Metrics.Prometheus.Ridley.Metrics.FD where import Control.Monad.IO.Class @@ -8,48 +10,61 @@ import qualified Data.Text as T import Lens.Micro import Shelly +import Katip.Core import qualified System.Metrics.Prometheus.Metric.Gauge as P import qualified System.Metrics.Prometheus.RegistryT as P import System.Metrics.Prometheus.Ridley.Types import System.Posix.Types (ProcessID) import System.Remote.Monitoring.Prometheus (labels) import Text.Read (readMaybe) +import Katip.Monadic +import Data.String +import Control.Monad.Trans (lift) +import Control.Monad.Reader (ask) +logAndReturnFDs :: RidleyOptions -> LogEnv -> ProcessID -> [T.Text] -> IO Double +logAndReturnFDs opts le pid descriptors = do + let !descriptorsNums = length descriptors + when (descriptorsNums >= opts ^. openFDWarningTreshold) $ + runRidley opts le $ do + $(logTM) WarningS $ fromString $ "Careful, number of open file descriptors for process " <> show pid <> " exceeded warning threshold (" <> show (opts ^. openFDWarningTreshold) <> "):\n" <> T.unpack (T.unlines descriptors) + return $ (fromIntegral $ descriptorsNums) + -------------------------------------------------------------------------------- -getOpenFD_unix :: ProcessID -> IO Double -getOpenFD_unix pid = do - rawOutput <- shelly $ silently $ escaping False $ - T.strip <$> run "ls" ["-l", "/proc/" <> T.pack (show pid) <> "/fd", "|" - ,"wc", "-l" +getOpenFD_unix :: RidleyOptions -> LogEnv -> ProcessID -> IO Double +getOpenFD_unix opts le pid = do + descriptors <- shelly $ silently $ escaping False $ + T.lines . T.strip <$> run "ls" ["-l", "/proc/" <> T.pack (show pid) <> "/fd", "|" + ,"grep", "^l" ] - return $ fromMaybe 0.0 (readMaybe . T.unpack $ rawOutput) + logAndReturnFDs opts le pid descriptors -------------------------------------------------------------------------------- -getOpenFD_darwin :: ProcessID -> IO Double -getOpenFD_darwin pid = do - rawOutput <- shelly $ silently $ escaping False $ - T.strip <$> run "lsof" ["-p", T.pack (show pid), "|" - ,"wc", "-l" +getOpenFD_darwin :: RidleyOptions -> LogEnv -> ProcessID -> IO Double +getOpenFD_darwin opts le pid = do + descriptors <- shelly $ silently $ escaping False $ + T.lines . T.strip <$> run "lsof" ["-p", T.pack (show pid), "|" + ,"grep", "REG", "|", "awk", "'{print $9}'" ] - return $ fromMaybe 0.0 (readMaybe . T.unpack $ rawOutput) + logAndReturnFDs opts le pid descriptors -------------------------------------------------------------------------------- -updateOpenFD :: ProcessID -> P.Gauge -> Bool -> IO () -updateOpenFD pid gauge _ = do +updateOpenFD :: RidleyOptions -> LogEnv -> ProcessID -> P.Gauge -> Bool -> IO () +updateOpenFD opts le pid gauge _ = do #ifdef darwin_HOST_OS - openFd <- getOpenFD_darwin pid + openFd <- getOpenFD_darwin opts le pid #else - openFd <- getOpenFD_unix pid + openFd <- getOpenFD_unix opts le pid #endif P.set openFd gauge -------------------------------------------------------------------------------- -- | Monitors the number of open file descriptors for a given `ProcessID`. -processOpenFD :: MonadIO m - => ProcessID - -> RidleyOptions - -> P.RegistryT m RidleyMetricHandler -processOpenFD pid opts = do +processOpenFD :: ProcessID + -> Ridley RidleyMetricHandler +processOpenFD pid = do + opts <- ask + le <- getLogEnv let popts = opts ^. prometheusOptions - openFD <- P.registerGauge "process_open_fd" (popts ^. labels) - return $ mkRidleyMetricHandler "ridley-process-open-file-descriptors" openFD (updateOpenFD pid) False + openFD <- lift $ P.registerGauge "process_open_fd" (popts ^. labels) + return $ mkRidleyMetricHandler "ridley-process-open-file-descriptors" openFD (updateOpenFD opts le pid) False diff --git a/src/System/Metrics/Prometheus/Ridley/Metrics/PhysicalMemory.hs b/src/System/Metrics/Prometheus/Ridley/Metrics/PhysicalMemory.hs --- a/src/System/Metrics/Prometheus/Ridley/Metrics/PhysicalMemory.hs +++ b/src/System/Metrics/Prometheus/Ridley/Metrics/PhysicalMemory.hs @@ -17,6 +17,7 @@ import System.Posix.Types (ProcessID) import System.Remote.Monitoring.Prometheus (labels) import Text.Read (readMaybe) +import Control.Monad.Reader {- Calling 'free' will report [service-runner@hermes-devel ~]$ free -k @@ -103,18 +104,17 @@ -------------------------------------------------------------------------------- -- | Returns the physical memory total and free as sampled from 'free'. -systemPhysicalMemory :: MonadIO m - => RidleyOptions - -> P.RegistryT m RidleyMetricHandler -systemPhysicalMemory opts = do +systemPhysicalMemory :: Ridley RidleyMetricHandler +systemPhysicalMemory = do + opts <- ask let popts = opts ^. prometheusOptions - gauges <- FreeGauges <$> P.registerGauge "free_mem_total_mb" (popts ^. labels) - <*> P.registerGauge "free_mem_used_mb" (popts ^. labels) - <*> P.registerGauge "free_mem_free_mb" (popts ^. labels) - <*> P.registerGauge "free_mem_shared_mb" (popts ^. labels) - <*> P.registerGauge "free_mem_buff_cache_mb" (popts ^. labels) - <*> P.registerGauge "free_mem_available_mb" (popts ^. labels) - <*> P.registerGauge "free_swap_total_mb" (popts ^. labels) - <*> P.registerGauge "free_swap_used_mb" (popts ^. labels) - <*> P.registerGauge "free_swap_free_mb" (popts ^. labels) + gauges <- lift $ FreeGauges <$> P.registerGauge "free_mem_total_mb" (popts ^. labels) + <*> P.registerGauge "free_mem_used_mb" (popts ^. labels) + <*> P.registerGauge "free_mem_free_mb" (popts ^. labels) + <*> P.registerGauge "free_mem_shared_mb" (popts ^. labels) + <*> P.registerGauge "free_mem_buff_cache_mb" (popts ^. labels) + <*> P.registerGauge "free_mem_available_mb" (popts ^. labels) + <*> P.registerGauge "free_swap_total_mb" (popts ^. labels) + <*> P.registerGauge "free_swap_used_mb" (popts ^. labels) + <*> P.registerGauge "free_swap_free_mb" (popts ^. labels) return $ mkRidleyMetricHandler "ridley-physical-memory-statistics" gauges updateFreeStats False diff --git a/src/System/Metrics/Prometheus/Ridley/Metrics/VirtualMemory.hs b/src/System/Metrics/Prometheus/Ridley/Metrics/VirtualMemory.hs --- a/src/System/Metrics/Prometheus/Ridley/Metrics/VirtualMemory.hs +++ b/src/System/Metrics/Prometheus/Ridley/Metrics/VirtualMemory.hs @@ -5,18 +5,19 @@ module System.Metrics.Prometheus.Ridley.Metrics.VirtualMemory where import Control.Monad.IO.Class +import Control.Monad.Reader (ask, lift) import Data.Maybe (fromMaybe, mapMaybe) import Data.Monoid import Data.Word -import qualified Data.Text as T import Lens.Micro import Shelly -import qualified System.Metrics.Prometheus.Metric.Gauge as P -import qualified System.Metrics.Prometheus.RegistryT as P import System.Metrics.Prometheus.Ridley.Types import System.Posix.Types (ProcessID) import System.Remote.Monitoring.Prometheus (labels) import Text.Read (readMaybe) +import qualified Data.Text as T +import qualified System.Metrics.Prometheus.Metric.Gauge as P +import qualified System.Metrics.Prometheus.RegistryT as P {- Calling 'vmstat' will report @@ -118,19 +119,18 @@ -------------------------------------------------------------------------------- -- | Returns the virtual memory total and free as sampled from 'vmstat'. -systemVirtualMemory :: MonadIO m - => RidleyOptions - -> P.RegistryT m RidleyMetricHandler -systemVirtualMemory opts = do +systemVirtualMemory :: Ridley RidleyMetricHandler +systemVirtualMemory = do + opts <- ask let popts = opts ^. prometheusOptions - gauges <- VmStatGauges <$> P.registerGauge "vmstat_total_memory_mb" (popts ^. labels) - <*> P.registerGauge "vmstat_used_memory_mb" (popts ^. labels) - <*> P.registerGauge "vmstat_active_memory_mb" (popts ^. labels) - <*> P.registerGauge "vmstat_inactive_memory_mb" (popts ^. labels) - <*> P.registerGauge "vmstat_free_memory_mb" (popts ^. labels) - <*> P.registerGauge "vmstat_buffer_memory_mb" (popts ^. labels) - <*> P.registerGauge "vmstat_swap_cache_mb" (popts ^. labels) - <*> P.registerGauge "vmstat_total_swap_mb" (popts ^. labels) - <*> P.registerGauge "vmstat_used_swap_mb" (popts ^. labels) - <*> P.registerGauge "vmstat_free_swap_mb" (popts ^. labels) + gauges <- lift $ VmStatGauges <$> P.registerGauge "vmstat_total_memory_mb" (popts ^. labels) + <*> P.registerGauge "vmstat_used_memory_mb" (popts ^. labels) + <*> P.registerGauge "vmstat_active_memory_mb" (popts ^. labels) + <*> P.registerGauge "vmstat_inactive_memory_mb" (popts ^. labels) + <*> P.registerGauge "vmstat_free_memory_mb" (popts ^. labels) + <*> P.registerGauge "vmstat_buffer_memory_mb" (popts ^. labels) + <*> P.registerGauge "vmstat_swap_cache_mb" (popts ^. labels) + <*> P.registerGauge "vmstat_total_swap_mb" (popts ^. labels) + <*> P.registerGauge "vmstat_used_swap_mb" (popts ^. labels) + <*> P.registerGauge "vmstat_free_swap_mb" (popts ^. labels) return $ mkRidleyMetricHandler "ridley-virtual-memory-statistics" gauges updateVmStat False