#!/usr/bin/perl -w
#
# df_swap: monitor disk, swap and RAM utilization and send an alert if any set
#          threshold is exceeded.
#
# AUTHOR : Scott Francis <darkuncle(at)darkuncle(dot)net>
# LICENSE: This program is distributed under the 2-clause BSD license:
#
# Copyright (c) 2005 Scott Francis
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY ``AS IS'' AND ANY EXPRESS OR IMPLIED
# WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
# EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
# PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
# OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
# OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
# ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
#
# DEFINITIONS
#  - capacity: when we refer to percent capacity, we're referring to the
#    amount that is in use, not the amount that is free. 90% capacity on a
#    100MB filesystem means 90MB in use, 10MB free.
#    $capacity = ( $used / $total )
#
# PREREQUISITES
#  - SMTP support (outbound pages won't go anywhere otherwise)
#  - 2 common Perl modules: FileHandle and POSIX
#  - Perl 5.005 or greater
#  - a reasonably modern UNIX-like OS (see SCO rant below) that includes
#    system utilities to report on swap, RAM and disk utilization
#  - cron (until daemon mode is implemented, this script should be called from
#    someone's (preferably not root's) crontab as often as desired)
#
# TODO
#  - identical/similar code into functions/subs to reduce duplication
#  - function to read in a global exceptions list (/etc/df_swap ?)
#  - daemon mode? multi-thread support?
#  - cygwin support? (if I can locate the appropriate Windows CLI utilities,
#    assuming such things even exist)

require 5.005;
use strict;
use FileHandle;
use POSIX;
use constant DEBUG => 1; # set to 1 to turn on debug output to STDERR

sub debug {
  print STDERR "@_\n" if DEBUG;
}

my @msgs = ();
my ($last_warning, $current_time, $sendmail, $recipient, $top_cmd, $swap_cmd, $df_cmd, $size, $free) = '';
my ($osname, $hostname, $release, $version, $arch) = uname();

##############################################################################
# CONFIGURABLE VARIABLES: adjust alert thresholds, notification emails, etc. #
##############################################################################
my $my_name        = 'df_swap@' . $hostname;      # 'From:' field in alerts
my $reply_to       = 'page-admin@example.com';    # alert replies go elsewhere
my $df_min_percent = 95;                          # alert if > 95% full
my $df_min_kb      = 102400;                      # alert if < 100MB free
my $swap_min_percent = 75;                        # alert if > 75% swap in use
my $swap_min_decimal = ($swap_min_percent / 100); # 0.75 instead of 75%
my $swap_min_kb   = 51200;                        # alert if < 50MB free

if (DEBUG) { $recipient = 'sysadmin@example.com'; }
else { $recipient = 'page-admin@example.com, admin@example.com'; }
##############################
# END CONFIGURABLE VARIABLES #
##############################

if ($osname eq 'SunOS') {
  $sendmail = '/usr/lib/sendmail';
  $top_cmd = '/usr/local/bin/top -d1';
  $df_cmd = '/bin/df -k';
}
elsif ($osname eq 'Linux') {
  $sendmail = '/usr/sbin/sendmail';
  $df_cmd = '/bin/df -k';
}
elsif ($osname eq 'OpenBSD') {
  $sendmail = '/usr/sbin/sendmail';
  $swap_cmd = '/sbin/swapctl -l';
  $df_cmd = '/bin/df -k';
}
elsif ($osname eq 'FreeBSD') {
  $sendmail = '/usr/sbin/sendmail';
  $swap_cmd = '/usr/sbin/swapinfo';
  $df_cmd = '/bin/df -k';
}
elsif ($osname eq 'SCO_SV') {
  $sendmail = '';
  $swap_cmd = '/etc/swap -l';
  $df_cmd = '/bin/df -kP';
}

