#!/usr/bin/perl -w

# mailq check module

# Version: $Revision: 0.14 $
# Author: Benjamin Oshrin
# Date: $Date: 2004/09/16 14:54:34 $
#
# Copyright (c) 2002 - 2003
# The Trustees of Columbia University in the City of New York
# Academic Information Systems
# 
# License restrictions apply, see doc/license.html for details.

use strict;
use FindBin;
use lib "$FindBin::Bin/../common";
use Survivor::Check;

my %argformat = (# Directory holding outgoing queue
		 "queuedir" =>
		 "optional directory default(/var/spool/mqueue)",
		 # Minimum age of file in seconds to be counted
		 "age" => "optional number between(0,inf) default(0)",
		 # Total queue size to generate warning
		 "warn" => "optional number between(0,inf) default(0)",
		 # Total queue size to generate problem
		 "prob" => "optional number between(0,inf) default(0)",
		 # Undeliverable messages to generate warning
		 "deadwarn" => "optional number between(0,inf) default(1)",
		 # Undeliverable messages per host to generate problem
		 "deadprob" => "optional number between(0,inf) default(0)",
		 # Messages per host to generate warning
		 "hostwarn" => "optional number between(0,inf) default(0)",
		 # Messages per host to generate problem
		 "hostprob" => "optional number between(0,inf) default(0)",
		 # Messages per address to generate warning
		 "userwarn" => "optional number between(0,inf) default(0)",
		 # Messages per address to generate problem
		 "userprob" => "optional number between(0,inf) default(0)");

sub MailqValidate {
    my ($self) = @_;

    return(MODEXEC_OK, 0, "Mailq OK");
}

