scripts/lcp_rtt_exporter

   1 #!/usr/bin/perl
   2 # vim: shiftwidth=4 tabstop=4
   3 #
   4 # This CGI program is a Prometheus exporter for pppd's lcp-rtt-file feature.
   5 #
   6 # Copyright (C) Marco d'Itri <md@linux.it>
   7 #
   8 # This program is free software; you can redistribute it and/or modify
   9 # it under the terms of the GNU General Public License as published by
  10 # the Free Software Foundation; either version 2 of the License, or
  11 # (at your option) any later version.
  12
  13 use v5.14;
  14 use warnings;
  15 use autodie;
  16
  17 use List::Util qw(sum max min);
  18
  19 {
  20         my $data = read_data('/run/ppp-rtt.data');
  21         my $stats = compute_statistics($data, 60);
  22
  23         my $s = metrics($stats);
  24         my $length = length($s);
  25
  26         print "Content-type: text/plain\n";
  27         print "Content-length: $length\n\n$s";
  28         exit;
  29 }
  30
  31 sub metrics {
  32         my ($stats) = @_;
  33
  34         my $s = <<END;
  35 # TYPE lcp_rtt_status gauge
  36 # HELP LCP RTT status
  37 lcp_rtt_status $stats->{status}
  38 END
  39         foreach (qw(average min max loss)) {
  40                 next if not exists $stats->{$_};
  41                 $s .= <<END;
  42 # TYPE lcp_rtt_$_ gauge
  43 # HELP LCP RTT $_
  44 lcp_rtt_$_ $stats->{$_}
  45 END
  46         }
  47
  48         return $s;
  49 }
  50
  51 sub compute_statistics {
  52         my ($data, $length) = @_;
  53
  54         my $cutoff = time() - $length;
  55         my @e = grep { $_->[0] >= $cutoff } @{ $data->{data} };
  56         return { status => -1 } if not @e; # no data
  57
  58         my $average = (sum map { $_->[1] } @e) / scalar(@e);
  59         my $min = min map { $_->[1] } @e;
  60         my $max = max map { $_->[1] } @e;
  61         my $loss = sum map { $_->[2] } @e;
  62
  63         return {
  64                 status  => $data->{status},
  65                 average => $average,
  66                 min             => $min,
  67                 max             => $max,
  68                 loss    => $loss,
  69         };
  70 }
  71
  72 sub read_data {
  73         my ($file) = @_;
  74
  75         my $data;
  76         open(my $fh, '<', $file);
  77         binmode($fh);
  78         my $bytes_read;
  79         do {
  80                 $bytes_read = sysread($fh, $data, 8192, length($data));
  81         } while ($bytes_read == 8192);
  82         close($fh);
  83
  84         my ($magic, $status, $position, $echo_interval, $rest)
  85                 = unpack('NNNN a*', $data);
  86         return undef if $magic != 0x19450425;
  87
  88         # the position is relative to the C array, not to the logical entries
  89         $position /= 2;
  90
  91         my @rawdata = unpack('(N C a3)*', $rest);
  92         my @data;
  93         while (my ($time, $loss, $rtt) = splice(@rawdata, 0, 3)) {
  94                 push(@data, [ $time, unpack('N', "\000$rtt"), $loss ]);
  95         }
  96
  97         @data =
  98                 # skip any "empty" (null) entries
  99                 grep { $_->[0] }
 100                 # rearrange the list in chronological order
 101                 (@data[$position+1 .. $#data], @data[0 .. $position]);
 102
 103         return {
 104                 status                  => $status,
 105                 echo_interval   => $echo_interval,
 106                 position                => $position,
 107                 data                    => \@data,
 108         };
 109 }
 110