# -- BEGIN RANT --
# looking forward to removing support for SCO in the near future. What a sorry
# excuse for an OS - seriously, who ships a UNIX-like OS without top(1)?
# Welcome to 1995, folks. And don't even get me started about the convoluted
# mess that is /etc, the missing tools, the Windows-like number of reboots and
# kernel rebuilds involved during system configuration (having to relink your
# kernel and reboot in order to _change_an_IP_address_ is beyond archaic -
# even Windows has managed to join the modern world in that regard). Their
# decision to duplicate the standard filesystem tree inside
# /opt/K/SCO/Unix/<ver>/ and then symlink there from all the normal places
# only serves to add yet another reason for sysadmins to avoid this heap of
# mouldy debris like the plague. The astonishing level of incompetence by
# their current executive team (the bad PR from attacking Linux will far
# outweigh any possible gains, and it was sheer foolishness to attempt to take
# on IBM right out of the gate) boggles the mind. A sad state of affairs for
# one of the seminal names in UNIX. *sigh* That is all.
#
# (legal disclaimer: the above is my opinion, not that of any employer, past,
# present or future. Free speech, personal opinion and all that. Huzzah.)
# -- END RANT --

else { die "unsupported OS: $osname"; }

debug("osname: $osname\nhostname: $hostname\nrelease: $release\nversion: $version\narch: $arch\n");

&dfscan;
&swapscan;
&notify;
 
##############
# begin subs #
##############

sub dfscan {

  debug("osname (dfscan): $osname");
  my $df = new FileHandle;
  $df->open("$df_cmd |") or die "Can't execute $df_cmd: $!\n";

  while ( $_ = $df->getline() ) {
    chomp;
    s/\s+/ /g;
    my($fs, $size, $used, $free, $capacity, $mounted) = split(/\s+/, $_, 6);

    next unless $fs       =~ /^\/dev|^swap/;
    next unless $capacity =~ /\%/;
    next if     $mounted  =~ /^\/cdrom|^\/boot/;

    # we can add exceptions for certain filesystems and/or hosts that always
    # exceed the threshold by a constant amount, but never overflow
    # next if ($hostname eq 'myhost' and $mounted =~ m#/some/nearly/full/fs#);

    debug("fs: $fs\nsize: $size\nused: $used\nfree: $free\ncapacity: $capacity\nmounted: $mounted\n");
    $capacity =~ s/\%//;

    # we don't alert unless both capacity and df_min_kb thresholds are
    # crossed. This ensures we don't alert on e.g. 100MB filesystems with
    # 50MB free (does not cross capacity threshold, so df_min_kb threshold
    # isn't tested - and with only 50MB free, we would normally alert) or on
    # e.g. 500GB filesystems with 50GB free (crosses capacity
    # threshold (90% utilized), but not df_min_kb threshold (50GB free is
    # plenty of free space)).
    #
    # Obviously, df_min_percent and df_min_kb should be tuned to suit your 
    # installation.
    if ( (int($capacity) > $df_min_percent) && ($free < $df_min_kb) ) {
      push(@msgs, "Only $free KB free on $mounted [$fs] ($capacity%)\n");
    }
  }

  $df->close();

} # end &dfscan


