#!/usr/bin/perl -w

require "sys/syscall.ph";
use Time::HiRes qw( time sleep );
use IO::File;

$DEBUG = 0;

$interval = 30;

# Note: order must match order in the rrd
@tempsensors = (
   '/sys/class/i2c-adapter/i2c-0/0-002d/temp1_input', # vrm2
   '/sys/class/i2c-adapter/i2c-0/0-002d/temp2_input', # cpu1
   '/sys/class/i2c-adapter/i2c-0/0-002d/temp3_input', # cpu2
   '/sys/devices/platform/w83627hf.3072/temp1_input', # vrm1
   '/sys/devices/platform/w83627hf.3072/temp2_input', # agp
   '/sys/devices/platform/w83627hf.3072/temp3_input', # ddr
);

$dotemp = 0;

@fstypes = qw( ext2 ext3 ext4 reiserfs );

sub openDB {
   if ($DEBUG) {
      open(DB, "| rrdtool -");
   } else {
      open(DB, "| rrdtool - > /dev/null");
   }

   # Perl magic to make handle non-buffering
   select((select(DB), $|=1)[0]);
}

sub reopenDB {
   close(DB);
   openDB;
}

openDB;


############### From http://davesource.com/Solutions/20080924.Perl-Non-blocking-Read-On-Pipes-Or-Files.html

