#!/usr/bin/perl
#
# Yet Another Monitoring Script - CGI for whitebox monitoring
#
use Sys::Hostname;
use Time::HiRes qw( gettimeofday tv_interval );
use strict;

my $httpd = 0;
my $secret = 0;
for my $ARG (@ARGV) {
  $httpd = 1 if ($ARG eq "--httpd");
  $secret = $1 if ($ARG =~ /^--secret=(.*)$/);
}

my $seen_secret = !$secret;
if ($httpd)
{
  # This is the dumbest HTTP server in the Universe!
  #
  # If you aren't running a HTTP server or just don't want yamon cluttering
  # up your web logs, you can use this feature to run straight out of 
  # (x)inetd or something similar.
  #
  $|=1;
  while (<STDIN>) {
    chomp;
    $seen_secret = 1 if ($secret && /$secret/);
    last if (/^\s*$/s);
  }
  print "HTTP/1.0 200 OK\n";
}

# Basic HTTP header; text/plain output, disable any caching.
my $t0 = [gettimeofday()];
print "Content-type: text/plain\n";
print "Cache-Control: no-cache\n";
print "\n";
unless ($seen_secret) {
  print "Sorry!\n";
  exit(0) 
}

my $uname = one_line(run('uname -a'));
my %variables = (
  "ts" => time(),
  "hostname" => hostname(),
  "uname" => $uname,
  uptime(),
  mail_queues(),
  disk_usage(),
  processes(),
  network_bytes(),
  log_sizes(),
  vm_stat(),
);
$variables{"yamon_rtime"} = int(1000 * tv_interval($t0));
print map { "$_: $variables{$_}\n" } sort keys(%variables);


##[ Data collection... ]#######################################################

sub disk_usage
{
  my $dfi = hash_magic(run("df -i"));
  my $df = $dfi;

  # Mac OS X style output gives both blocks and inodes at once.
  unless ($dfi->[0]->{"used"} && 
          $dfi->[0]->{"iused"})
  {
    # We don't have that, get the df output too.
    $df = hash_magic(run("df"));
  }

  my %return = ( );
  for (my $i = 0; $i < @$dfi; $i++)
  {
    next if (defined($dfi->[$i]->{'iused'}) &&
             ($dfi->[$i]->{'iused'} + $dfi->[$i]->{'ifree'} == 0));

    my $mounted = $dfi->[$i]->{"Mounted"};
    #                       Mac OS X                  Linux
    my $iuse = $dfi->[$i]->{'%iused'}  || $dfi->[$i]->{'IUse%'};
    my $buse = $df->[$i]->{'Capacity'} || $df->[$i]->{'Use%'};

    $return{"inodes_used_$mounted"} = $iuse;
    $return{"blocks_used_$mounted"} = $buse;
  }

  return %return;
}

sub processes
{
  my $ps = hash_magic(run('ps auxwwww'));

  # Munge the data a bit...
  my %cmd_counts = ( );
  foreach my $p (@$ps)
  {
    # Figure out the command name, make it "pretty"
    my $command = $p->{'COMMAND'};
    $command =~ s/^(--\S+\s+)*// if ($uname =~ /Darwin/);
    $command =~ s,^(/usr/bin/(?:perl\S*|python\S*)|/bin/\S*sh)\s+(?:\-\S+\s)*(\S),$2,;
    unless ($command =~ s/^[\[\(](.*?)[\]\)]$/$1/)
    {
      $command =~ s/\s+.*$//;
      $command =~ s/^.*\///;
    }
    $command =~ s/\s/_/g;
    $command =~ s/:$//;

    $p->{'BASE_COMMAND'} = $command;
    $cmd_counts{$command} += 1;

    my $time = $p->{'TIME'};
    my $s = 0;
    if ($time =~ /(\d+):(\d+)(\.\d+)?/)
    {
      $s = $1 * 60 + $2;
    } 
    $p->{'TIME_S'} = $s;
  }

  my @by_rss = sort { $b->{'RSS'} <=> $a->{'RSS'} } @$ps;
  my @by_cpu = sort { $b->{'%CPU'} <=> $a->{'%CPU'} } @$ps;
  my @by_time = sort { $b->{'TIME_S'} <=> $a->{'TIME_S'} } @$ps;
  my @cmds = sort { $b->[1] <=> $a->[1] } 
               map { [ $_, $cmd_counts{$_} ] } keys(%cmd_counts);

  return (
    "num_processes" => scalar(@$ps), 

    (map { "running_".$_ => $cmd_counts{$_} } keys(%cmd_counts)),

    "most_running" => $cmds[0]->[1],
    "most_running_command" => $cmds[0]->[0],

    "max_cpu" => $by_cpu[0]->{'%CPU'},
    "max_cpu_command" => $by_cpu[0]->{"COMMAND"},

    "max_time" => $by_time[0]->{'TIME_S'},
    "max_time_command" => $by_time[0]->{"COMMAND"},

    "max_rss" => $by_rss[0]->{'RSS'},
    "max_rss_command" => $by_rss[0]->{"COMMAND"},
  );
}