sub MailqCheck {
    my ($self, $host) = @_;

    # Retrieve arguments and set default values as needed
    my $qdir = $self->Arg("queuedir");
    my $age = $self->Arg("age");
    my $warn = $self->Arg("warn");
    my $prob = $self->Arg("prob");
    my $deadwarn = $self->Arg("deadwarn");
    my $deadprob = $self->Arg("deadprob");
    my $hostwarn = $self->Arg("hostwarn");
    my $hostprob = $self->Arg("hostprob");
    my $userwarn = $self->Arg("userwarn");
    my $userprob = $self->Arg("userprob");

    # While GetOpt will validate the arguments provided, we need to
    # check that at least one useful warn or prob was provided.  We can add
    # up the totals since the parser will not permit negative values
    # according to our specification.

    # Since mailq is a remote module and will generally not be run
    # threaded, it's OK to do this check within the Check subroutine,
    # rather than before $sc->Exec.

    if($warn + $prob + $deadwarn + $deadprob + $hostwarn + $hostprob
       + $userwarn + $userprob == 0) {
	return(MODEXEC_MISCONFIG, 0, "No useful arguments provided");
    }

    # Open the directory and examine the queuefiles
    
    my $total = 0;
    my(@unread,%addresses,%servers);

    if(opendir(MAILQ, $qdir)) {
	my @allfs = readdir(MAILQ);
	closedir(MAILQ);
	
	my @allqfs = grep(/^qf.*/, @allfs);
	my @deadqfs = grep(/^Q.*/, @allfs);
	
	# Stat each file, and discard any that are too new

	my @qfs;
	
	if($age > 0) {
	    foreach my $qf (@allqfs) {
		my $qfile = $qdir.'/'.$qf;
		
		my $mtime = (stat($qfile))[9];
		
		if(defined $mtime) {
		    if((time() - $mtime) >= ($age * 60)) {
			push(@qfs, $qfile);
		    }
		}
		# else stat failed, which usually means the file was
		# processed before we got to look at it.
	    }
	} else {
	    push(@qfs, @allqfs);
	}
	
	$total = scalar(@qfs);
	
	if($userwarn > 0 || $userprob > 0 || $hostwarn > 0 || $hostprob > 0) {
	    # Only examine the files if requested to do so
	    
	    foreach my $qf (@qfs) {
		my $qfile = $qdir.'/'.$qf;
		
		if(open(QF, $qfile)) {
		    # We only count a server the first time we see it
		    # in a message, otherwise we get inflated message counts
		    my(%serversseen);
		    undef(%serversseen);
		    
		    while(<QF>) {
			chomp;
			
			# There may be multiple R lines in a given file,
			# so we loop through the entire thing.  We process
			# both user and host information regardless of what
			# was requested, since it isn't much more expensive
			# to do both if we're doing either.
			
			if(/^R/) {
			    my($command, $addr) = split(/:/, $_, 2);
			    
			    # Toss <> and .procmail from the address,
			    # then lowercase everything.  (Hostnames
			    # are case insensitive, usernames should
			    # be.)
			    
			    $addr =~ s/^.*<//;
			    $addr =~ s/>.*$//;
			    $addr =~ s/\.procmail$//;
			    $addr = lc $addr;
			    
			    $addresses{$addr}++;

			    # Toss everything through the rightmost @
			    # for servers.
			    
			    $addr =~ s/.*@//;

			    if(!$serversseen{$addr})
			    {
				$servers{$addr}++;
				$serversseen{$addr} = 1;
			    }
			}
		    }
		    
		    close(QF);
		} else {
		    # It could be that the file was processed and removed.
		    # If it still exists, however, complain.
		    
		    if(-e $qfile) {
			push(@unread, $qfile);
		    }
		}
	    }
	    
	    # If @unread is about equal to $total, then we likely have a
	    # permission error
	
	    if(scalar(@unread) == $total && $total > 0) {
		return(MODEXEC_MISCONFIG, 0,
		       "Unable to read queue files (permission denied)");
	    }
	}
	
	# Now process each bit of requested data
	
	# Total queue files
	if($prob > 0 && $total >= $prob) {
	    $self->AccResultAdd($host, MODEXEC_PROBLEM,
				"$total messages queued");
	} elsif ($warn > 0 && $total >= $warn) {
	    $self->AccResultAdd($host, MODEXEC_WARNING,
				"$total messages queued");
	} else {
	    $self->AccResultAdd($host, MODEXEC_OK,
				"$total messages queued");
	}

	# By undeliverable
	if($deadprob > 0 || $deadwarn > 0) {
	    my $dcount = scalar(@deadqfs);
	    
	    if($deadprob > 0 && $dcount >= $deadprob) {
		$self->AccResultAdd($host, MODEXEC_PROBLEM,
				    "$dcount undeliverable messages queued");
	    } elsif ($deadwarn > 0 && $dcount >= $deadwarn) {
		$self->AccResultAdd($host, MODEXEC_WARNING,
				    "$dcount undeliverable messages queued");
	    } else {
		$self->AccResultAdd($host, MODEXEC_OK,
				    "$dcount undeliverable messages queued");
	    }
	}
	
	# By address
	if($userprob > 0 || $userwarn > 0) {
	    foreach my $key (sort keys %addresses) {
		if($userprob > 0 && $addresses{$key} > $userprob) {
		    $self->AccResultAdd($host, MODEXEC_PROBLEM,
				  "$key has $addresses{$key} messages queued");
		} elsif($userwarn > 0 && $addresses{$key} > $userwarn) {
		    $self->AccResultAdd($host, MODEXEC_WARNING,
				  "$key has $addresses{$key} messages queued");
		}
	    }	
	}
	
	# By server
	if($hostprob > 0 || $hostwarn > 0) {
	    foreach my $key (sort keys %servers) {
		if($hostprob > 0 && $servers{$key} > $hostprob) {
		    $self->AccResultAdd($host, MODEXEC_PROBLEM,
				    "$key has $servers{$key} messages queued");
		} elsif($hostwarn > 0 && $servers{$key} > $hostwarn) {
		    $self->AccResultAdd($host, MODEXEC_WARNING,
				    "$key has $servers{$key} messages queued");
		}
	    }
	}
	
	# Produce the result
	return($self->AccResultGet($host, $total));
    } else {
	return(MODEXEC_MISCONFIG, 0, "Unable to open $qdir");
    }
}

my $sc = new Survivor::Check();

$sc->GetOpt(\%argformat, \&MailqValidate);

my $r = $sc->Exec(\&MailqCheck);

exit($r);