# An non-blocking filehandle read that returns an array of lines read
# Returns:  ($eof,@lines)
my %nonblockGetLines_last;
sub nonblockGetLines {
	my ($fh,$timeout) = @_;

	$timeout = 0 unless defined $timeout;
	my $rfd = '';
	$nonblockGetLines_last{$fh} = ''
		unless defined $nonblockGetLines_last{$fh};

	vec($rfd,fileno($fh),1) = 1;
	return unless select($rfd, undef, undef, $timeout)>=0;
	# I'm not sure the following is necessary?
	return unless vec($rfd,fileno($fh),1);
	my $buf = '';
	my $n = sysread($fh,$buf,1024*1024);
	# If we're done, make sure to send the last unfinished line
	return (1,$nonblockGetLines_last{$fh}) unless $n;
	# Prepend the last unfinished line
	$buf = $nonblockGetLines_last{$fh}.$buf;
	# And save any newly unfinished lines
	$nonblockGetLines_last{$fh} =
		(substr($buf,-1) !~ /[\r\n]/ && $buf =~ s/([^\r\n]*)$//) ? $1 : '';
	$buf ? (0,split(/\n/,$buf)) : (0);
}

############### End from http://davesource.com/Solutions/20080924.Perl-Non-blocking-Read-On-Pipes-Or-Files.html


$apache = new IO::File;
open($apache, "tail -n 0 -F /var/log/apache2/access_log |");


# This will result in an initial value out of range, & will be ignored
$idle=0;

$t = time();

sub printtoDB {
   if ($DEBUG) {
      print @_;
      print DB @_;
   } else {
      print DB @_;
   }
}

# Allow runtime switching of $DEBUG

sub toggleDEBUG {
   $DEBUG = !$DEBUG;
   print "\$DEBUG is now $DEBUG\n";
   reopenDB;
}

$SIG{USR1} = \&toggleDEBUG;

# Pull in wes's password from a file

open(WESPASS, "< /var/www/lib/wespass");
$wespass = <WESPASS>;
chomp($wespass);
close(WESPASS);


while (1) {


   # Uptime & CPU Utilization

   $oldidle = $idle;
   open(UPTIME, "< /proc/uptime");
   ($a, $idle) = split /\s+/, <UPTIME>;
   $b = 100 - (($idle - $oldidle) * (100 / $interval));
   printtoDB "update cpuutil.rrd N:$b\n";
   printtoDB "update uptime.rrd N:$a\n";
   close(UPTIME);


   # Apache hits

   $hits=0;
   $localhits=0;
   # Name "main::eof" used only once: possible typo at ./datafeed.pl line 130.
   # Yea, I don't want it.  How do I throw it away without the warning?
   ($eof,@lines) = nonblockGetLines($apache);
   for (@lines) {
      $hits++;
      if ( /^[^ ]* (chkno\.net |127\.0\.0\.1 |24\.20\.242\.11 |192\.168\.1\.)/ ) {
         $localhits++;
      }
   }
   printtoDB "update apache.rrd N:$hits:$localhits\n";


   # #chat activity

   $chatsdir = "/home/chkno/irclogs/chkno";
   $chatcount = 0;
   opendir(CHATS, $chatsdir);
   for $file (readdir(CHATS)) {
      $chatcount += (stat $chatsdir . "/" . $file)[7];
   }
   printtoDB "update silcchat.rrd N:$chatcount\n";


   # Load average & Process count

   open(LOADAVG, "< /proc/loadavg");
   <LOADAVG> =~ /^([\d.]+)\s+[\d.]+\s+[\d.]+\s+\d+\/(\d+)/;
   printtoDB "update loadavg.rrd N:$1\n";
   printtoDB "update processes.rrd N:$2\n";
   close(LOADAVG);


   # Inet traffic

   open (INET, "< /proc/net/dev");
   # Eat description lines
   $_ = <INET>;
   $_ = <INET>;
   while (<INET>) {
      if (/^\s*(\w+):\s*(\d+)\s+(\d+\s+){8}(\d+\s+){7}$/) {
         printtoDB "update $1.rrd N:$2:$3\n";
      } else {
         die "/proc/net/dev format changed?";
      }
   }
   close (INET);


   # TCP stats

   open (TCP, "< /proc/net/tcp");
   # Eat description line
   $_ = <TCP>;
   $tx_queue = $rx_queue = $numconnections = 0;
   while (<TCP>) {
      if (/^\s*\d+:\s+([:[:xdigit:]]+\s+){2}([:[:xdigit:]]+)\s+([[:xdigit:]]+):([[:xdigit:]]+)/) {
	 ++$numconnections if (hex($2) == 1); # 1 means established
	 $tx_queue += hex($3);  $rx_queue += hex($4);
      } else {
         die "/proc/net/tcp format changed?";
      }
   }
   close (TCP);
   printtoDB "update tcp.rrd N:$numconnections:$tx_queue:$rx_queue\n";


   # Context switches and Forks

   open(STAT, "< /proc/stat");
   
   while(<STAT>) {
      if(/^ctxt\s+(\d+)/) {
         printtoDB "update context.rrd N:$1\n";
         last;
      }
   }
   while(<STAT>) {
      if(/^processes\s+(\d+)/) {
         printtoDB "update forks.rrd N:$1\n";
         last;
      }
   }
   close(STAT);


   # Interrupts

   open(INTR, "< /proc/interrupts");
   $interrupts = 0;
   while(<INTR>) {
      next if (/timer/);
      if (/^\s*\d+:\s*(\d+)\s+(\d+)/) { $interrupts += $1 + $2; }
   }
   close(INTR);
   printtoDB "update intr.rrd N:$interrupts\n";


   # Disk I/O

   open(DISKIO, "< /proc/diskstats");
   while (<DISKIO>) {
      if (/^\s+\d+\s+\d+\s+(\S+)\s+\d+\s+\d+\s+(\d+)\s+(\d+)\s+\d+\s+\d+\s+(\d+)\s+(\d+)\s+\d+\s+\d+\s+(\d+)\s*$/) {
         next if ($1 =~ /ram/);
         printtoDB "update $1.rrd N:$2:$3:$4:$5:$6\n";
      }
   }
   close(DISKIO);


   # Spam

   open(SPAM, "< /var/spool/dspam/data/local/chkno/chkno.stats");
   $spam = <SPAM>;
   if ($spam) {
      $spam =~ s/,/:/g;
      printtoDB "update spam.rrd N:$spam";
   }
   close(SPAM);


   # Memory stats

   %memstats = ();
   open(MEM, "< /proc/meminfo");
   while(<MEM>) {
      if (/^(.+):\s+(\d+)( kB)?$/) {
         $memstats{$1} = $2;
      } else {
         die "/proc/meminfo format changed: cannot parse \"$_\"";
      }
   }
   close(MEM);
   printtoDB "update mem.rrd N"
      . ':' . $memstats{'MemTotal'}
      . ':' . $memstats{'MemFree'}
      . ':' . $memstats{'Buffers'}
      . ':' . $memstats{'Cached'}
      . ':' . $memstats{'SwapCached'}
      . ':' . $memstats{'Active'}
      . ':' . $memstats{'Inactive'}
      . ':' . $memstats{'HighTotal'}
      . ':' . $memstats{'HighFree'}
      . ':' . $memstats{'LowTotal'}
      . ':' . $memstats{'LowFree'}
      . ':' . $memstats{'SwapTotal'}
      . ':' . $memstats{'SwapFree'}
      . ':' . $memstats{'Dirty'}
      . ':' . $memstats{'Writeback'}
      . ':' . $memstats{'Mapped'}
      . ':' . $memstats{'Slab'}
      . ':' . $memstats{'CommitLimit'}
      . ':' . $memstats{'Committed_AS'}
      . ':' . $memstats{'PageTables'}
      . ':' . $memstats{'VmallocTotal'}
      . ':' . $memstats{'VmallocUsed'}
      . ':' . $memstats{'VmallocChunk'} . "\n";


   # VM stats

   %vmstats = ();
   open(VM, "< /proc/vmstat");
   while(<VM>) {
      if (/^(\S+)\s+(\d+)$/) {
         $vmstats{$1} = $2;
      } else {
         die "/proc/vmstat format changed";
      }
   }
   close(VM);
   printtoDB "update vm.rrd N"
     . ':' . $vmstats{'nr_dirty'}
     . ':' . $vmstats{'nr_writeback'}
     . ':' . $vmstats{'nr_unstable'}
     . ':' . $vmstats{'nr_page_table_pages'}
     . ':' . $vmstats{'nr_mapped'}
     . ':' . 'U' # used to be nr_slab
     . ':' . $vmstats{'pgpgin'}
     . ':' . $vmstats{'pgpgout'}
     . ':' . $vmstats{'pswpin'}
     . ':' . $vmstats{'pswpout'}
     . ':' . $vmstats{'pgalloc_normal'}
     . ':' . $vmstats{'pgalloc_dma'}
     . ':' . $vmstats{'pgfree'}
     . ':' . $vmstats{'pgactivate'}
     . ':' . $vmstats{'pgdeactivate'}
     . ':' . $vmstats{'pgfault'}
     . ':' . $vmstats{'pgmajfault'}
     . ':' . $vmstats{'pgrefill_normal'}
     . ':' . $vmstats{'pgrefill_dma'}
     . ':' . 'U' # used to be pgsteal_normal
     . ':' . 'U' # used to be pgsteal_dma
     . ':' . $vmstats{'pgscan_kswapd_normal'}
     . ':' . $vmstats{'pgscan_kswapd_dma'}
     . ':' . $vmstats{'pgscan_direct_normal'}
     . ':' . $vmstats{'pgscan_direct_dma'}
     . ':' . $vmstats{'pginodesteal'}
     . ':' . $vmstats{'slabs_scanned'}
     . ':' . 'U' # used to be kswapd_steal
     . ':' . $vmstats{'kswapd_inodesteal'}
     . ':' . $vmstats{'pageoutrun'}
     . ':' . $vmstats{'allocstall'}
     . ':' . $vmstats{'pgrotated'}
     . ':' . $vmstats{'nr_bounce'} . "\n";


   # Disk space

   %used  = ();
   %avail = ();
   open(MOUNTS, "< /proc/mounts");
   while (<MOUNTS>) {
      if(/(\S+)\s+(\S+)\s+(\S+)/) {
         $device = $1;
         $path = $2;
         $type = $3;
         if (not exists $used{$device}) {
            foreach (@fstypes) {
               if ($type eq $_) {
	          my ($files, $ffree);
                  $fmt = "\0" x 512;
                  $res = syscall (&main::SYS_statfs, $path, $fmt);
	          die if ($res == -1);
                  ($type, $bsize, $blocks, $bfree, $bavail, $files, $ffree)
                     = unpack "L7", $fmt;
                  $used{$device}  = $bsize * ($blocks - $bfree);
                  $avail{$device} = $bsize * $bavail;
               }
            }
         }
      }
   }
   close(MOUNTS);
   $totalused = $totalavail = 0;
   foreach $dev (keys %used) {
      $totalused  += $used{$dev};
      $totalavail += $avail{$dev};
   }
   printtoDB "update diskspace.rrd N:$totalused:$totalavail\n";


   # Wes' Car Collection

   open(WESCARS, "< /var/www/chkno.net/htdocs/wes/$wespass/data");
   $numcars = <WESCARS>;
   close(WESCARS);
   printtoDB "update wescars.rrd N:$numcars\n";


   # Pan download queue

   $taskcount = 0;
   if ( -r "/home/chkno/.pan2/tasks.nzb") {
      open(PAN, "< /home/chkno/.pan2/tasks.nzb");
      while (<PAN>) {
         $taskcount++ if (/<file/);
      }
      close(PAN);
      printtoDB "update pantasks.rrd N:$taskcount\n";
   }



   # Count exim/dspam processes

   my $eximcount = 0;
   my $dspamcount = 0;
   opendir(PROC, "/proc") or die "opendir: $!";
   while ($d = readdir(PROC)) {
      if ($d =~ /^[0-9]+$/) {
         if (open(CMDLINE, "< /proc/$d/cmdline")) {
            if (read(CMDLINE, $cmd, 15)) {
               $eximcount ++ if $cmd =~ /^\/usr\/sbin\/exim\0/;
               $dspamcount ++ if $cmd =~ /^\/usr\/bin\/dspam\0/;
            }
            # Perl WTF: perl's close() can return an error even
            # though the underlying close() syscall returned
            # success.  Files in /proc are a little different
            # that normal files in that when the process dies
            # those files go away immediately even if there are
            # open file handles on them.  Any attempt to read()
            # from the filehandle yields ESRCH (No such process).
            # But you can of course still close() it.  With the
            # close() syscall, at least.  Perl's close() on one of
            # these filehandles signals an error, even though the
            # underlying close() was called and returned success
            # (but only if you have read() from it.  If you just
            # open() it and close() it, no perl error).
            #
            # So, in this case, the file was successfully opened,
            # but the read failed because the process went away.
            # We still need to close the filehandle, but perl will
            # errorenously signal an error on this close.  So we
            # intentionally don't check for a close() errors here.
            close(CMDLINE); } } }
   closedir(PROC) or die "closedir: $!";
   printtoDB "update eximdspam.rrd N:$eximcount:$dspamcount\n";



   # Temperatures

   if ( $dotemp ) {

      @a = ();
      foreach (@tempsensors) {
         open(TEMP, "< $_");
         push (@a, <TEMP> / 1000);
         close (TEMP);
      }
      $temps = join(':', @a);
      printtoDB "update temp.rrd N:$temps\n";
      printtoDB "update temp2.rrd N:$temps\n";
   }


   # Sleep

   $t += $interval;
   $sleepfor = $t - time();
   if ($sleepfor < 0) {
      # We were held from running for a long time
      # Do a dance to avoid calling sleep with a negative argument
      if ($DEBUG) {
         print "Overslept!!  \$sleepfor was $sleepfor\n";
      }
      $t = time() + $interval;
      $sleepfor = $interval;
      $oldidle=0;
   }
   if ($DEBUG) {
      print "sleeping for $sleepfor seconds\n";
   }
   sleep $sleepfor;

   
}
close (DB);