#!/usr/bin/env perl

use strict;
use Getopt::Long;
use Fcntl qw(:DEFAULT :flock);

my ($proc) = '$Id: rsysinfo 144523 2022-01-03 21:25:29Z vinc17/joooj $'
  =~ /^.Id: (\S+) / or die;

my $conffile = "/etc/rsysinfo.conf";
my ($arcdir,$createcmd,$debug,$dryrun,$gdir,$loop,$out,$rrddir);
my $linux = $^O eq 'linux';

GetOptions('archive|a=s' => \$arcdir,
           'config|c=s' => \$conffile,
           'create' => \$createcmd,
           'debug|d' => \$debug,
           'dry-run' => \$dryrun,
           'graphs|g=s' => \$gdir,
           'loop|l=i' => \$loop,
           'output|o=s' => \$out,
           'rrdtool|r=s' => \$rrddir)
  or die;

if (defined $out && $out ne '-')
  {
    open STDOUT, '>', $out
      or die "$proc: can't create file $out\n$!\n";
  }

!defined $arcdir || -d $arcdir
  or die "$proc: $arcdir is not a directory\n";

!defined $gdir || -d $gdir
  or die "$proc: $gdir is not a directory\n";

!defined $rrddir || -d $rrddir
  or die "$proc: $rrddir is not a directory\n";

my ($lock,$locked);
$SIG{__DIE__} = sub { die @_ if $^S; $locked and unlink $lock; };

my $label = qr/[-A-Za-z0-9_]+/;
my ($cpuload,@disks,$entropy,@macsensors,@wake);
my %suffix = ('AVERAGE' => 'avg', 'MIN' => 'min', 'MAX' => 'max');

my %t =
  ('day'   => 1,
   'week'  => 6,
   'month' => 24,
   'year'  => 288);

my %vlabel =
  (
   'cpuload'   => sub { 'CPU load' },
   'disk'      => sub { "disk used: $_[0]->{dir}" },
   'entropy'   => sub { 'entropy available' },
   'macsensor' => sub { "$_[0]->{location} temperature" },
  );

my %gparam =
  (
   'cpuload' => sub
     { ("DEF:avg=$_[0]:cpuload:AVERAGE",
        "DEF:max=$_[0]:cpuload:MAX",
        "AREA:avg#00ff00", "LINE1:max#ff0000") },
   'disk' => sub
     { ("DEF:kavg=$_[0]:$_[1]:AVERAGE", "CDEF:avg=kavg,1024,*",
        "DEF:kmax=$_[0]:$_[1]:MAX",     "CDEF:max=kmax,1024,*",
        "AREA:avg#00ff00", "LINE1:max#ff0000") },
   'entropy' => sub
     { ("DEF:avg=$_[0]:entropy:AVERAGE",
        "DEF:min=$_[0]:entropy:MIN",
        "DEF:max=$_[0]:entropy:MAX",
        "AREA:avg#00ff00", "LINE1:min#0000ff", "LINE1:max#ff0000") },
   'macsensor' => sub
     { ("DEF:avg=$_[0]:$_[1]:AVERAGE",
        "DEF:min=$_[0]:$_[1]:MIN",
        "DEF:max=$_[0]:$_[1]:MAX",
        "AREA:avg#00ff00", "LINE1:min#0000ff", "LINE1:max#ff0000") },
  );

### Subroutines ########################################################

sub outdebug (@)
  {
    $debug or return;
    my $msg = "@_\n";
    $msg =~ s/^/DEBUG: /mg;
    warn $msg;
  }

sub outrrdcmd ($@)
  {
    my ($cmd,@args) = @_;
    # Assume that @args elements do not contain the character '.
    print "rrdtool $cmd ", join(' ', map { "'$_'" } @args), "\n";
  }

