#!/usr/bin/perl

=head1 NAME

loadcheck

=head1 DESCRIPTION

Only takes email transactions if the system load is at or below a
specified level.  

If this is running on a system that provides /kern/loadavg or 
/proc/loadavg it will be used instead of the 'uptime' command.

Once a load value is determined, it is cached for a period of time.
See the cache_time below.

Since fork/exec is expensive in perl you'll want to use cache_time to avoid increasing your load on every connection by checking system load.

=head1 CONFIG

max_load

  This is the 1 minute system load where we won't take transactions
if our load is higher than this value.  (Default: 7)

cache_time

  A recently determined load value will be cached and used for the
assigned number of seconds.  (Default: 10)

uptime

  The path to the command 'uptime' if different than the default.  
(Default: /usr/bin/uptime)

Example:

loadcheck cache_time 30

loadcheck max_load 7 uptime /usr/bin/uptime

=head1 SEE ALSO

Original version: http://www.nntp.perl.org/group/perl.qpsmtpd/2006/01/msg4422.html

Variant with caching: http://www.nntp.perl.org/group/perl.qpsmtpd/2006/03/msg4710.html

Steve Kemp's announcement of an alternate load limiter: http://www.nntp.perl.org/group/perl.qpsmtpd/2008/03/msg7814.html

=head1 AUTHOR

Written by Peter Eisch <peter@boku.net>.

=cut

my $VERSION = 0.02;

sub register {
    my ($self, $qp, @args) = @_;

    %{$self->{_args}} = @args;

    $self->{_args}->{max_load} = 7
      if (!defined $self->{_args}->{max_load});

    $self->{_args}->{uptime} = '/usr/bin/uptime'
      if (!defined $self->{_args}->{uptime});

    $self->{_args}->{cache_time} = 10
      if (!defined $self->{_args}->{cache_time});

    $self->{_load} = -1;
    $self->{_time} = 0;

    $self->register_hook("connect", "loadcheck");
}

sub loadcheck {
    my ($self, $transaction) = @_;

    if (time() > ($self->{_time} + $self->{_args}->{cache_time})) {

        # cached value expired

        if (-r '/kern/loadavg') {    # *BSD
                                     # contains fix-point scaling value
            open(LD, "</kern/loadavg");
            my $res = <LD>;
            close LD;
            my @vals = split(/ /, $res);
            $self->{_load} = ($val[0] / $val[3]);
            $self->{_time} = time();
            $self->log(LOGDEBUG, "/kern/loadavg reported: $self->{_load}");
        }
        elsif (-r '/proc/loadavg') {    # *inux
                                        # contains decimal value
                                        # contains fix-point scaling value
            open(LD, "</proc/loadavg");
            my $res = <LD>;
            close LD;
            $self->{_load} = (split(/ /, $res))[0];
            $self->{_time} = time();
            $self->log(LOGDEBUG, "/proc/loadavg reported: $self->{_load}");
        }
        else {
           # the various formats returned:
           #10:33AM  up  2:06, 1 user, load averages: 6.55, 3.76, 2.48
           # 12:29am  2 users,  load average: 0.05, 0.05, 0.06
           # 12:30am  up 5 days, 12:43,  1 user,  load average: 0.00, 0.00, 0.00

            my $res = `$self->{_args}->{uptime}`;
            if ($res =~ /aver\S+: (\d+\.\d+)/) {
                $self->{_load} = $1;
                $self->{_time} = time();
                $self->log(LOGDEBUG,
                           "$self->{_args}->{uptime} reported: $self->{_load}");
            }
        }
    }

    if ($self->{_load} > $self->{_args}->{max_load}) {
        $self->log(LOGERROR, "local load too high: $self->{_load}");
        return DENYSOFT;
    }

    return (DECLINED, "continuing with load: $self->{_load}");
}