diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,3 @@ +# 0.1.0.0 -- 2019-01-15 + +* Initial release. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2018, Ollie Charles + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Ollie Charles nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/prometheus-proc.cabal b/prometheus-proc.cabal new file mode 100644 --- /dev/null +++ b/prometheus-proc.cabal @@ -0,0 +1,27 @@ +name: prometheus-proc +version: 0.1.0.0 +synopsis: Export metrics from /proc for the current process +homepage: https://github.com/fimad/prometheus-haskell +license: BSD3 +license-file: LICENSE +author: Ollie Charles +maintainer: ollie@ocharles.org.uk +category: System +build-type: Simple +extra-source-files: ChangeLog.md +cabal-version: >=1.10 + +source-repository head + type: git + location: https://github.com/fimad/prometheus-haskell + +library + exposed-modules: Prometheus.Metric.Proc + build-depends: base >=4.10 && <4.13 + , filepath >=1.4 && <1.5 + , unix-memory >=0.1 && <0.2 + , unix >=2.7 && <2.8 + , regex-applicative >=0.3 && <0.4 + , prometheus-client >= 1.0.0 && < 1.1 + hs-source-dirs: src + default-language: Haskell2010 diff --git a/src/Prometheus/Metric/Proc.hs b/src/Prometheus/Metric/Proc.hs new file mode 100644 --- /dev/null +++ b/src/Prometheus/Metric/Proc.hs @@ -0,0 +1,235 @@ +{-# language ForeignFunctionInterface #-} +{-# language NamedFieldPuns #-} +{-# language OverloadedStrings #-} +{-# language RecordWildCards #-} + +{-| + +This module exposes a @prometheus-client@ "Metric" for exporting information +about the currently running process. + +-} +module Prometheus.Metric.Proc ( ProcMetrics(..), procMetrics ) where + +import Data.Char ( isSpace ) +import Data.Maybe ( catMaybes ) +import Data.String ( fromString ) +import Foreign.C +import Prometheus +import System.FilePath +import System.IO.Unsafe +import System.Posix.Memory ( sysconfPageSize ) +import System.Posix.Process ( getProcessID ) +import qualified Text.Regex.Applicative as RE +import qualified Text.Regex.Applicative.Common as RE + + +-- | The tag for 'procMetrics'. +data ProcMetrics = + ProcMetrics + + +{-| + +Unregistered metrics for the current process. This is to be used with +'Prometheus.register' to register the metrics. + +This exports the following: + + +* @process_cpu_seconds_total@ +* @process_start_time_seconds@ +* @process_virtual_memory_bytes@ +* @process_resident_memory_bytes@ + +See the official Prometheus documentation for more information on these standard +metrics: https://prometheus.io/docs/instrumenting/writing_clientlibs/#standard-and-runtime-collectors + +-} +procMetrics :: Prometheus.Metric ProcMetrics +procMetrics = + Metric ( return ( ProcMetrics, collect ) ) + + +-- | Returns the number of CPU clock ticks per second. +foreign import ccall unsafe + clk_tck :: CLong + + +collect :: IO [ SampleGroup ] +collect = do + pid <- + getProcessID + + mprocStat <- + RE.match parseProcStat <$> readFile ( "/" "proc" show pid "stat" ) + + return + ( foldMap ( toMetrics ) mprocStat ) + + +toMetrics :: ProcStat -> [ SampleGroup ] +toMetrics ProcStat{ utime, stime, starttime, vsize, rss } = + catMaybes + [ Just process_cpu_seconds_total + , process_start_time_seconds + , Just process_virtual_memory_bytes + , Just process_resident_memory_bytes + ] + + where + + process_cpu_seconds_total = + metric + "process_cpu_seconds_total" + "Total user and system CPU time spent in seconds." + CounterType + ( fromTicks ( utime + stime ) ) + + process_start_time_seconds = do + btime <- + mbtime + + return + ( metric + "process_start_time_seconds" + "Start time of the process since unix epoch in seconds." + GaugeType + ( fromIntegral btime + fromTicks starttime ) + ) + + process_virtual_memory_bytes = + metric + "process_virtual_memory_bytes" + "Virtual memory size in bytes." + GaugeType + vsize + + process_resident_memory_bytes = + metric + "process_resident_memory_bytes" + "Resident memory size in bytes." + GaugeType + ( rss * sysconfPageSize ) + + metric metricName metricHelp metricType value = + SampleGroup + Info{..} + metricType + [ Sample + metricName + [] + ( fromString ( show value ) ) + ] + + +-- | Convert a number of clock ticks into the corresponding duration in seconds. +fromTicks :: Int -> Double +fromTicks ticks = + fromIntegral ticks / fromIntegral clk_tck + + +{-| + +Returns the current boot time in seconds since Unix epoch. This is a Maybe +as we might not to be able to successfully parse this information out of +@/proc/stat@. + +'unsafePerformIO' is used as this value does not change during the +execution of the program, so this gives us a lightweight cache for this +value. + +-} +{-# NOINLINE mbtime #-} +mbtime :: Maybe Int +mbtime = unsafePerformIO $ do + fmap ( \( _, a, _ ) -> a ) . RE.findFirstInfix ( "btime " *> RE.decimal ) + <$> readFile "/proc/stat" + + +-- | Specific metrics from @/proc/xyz/stat@ that we are interested in. +data ProcStat = ProcStat + { utime :: Int + -- ^ Amount of time that this process has been scheduled in user mode, + -- measured in clock ticks (divide by sysconf(_SC_CLK_TCK)). + , stime :: Int + -- ^ Amount of time that this process has been scheduled in kernel mode, + -- measured in clock ticks (divide by sysconf(_SC_CLK_TCK)). + , starttime :: Int + -- ^ The time the process started after system boot. In kernels before Linux + -- 2.6, this value was expressed in jiffies. Since Linux 2.6, the value is + -- expressed in clock ticks (divide by sysconf(_SC_CLK_TCK)). + , vsize :: Int + -- ^ Virtual memory size in bytes. + , rss :: Int + -- ^ Resident Set Size: number of pages the process has in real memory. This + -- is just the pages which count toward text, data, or stack space. This + -- does not include pages which have not been demand-loaded in, or which are + -- swapped out. + } + deriving + ( Show ) + + +{-| + +A regular expression for parsing @/proc/xyz/stat@. See +@man 5 proc@ for more information on the format of this file: +https://linux.die.net/man/5/proc. + +-} +parseProcStat :: RE.RE Char ProcStat +parseProcStat = + ProcStat + <$ any -- pid %d + <* token ( RE.sym '(' *> RE.some RE.anySym <* RE.sym ')' ) -- comm %s + <* any -- state %c + <* any -- ppid %d + <* any -- pgrp %d + <* any -- session %d + <* any -- tty_nr %d + <* any -- tpgid %d + <* any -- flags %u (%lu before Linux 2.6.22) + <* any -- minflt %lu + <* any -- cminflt %lu + <* any -- majflt %lu + <* any -- cmajflt %lu + <*> token RE.decimal -- utime %lu + <*> token RE.decimal -- stime %lu + <* any -- cutime %ld + <* any -- cstime %ld + <* any -- priority %ld + <* any -- nice %ld + <* any -- num_threads %ld + <* any -- itrealvalue %ld + <*> token RE.decimal -- starttime %llu (was %lu before Linux 2.6) + <*> token RE.decimal -- vsize %lu + <*> token RE.decimal -- rss %ld + <* any -- rsslim %lu + <* any -- startcode %lu + <* any -- endcode %lu + <* any -- startstack %lu + <* any -- kstkesp %lu + <* any -- kstkeip %lu + <* any -- signal %lu + <* any -- blocked %lu + <* any -- sigignore %lu + <* any -- sigcatch %lu + <* any -- wchan %lu + <* any -- nswap %lu + <* any -- cnswap %lu + <* any -- exit_signal %d (since Linux 2.1.22) + <* any -- processor %d (since Linux 2.2.8) + <* any -- rt_priority %u (since Linux 2.5.19; was %lu before Linux 2.6.22) + <* any -- policy %u (since Linux 2.5.19; was %lu before Linux 2.6.22) + <* any -- delayacct_blkio_ticks %llu (since Linux 2.6.18) + <* any -- guest_time %lu (since Linux 2.6.24) + <* any -- cguest_time %ld (since Linux 2.6.24) + + where + + token a = + a <* RE.psym isSpace <* RE.few ( RE.psym isSpace ) + + any = + token ( RE.few RE.anySym )