Artifact Content
Not logged in

Artifact 998242a65258eeee8fcf42f63a132629436c13b6:


#!/usr/bin/perl

use strict;
use warnings;

use Getopt::Long;
use IO::Async::Signal;
use IO::Async::Loop;
use Net::Async::HTTP::Server::PSGI;
use Net::Prometheus 0.05;
use POSIX qw( strftime );
use YAML;

STDOUT->autoflush(1); # Disable block buffering in case of logging to regular file

sub printlog
{
   print strftime( "[%Y-%m-%d %H:%M:%S] ", localtime ), @_, "\n";
}

GetOptions(
   'C|config-file=s' => \( my $CONFIG_FILE = "process_exporter.yaml" ),
   'p|port=i'        => \( my $PORT = 9124 ),
   'pidfile=s'       => \my $PIDFILE,
) or exit 1;

my $CONFIG = YAML::LoadFile( $CONFIG_FILE );

my $loop = IO::Async::Loop->new;

my $prometheus = Net::Prometheus->new;

my %collectors_by_desc;
reapply_config();

$loop->add( IO::Async::Signal->new(
   name => "HUP",
   on_receipt => sub {
      printlog "Reloading config due to SIGHUP";

      eval { $CONFIG = YAML::LoadFile( $CONFIG_FILE ); 1 } or do {
         printlog "Unable to load config - $@";
         return;
      };

      reapply_config();
   }
) );

my $server = Net::Async::HTTP::Server::PSGI->new(
   app => $prometheus->psgi_app
);
$loop->add( $server );

$server->listen(
   socktype => "stream",
   service  => $PORT,
)->get;

printlog "Listening for metrics on http://[::0]:" . $server->read_handle->sockport;

if( defined $PIDFILE ) {
   open my $pidfh, ">", $PIDFILE or
      die "Unable to write pidfile $PIDFILE - $!";
   $pidfh->print( "$$\n");
}

$loop->run;

sub reapply_config
{
   # Unregister all the watchers then start again
   foreach my $collector ( values %collectors_by_desc ) {
      $prometheus->unregister( $collector );
   }

   %collectors_by_desc = ();

   my $processes = $CONFIG->{processes};
   foreach my $name ( keys %$processes ) {
      my $configs = $processes->{$name};
      foreach my $config ( ref $configs eq "ARRAY" ? @$configs : ( $configs ) ) {
         my $collector = ProcessCollector->new(
            name => $name,
            %$config,
         );

         my $desc = $collector->desc;

         printlog "Watching $desc(" . ( $collector->pid // "??" ). ")";
         $prometheus->register( $collectors_by_desc{$desc} = $collector );
      }
   }
}

package ProcessCollector;

use File::stat;

use Net::Prometheus::Types qw( MetricSamples Sample );

sub new
{
   my $class = shift;
   my %args = @_;

   return bless {
      name    => delete $args{name},
      pidfile => delete $args{pidfile},
      pid     => delete $args{pid},
      labels  => delete $args{labels},
   };
}

sub desc
{
   my $self = shift;

   return $self->{name} unless my $labels = $self->{labels};

   return join "", $self->{name}, "{",
      ( map { qq($_="$labels->{$_}") } sort keys %$labels ),
      "}";
}

sub pid
{
   my $self = shift;
   defined( my $pidfile = $self->{pidfile} ) or
      return $self->{pid};

   my $stat = stat( $pidfile );
   return $self->{_cached_pid} if
      $stat and $stat->mtime and $stat->mtime == ( $self->{_cached_pid_mtime} // 0 );

   open my $fh, "<", $pidfile or return undef;

   my $pid = <$fh>; chomp $pid;

   # Check if the PID is valid
   -e "/proc/$pid" or return undef;

   $self->{_cached_pid_mtime} = stat( $fh )->mtime;
   return $self->{_cached_pid} = $pid;
}

sub collect
{
   my $self = shift;

   my $pid = $self->pid;

   if( defined $pid and defined $self->{last_pid} and $pid != $self->{last_pid} ) {
      ::printlog "Process $self->{name} changed its pid to $pid";

      undef $self->{collector};
   }

   my $morelabels = $self->{labels};
   my @labels = (
      process_name => $self->{name},
      map { $_ => $morelabels->{$_} } sort keys %$morelabels,
   );

   my @metrics;
   if( defined $pid ) {
      $self->{last_pid} = $pid;

      my $collector = $self->{collector} //=
         Net::Prometheus::ProcessCollector->new(
            pid    => $pid,
            prefix => "exported_process",
            labels => \@labels,
         );

      @metrics = $collector->collect;
   }

   my $up_metric = MetricSamples( exported_process_up =>
      "gauge", "The value 1 if the exported process exists",
      [ Sample( exported_process_up => \@labels, @metrics ? 1 : 0 ) ] );

   return $up_metric, @metrics;
}