module System.Metrics.Prometheus.Ridley.Metrics.FD where
import Control.Monad.IO.Class
import Data.Maybe (fromMaybe)
import Data.Monoid
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)
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"
]
return $ fromMaybe 0.0 (readMaybe . T.unpack $ rawOutput)
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"
]
return $ fromMaybe 0.0 (readMaybe . T.unpack $ rawOutput)
updateOpenFD :: ProcessID -> P.Gauge -> Bool -> IO ()
updateOpenFD pid gauge _ = do
#ifdef darwin_HOST_OS
openFd <- getOpenFD_darwin pid
#else
openFd <- getOpenFD_unix pid
#endif
P.set openFd gauge
processOpenFD :: MonadIO m
=> ProcessID
-> RidleyOptions
-> P.RegistryT m RidleyMetricHandler
processOpenFD pid opts = do
let popts = opts ^. prometheusOptions
openFD <- P.registerGauge "process_open_fd" (popts ^. labels)
return RidleyMetricHandler {
metric = openFD
, updateMetric = updateOpenFD pid
, flush = False
}