sub getsysinfo
  {
    my $val;

    $val = $cpuload->{'value'} = eval {
      require Sys::CpuLoad;
      (&Sys::CpuLoad::load())[0];
    };
    $cpuload->{'time'} = time;
    print "cpuload = $val\n"
      if defined $out && defined $val;

    foreach my $disk (@disks)
      {
        $val = $disk->{'value'} = eval {
          require Filesys::DiskSpace;
          (&Filesys::DiskSpace::df($disk->{'dir'}))[2];
        };
        $disk->{'time'} = time;
        print "disk[$disk->{label}] = $val\n"
          if defined $out && defined $val;
      }

    if ($linux and open ENTROPY, '/proc/sys/kernel/random/entropy_avail')
      {
        ($val) = <ENTROPY> =~ /^(\d+)$/;
        $entropy->{'time'} = time;
        $entropy->{'value'} = $val;
        close ENTROPY;
        print "entropy = $val\n"
          if defined $out && defined $val;
      }

    if (@macsensors)
      {
        my $sensors = &readmacsensors;
        foreach my $sensor (defined $sensors ? @macsensors : ())
          {
            $val = $sensor->{'value'} = $sensors->{$sensor->{'location'}};
            $sensor->{'time'} = time;
            print "macsensor[$sensor->{label}] = $val\n"
              if defined $out && defined $val;
          }
      }
  }

sub readmacsensors
  {
    my ($ok,$loc,$type,$val,%s);
    open IOREG, '-|', qw(ioreg -n IOHWSensor -w 0)
      or warn("$!\n$proc: can't exec ioreg\n"), return;
    while (<IOREG>)
      {
        /-o IOHWSensor/ and $ok = 1, undef $loc, undef $type, undef $val;
        $ok && /\|\s*"location" = "(.*?)"/ and $loc = $1;
        $ok && /\|\s*"type" = "(.*?)"/ and $type = $1;
        $ok && /\|\s*"current-value" = (-?\d+)/ and $val = $1;
        /\|\s*\}/ or next;
        undef $ok;
        $type eq 'temperature' or next;
        # See http://ask.metafilter.com/mefi/25932
        $s{$loc} = ($val >> 13) / 8 - 0.5;
        outdebug "Mac sensor $loc = $val";
      }
    close IOREG or warn "$!\n$proc: ioreg failed\n";
    return \%s;
  }

sub crcmd ($$$@)
  {
    my ($class,$cf,$dsta,@dsname) = @_;
    print "rrdtool create $class.rrd \\\n";
    print map "  DS:$_:$dsta \\\n", @dsname;
    foreach my $i (@$cf)
      { print map "  RRA:$i:0.5:$_:600 \\\n", 1, 6, 24, 288 }
    print "\n";
  }

sub rrdarch ($$)
  {
    # Use fetch instead of dump, as fetch is available via the RRDs module
    # and this is a more efficient solution.

    return if $dryrun;

    require RRDs;

    outdebug "rrdarch[@_]";
    my ($class,$cf) = @_;

    my ($start,$step,$names,$array) =
      RRDs::fetch ("$rrddir/$class.rrd", $cf, '-s', -1080000);
    my $error = &RRDs::error();
    # The following error is normal on CF's that are not in the rrd file;
    # that is why it is output only in debug mode (check the timestamp of
    # the backup files to detect potential problems).
    # However, rrdtool no longer fails in such a case:
    #   https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=1002977
    # (at least 1.7.2 is affected). Workaround: "|| $step != 1800" as one
    # gets a step of 300 when the CF is absent. A drawback is to leave
    # some potential bugs undetected.
    $error || $step != 1800 and
      outdebug("Error in rrdarch while fetching $class.rrd on CF $cf:\n".
               "$error"), return;
    $step == 1800 or die "$proc: incorrect step value ($step) for @_\n";
    outdebug "Start: $start";
    outdebug "Names: @$names";

    my $file = "$arcdir/$class-$suffix{$cf}";
    outdebug "Set lock on file $file";
    $lock = "$file.lock";
    open LOCK, ">$lock" or die "$proc: can't create lock file $lock\n$!\n";
    flock LOCK, LOCK_EX | LOCK_NB or die "$proc: can't set lock\n$!\n";
    $locked = 1;

    outdebug "Reading file $file";
    my ($hs,@h);
    if (open FILE, '<', $file)
      {
        while (my $line = <FILE>)
          {
            $line =~ /^(\d+):/ or die "$proc: bad format";
            $1 < $start and next;
            @h or $hs = $1;
            push @h, $line;
          }
        close FILE or die "$proc: can't close file $file\n$!\n";
      }

    outdebug "Appending to file $file";
    open FILE, '>>', $file or die "$proc: can't append to file $file\n$!\n";
    my ($checked,$s,$started);
    foreach my $line (@$array)
      {
        my $current = "$start";
        my $def;
        foreach my $val (@$line)
          {
            $current .= defined $val ?
              ($def = 1, sprintf(":%1.10e", $val)) : ':NaN';
          }
        $current .= "\n";
        if ($hs == $start)
          {
            $current eq shift @h
              or die "$proc: line mismatch for time $start in $file\n";
            @h and $hs += $step;
            $checked++;
            $started = 1;
          }
        $s .= $current;
        $def && $start > $hs && ($checked || !defined $hs)
          and $started = 1, print FILE $s;
        undef $s if $def || !$started;
        $start += $step;
      }
    close FILE or die "$proc: can't close file $file (append mode)\n$!\n";

    outdebug "$checked line".($checked > 1 ? 's' : ' ')." checked"
      if $checked;
    outdebug "Remove lock on file $file";
    unlink $lock;
  }