sub swapscan {

# if Linux, parse /proc/meminfo
# if FreeBSD, parse swapinfo(8) output
# if OpenBSD, parse swapctl(8) output
# if SunOS, parse top(1) output :)
# if SCO, parse swap(ADM) output

  if ($osname eq 'Linux') {
    debug("osname (swapscan): Linux");
    open(MEMINFO, "/proc/meminfo") or die "Can't open /proc/meminfo: $!\n";
      while (<MEMINFO>) {
        chomp;
        next unless /^Swap/;
        if (/^SwapTotal:\s+(\d+) kB/) { $size = $1; debug("size: $size\n"); }
        if (/^SwapFree:\s+(\d+) kB/) { $free = $1; debug("free: $free\n"); }
      }
    close (MEMINFO);
    my $capacity = (($size - $free) / $size);
    debug("% in use: $capacity\n");
    if ( $capacity > $swap_min_decimal) {
      push(@msgs, "Only $free KB swap free ($capacity in use)\n");
    }
  } # end Linux

  elsif ($osname eq 'OpenBSD') {
    debug("osname (swapscan): OpenBSD");
    my $swapctl = new FileHandle;
    $swapctl->open("$swap_cmd |") or die "Can't execute $swap_cmd: $!\n";
    while ( $_ = $swapctl->getline() ) {
      chomp;
      next unless /^swap_device/;
      my($device, $size, $used, $free, $capacity, $priority) = split(/\s+/, $_, 6);
      debug("size: $size\nused: $used\nfree: $free\ncapacity: $capacity\n");
      $capacity =~ s/\%//;
      if ( (int($capacity) > $swap_min_percent) || ($free < $swap_min_kb) ) {
        push(@msgs, "Only $free KB swap free ($capacity in use)\n");
      }
    }
  } # end OpenBSD

  elsif ($osname eq 'FreeBSD') {
    debug("osname (swapscan): FreeBSD");
    my $swapinfo = new FileHandle;
    $swapinfo->open("$swap_cmd |") or die "Can't execute $swap_cmd: $!\n";
    while ( $_ = $swapinfo->getline() ) {
      chomp;
      next unless /^\/dev/;
      my($device, $size, $used, $free, $capacity, $type) = split(/\s+/, $_, 6);
      debug("size: $size\nused: $used\nfree: $free\ncapacity: $capacity\n");
      $capacity =~ s/\%//;
      if ( (int($capacity) > $swap_min_percent) || ($free < $swap_min_kb) ) {
        push(@msgs, "Only $free KB swap free ($capacity in use)\n");
      }
    }
  } # end FreeBSD

  elsif ($osname eq 'SunOS') {
    debug("osname (swapscan): SunOS");
    my $top = new FileHandle;
    $top->open("$top_cmd |") or die "Can't execute $top_cmd: $!\n";
    while ( $_ = $top->getline() ) {
      chomp;
      next unless /^Mem|^Swap/;
      if (my ($used, $free) = /\b(\d+[KMG]) swap in use.*\b(\d+[KMG]) swap free/) {
        debug("debug: solaris mem/swap: $_");
        my %suffix = (M => 1024, G => 1024 * 1024);
        $used =~ s/([MG])$// and $used *= $suffix{$1};
        $free =~ s/([MG])$// and $free *= $suffix{$1};
        debug("swap in use: $used KB");
        debug("swap free: $free KB");
        my $capacity = ($used / ($free + $used));
        if ($free < $swap_min_kb) {
          push(@msgs, "Only $free KB swap free ($capacity in use)\n");
        }
      }
    }
  } # end SunOS

  elsif ($osname eq 'SCO_SV') {
    debug("osname (swapscan): SCO_SV");
    my $swapinfo = new FileHandle;
    $swapinfo->open("$swap_cmd |") or die "Can't execute $swap_cmd: $!\n";
    while ( $_ = $swapinfo->getline() ) {
      chomp;

      # none of my SCO boxes use anything but /dev/swap for a swapfile. If
      # you are using multiple/different swapfiles, this match will not work
      # and you'll need to come up with something else here.
      next unless /^\/dev\/swap/;

      my($path, $devnum, $swaplo, $size, $free) = split(/\s+/, $_, 5);
      debug("path: $path\nsize: $size\nfree: $free\n");
      my $capacity = ((($size - $free) / $size) * 100);
      my $kfree = ($free / 2); # swap(ADM) returns sizes in 512-byte blocks
      if ( ($capacity > $swap_min_percent) || ($kfree < $swap_min_kb) ) {
        push(@msgs, "Only $kfree KB swap free ($capacity in use)\n");
      }
    }
  } # end SCO

} # end &swapscan

sub notify {

  if ( scalar(@msgs) > 0 ) {
    my $mail = new FileHandle;
    $mail->open("| $sendmail -f$my_name $recipient") or die "Can't open sendmail: $!\n";
    $mail->print("From: $my_name\n");
    $mail->print("To: $recipient\n");
    $mail->print("Subject: df_swap warning on $hostname\n\n");

    foreach (@msgs) {
	$mail->print($_, "\n");
    }

    $mail->close();
  }

} # end &notify