sub vm_stat
{
  my $free = run('free');
  if ($free =~ /-\/\+ buffers\/cache:/) {
    $free =~ s/^.*buffers\/cache:/0/m;
    $free =~ s/^(.*?:)?\s+//gm;

    my $vals = hash_magic($free);
    return (
      mem_total => $vals->[0]->{'total'},
      mem_used => $vals->[0]->{'used'},
      mem_free => $vals->[0]->{'free'},
      mem_shared => $vals->[0]->{'shared'},
      mem_buffers => $vals->[0]->{'buffers'},
      mem_cached => $vals->[0]->{'cached'},
      mem_real_used => $vals->[1]->{'used'},
      mem_real_free => $vals->[1]->{'free'},
      swap_total => $vals->[2]->{'total'},
      swap_used => $vals->[2]->{'used'},
      swap_free => $vals->[2]->{'free'},
    );
  }
  return ( );
}

sub log_sizes
{
  my %files = map { $_ => '' } 
                split(/\0/, run('find /var/log -type f -print0 2>/dev/null'));

  my %active = ( );
  my @active = ( );
  my @older = ( );
  foreach my $act (grep(!/\d(?:\.gz)?$/, keys(%files))) 
  {
    if (defined($files{$act.'.1'}))
    {
      push @active, $act;
      push @older, $act.'.1';
      push @older, $act.'.2' if (defined($files{$act.'.2'}));
    }
    elsif (defined($files{$act.'.1.gz'}))
    {
      push @active, $act;
      push @older, $act.'.1.gz';
      push @older, $act.'.2.gz' if (defined($files{$act.'.2.gz'}));
    }
  }
  my %file_info = filestats(@active, @older);
  my %older_sizes = gz_filesizes(@older);

  my %return = ( );
  foreach my $file (@active)
  {
    $return{"log_size_$file"} = $file_info{$file}->{'size'};    
    $return{"log_trend_$file"} = log_trend($file, \%file_info, \%older_sizes);
  }

  return %return;
}

# This function attempts to estimate how big a given log-file is
# going to be, based on it's age, current size and the time between
# log rotations.  It then returns how large this expected age is
# relative to the average for the last two rotated versions of this
# log file; a value of 1 would mean "the same size", 2.0 is "twice
# as big" and 0.5 is "half the size".
#
# This only gives meaningful results if logs are rotated on a fixed
# schedule and you expect logs to stay roughly the same size.
#
sub log_trend
{
  my ($file, $file_info, $older_sizes) = @_;

  my ($o1, $o2) = ($file.'.1', $file.'.2');
  ($o1, $o2) = ($file.'.1.gz', $file.'.2.gz') 
    if (defined $file_info->{$file.'.1.gz'});

  return 1.0 unless (defined $file_info->{$o2});

  my $s0 = $file_info->{$file}->{'size'};
  my $s1 = $older_sizes->{$o1};
  my $s2 = $older_sizes->{$o2};

  return 1.0 unless ($s0 && $s1 && $s2);

  my $t0 = time();
  my $t1 = $file_info->{$o1}->{'mtime'};
  my $t2 = $file_info->{$o2}->{'mtime'};

  my $elapsed = ($t0 - $t1) / ($t1 - $t2);
  return 1.0 unless (($elapsed > 0.125) && ($s0 > 1024000));

  my $trend1 = $s1 / ($s0 / $elapsed);
  my $trend2 = $s2 / ($s0 / $elapsed);
  return sprintf("%2.3f", ($trend1 + $trend2)/2);
}

