#!/usr/bin/env perl

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

my ($proc) = '$Id: rsysinfo 25667 2008-10-28 01:05:21Z vinc17/prunille $'
  =~ /^.Id: (\S+) / or die;

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

GetOptions('archive|a=s' => \$arcdir,
           'config|c=s' => \$conffile,
           'create' => \$createcmd,
           'debug|d' => \$debug,
           '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;
$SIG{__DIE__} = sub { defined $lock and unlink $lock };

my $label = qr/[-A-Za-z0-9_]+/;
my ($cpuload,@disks,$entropy,@macsensors);
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") },
  );

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 };
  }
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);
    &crcmd('entropy', ['MIN', 'AVERAGE', 'MAX'], 'GAUGE:600:0:U', 'entropy')
      if $linux;
    &crcmd('macsensor', ['MIN', 'AVERAGE', 'MAX'], 'GAUGE:600:-10:200',
           map $_->{'label'}, @macsensors);
    exit;
  }

do
  {
    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);
            &rrdupdate('entropy', $entropy) if $linux;
            &rrdupdate('macsensor', @macsensors);
          }
      }

    sleep $loop;
  }
while ($loop);

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 outdebug
  {
    $debug or return;
    my $msg = "@_\n";
    $msg =~ s/^/DEBUG: /mg;
    warn $msg;
  }

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.

    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).
    $error 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";

    &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);
    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++;
          }
        $s .= $current;
        print FILE $s if $def && $start > $hs && ($checked || !defined $hs);
        undef $s if $def || !defined $hs;
        $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";
    RRDs::update ($file, "--template",
                  (join ':', map $_->{'label'} || $class, @dsname),
                  (join ':', $time, map $_->{'value'}, @dsname));
    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'};
        my @a = ('-a', 'PNG', '-h', 200, '-v', $vlabel{$class}($i),
                 $gparam{$class}($file, $i->{'label'}));
        foreach my $p (qw/day week month year/)
          { RRDs::graph ("$base.$p.png", '--start', -120000 * $t{$p}, @a) }
      }
  }