sub rrdupdate ($@)
  {
    require RRDs;

    my ($class, @dsname) = @_;
    my $time = 0;
    foreach my $i (@dsname)
      { $time += $i->{'time'}; }
    $time /= @dsname;
    my $file = "$rrddir/$class.rrd";
    my @update = ($file, "--template",
                  (join ':', map $_->{'label'} || $class, @dsname),
                  (join ':', $time, map $_->{'value'}, @dsname));
    if ($dryrun)
      {
        outrrdcmd "update", @update;
      }
    else
      {
        RRDs::update (@update);
        my $error = &RRDs::error();
        $error and warn
          "Error in rrdupdate while updating $class.rrd: $error\n";
      }
    return unless defined $gdir;

    foreach my $i (@dsname)
      {
        my $base = "$gdir/$class";
        $base .= ".$i->{label}" if defined $i->{'label'};
        # --alt-autoscale is needed, otherwise, for instance with values
        # around 10, small variations are not visible, because Y ranges
        # from 9 to 20.
        # --alt-y-grid is needed when --alt-autoscale is used, otherwise
        # the y-axis may contain only one label (or even none, according
        # to bug reports).
        my @a = ('-a', 'PNG', '-h', 200, '-v', $vlabel{$class}($i),
                 '--alt-autoscale', '--alt-y-grid',
                 $gparam{$class}($file, $i->{'label'}));
        foreach my $p (qw/day week month year/)
          {
            my @graph = ("$base.$p.png", '--start', -120000 * $t{$p}, @a);
            if ($dryrun)
              {
                outrrdcmd "graph", @graph;
              }
            else
              {
                RRDs::graph (@graph);
              }
          }
      }
  }

### Main code ##########################################################

open CONFIG, '<', $conffile
  or die "$proc: can't open config file $conffile\n$!\n";
while (<CONFIG>)
  {
    /^disk\[($label)\]\s*=\s*(\S+)$/
      and push @disks, { 'label' => $1, 'dir' => $2 };
    /^macsensor\[($label)\]\s*=\s*(\S.*?)\s*$/
      and push @macsensors, { 'label' => $1, 'location' => $2 };
    /^wake\s*=\s*(\S.*)/ and push @wake, $1;
  }
close CONFIG
  or die "$proc: can't close config file $conffile\n$!\n";

if ($createcmd)
  {
    crcmd('cpuload', ['AVERAGE', 'MAX'], 'GAUGE:600:0:U', 'cpuload');
    crcmd('disk', ['AVERAGE', 'MAX'], 'GAUGE:864000:1:U',
           map $_->{'label'}, @disks) if @disks;
    crcmd('entropy', ['MIN', 'AVERAGE', 'MAX'], 'GAUGE:600:0:U', 'entropy')
      if $linux;
    crcmd('macsensor', ['MIN', 'AVERAGE', 'MAX'], 'GAUGE:600:-10:200',
           map $_->{'label'}, @macsensors) if @macsensors;
    exit;
  }

while (1)
  {
    if (defined $arcdir)
      {
        defined $rrddir or $rrddir = $arcdir;
        foreach my $class (qw/cpuload disk entropy macsensor/)
          { map { rrdarch $class, $_ } qw/MIN AVERAGE MAX/ }
      }
    else
      {
        &getsysinfo();
        if (defined $rrddir)
          {
            rrdupdate('cpuload', $cpuload);
            rrdupdate('disk', @disks) if @disks;
            rrdupdate('entropy', $entropy) if $linux;
            rrdupdate('macsensor', @macsensors) if @macsensors;
          }
      }
    $loop or exit;
    my $stime = sleep $loop;
    next if $stime < $loop + 5;
    # The machine has probably wake up. Let's execute the wake commands.
    foreach my $cmd (@wake)
      { system $cmd }
  }

########################################################################