sub network_bytes
{
  # FIXME: Track how many bytes in/out we've seen on ethN
  return ( );
}

sub mail_queues
{
  # FIXME: Does this always work?
  my $mq = run('mailq 2>&1 |grep Total');
  $mq =~ s/[^\d]+//g;
  return ("mailq" => ($mq || 0));
}

sub uptime
{
  my $up = run('uptime');

  $up =~ s/,/./g;
  my ($l1, $l5, $l15) = ($1, $2, $3)
    if ($up =~ /(\d+\.\d+)\.?\s+(\d+\.\d+)\.?\s+(\d+\.\d+)\s*$/);

  return (
    load_average_one => $l1,
    load_average_five => $l5,
    load_average_fifteen => $l15,
  );
}


##[ Helper routines ]##########################################################

sub gz_filesizes
{
  my @gz_files = grep(/\.gz$/, @_);
  my @reg_files = grep(!/\.gz$/, @_);

  my %gz_sizes = filesizes(@reg_files);
  if (@gz_files)
  {
    if (open(GZ, "gzip -l ".join(' ', map { s/\'/_/g; "'$_'" } @gz_files)."|"))
    {
      while (<GZ>)
      {
        chomp;
        if (/^\s*(\d+)\s*(\d+)\s*(\S+\%)\s+(.*)\s*$/)
        {
          my ($file, $size) = ($4, $2);
          $gz_sizes{$file.'.gz'} = $size unless ($file =~ /^\(Totals\)/i);
        }
      }
      close(GZ);
    }
  }
  return %gz_sizes;
}

sub filesizes
{
  return (map {
    my @stat = stat($_);
    $_ => $stat[7];
  } @_);
}

sub filestats
{
  return (map {
    my @stat = stat($_);
    $_ => {
      'uid' => $stat[4],
      'gid' => $stat[5],
      'size' => $stat[7],
      'atime' => $stat[8],
      'mtime' => $stat[9]
    };
  } @_);
}

sub one_line
{
  return join(' ', map { s/\r?\n/ /g; $_ } @_);
}

sub clean_spaces 
{
  return map { s/[ \t]+/ /g; s/^\s+//; s/\s+$//; $_ } @_;
}

sub run
{
  my ($cmd) = @_;
  open(CMD, "$cmd|") || return "FAILED: $!";
  my $cmd = join('', <CMD>);
  close(CMD);
  chomp $cmd;
  return $cmd; 
}

# This is my magic routine which converts the tabular "human readable"
# output of common unix commands into a list of hashes of keys => values.
#
sub hash_magic
{
  my ($fields, @data) = split(/\n/, shift);
  $fields .= ' ';
  my @fields = ($fields =~ m/(\s*?\S+\s+)(?=\S|$)/g);
  my @fn = map { my $b = $_; $b =~ s/\s*$//; $b; } @fields;

  my @return = ( );
  foreach my $l (@data)
  {
    my $e = { };

    my $i = 0;
    my $first = substr($l, 0, length($fields[0]), "");
    if ($first !~ /\s\s+\S/)
    {
      $first =~ s/\s+$//;
      $e->{$fn[0]} = $first;
      $i++; 
    }
    else
    {
      $l = $first.$l;
    }

    $l =~ s/^\s+//;
    my @cols = split(/\s+/, $l, @fields-$i);
    for (my $c = 0; $i < @fields; $c++, $i++)
    {
      $e->{$fn[$i]} = $cols[$c];
    }
    push @return, $e;
  }
  return \@return;
}

# vi:ts=2 expandtab