package RRD::Postfix;

=head1 NAME

RRD::Postfix - maintains a rrd file with temperature readings

=head1 SYNOPSIS

    use RRD::Postfix qw(create update);

    RRD::Postfix->create( '/var/local/rrd/temp.rrd', 2 );
    RRD::Postfix->update( '/var/local/rrd/temp.rrd', '/var/log/mail.log' );

=head1 DESCRIPTION

B<RRD::Postfix::create> creates the initial rrd file
B<RRD::Postfix::update> updates an rrd file with information from the
/sys filesystem.

=head1 METHODS

=over 4

=item create

Performs the initial creation of the rrd file. The first argument is
the path to the rrd file.  The second argument is the interval in 
seconds between which you intend to call update.

=item update

Performs the update of the rrd file. The first argument is the path
to the rrd file. The second argument is the name of the log file.

On failure, throws an error. Return value is not used.

=back

=head1 AUTHOR

(c) 2006 by Luke Heberling, E<lt>lukeh@c-ware.comE<gt>.

All rights reserved. All wrongs reversed. This program is
free software. You can redistribute and/or modify it under
the same terms as Perl itself.

=cut

use strict;
use warnings;
use RRDs;
use File::Tail;

use vars qw(@EXPORT_OK @ISA);
@ISA = qw(Exporter);
# we export nothing by default :)
@EXPORT_OK = qw(update create);

my $received = 0;
my $delivered = 0;
my $forwarded = 0;
my $deferred = 0;
my $bounced = 0;
my $rejected = 0;
my $reject_warnings = 0;
my $held = 0;
my $discarded = 0;
my $bytesReceived = 0;
my $bytesSent = 0;

my %msgSizes = ();
my %msgDeferred = ();

my $tail;

sub update() {
  shift;
  my $file = shift;
  my $logfile = shift;

  unless( defined( $tail ) ) {
    $tail = File::Tail->new( name => $logfile,
                                tail => -1,
                                ignore_nonexistant => 1,
                                nowait => 1,
                                maxbuf => 4096,
                                maxinterval => -1,
                                interval => -1,
    );
    $tail->nowait(1);
  }

  for( my $dummy = 0; $dummy < 3; ++$dummy ) {
    while( my $line = $tail->read ) {
      if ( $line =~ /[^:]*postfix\/(\w+)\[\d*\]: ([^:\s]+)/ ) {
        my ($cmd, $qid) = ($1,$2);
        if ( $cmd eq 'cleanup' &&
               $line =~ /\/cleanup\[\d+\]: .*?\b(reject|warning|hold|discard): (?:header|body) .*$/ ) {
          my $rejSubTyp = $1;
          if($rejSubTyp eq "reject") {
              ++$rejected;
          } elsif($rejSubTyp eq "warning") {
              ++$reject_warnings;
          } elsif($rejSubTyp eq "hold") {
              ++$held;
          } elsif($rejSubTyp eq "discard") {
              ++$discarded;
          }
        } elsif($qid eq 'reject') {
          ++$rejected;
        } elsif($qid eq 'reject_warning') {
          ++$reject_warnings;
        } elsif($qid eq 'hold') {
          ++$held;
        } elsif($qid eq 'discard') {
          ++$discarded;
        } elsif($cmd eq 'smtpd') {
          if( $line =~ /\[\d+\]: \w+: client=.+?(?:,|$)/) {
            ++$received;
          } elsif( $line =~ /\[\d+\]: \w+: (reject(?:_warning)?|hold|discard): /) {
            my $rejSubTyp = $1;
            if($rejSubTyp eq 'reject') {
              ++$rejected;
            } elsif($rejSubTyp eq 'reject_warning') {
              ++$reject_warnings;
            } elsif($rejSubTyp eq 'hold') {
              ++$held;
            } elsif($rejSubTyp eq 'discard') {
              ++$discarded;
            }
          }
        } else {
          my $toRmdr;
          if( $line =~ /from=<[^>]*>, size=(\d+)/ ) {
            next if($msgSizes{$qid});
            my $size = $1;
            $msgSizes{$qid} = $size;
            $bytesReceived+=$size;
          } elsif( $line =~ /to=<([^>]*)>, (?:orig_to=<[^>]*>, )?relay=([^,]+), delay=([^,]+), (?:delays=[^,]+, )?(?:dsn=\d+\.\d+\.\d+, )?status=(\S+)(.*)$/ ) {
            my ($addr, $relay, $delay, $status, $toRmdr) = ($1,$2,$3,$4,$5);

            if($status eq 'sent') {
              if($toRmdr =~ /forwarded as /) {
                ++$forwarded;
                next;
              }
              ++$delivered;
              if($msgSizes{$qid}) {
                $bytesSent += $msgSizes{$qid};
              } else {
                print STDERR "No size for $line\n";
              }
            } elsif($status eq 'deferred') {
              ++$deferred unless $msgDeferred{$qid};
              $msgDeferred{$qid}=undef;
            } elsif($status eq 'bounced') {
              ++$bounced;
            } else {
               print STDERR "No match 1 for $line\n";
            }
          } elsif($cmd eq 'pickup' && /: (?:sender|uid)=/) {
              ++$received;
          } else {
             #print STDERR "No match 2 for $line\n";
          }
        }
      }
    }
  }
  
  print STDERR "     Received: $received,
     Delivered: $delivered
     Forwarded: $forwarded
     Deferred: " . (scalar keys %msgDeferred) . "
     Deferrals: $deferred
     Bounced: $bounced
     Rejected: $rejected
     Reject_Warnings: $reject_warnings
     Held: $held
     Discarded: $discarded
     BytesReceived: $bytesReceived
     BytesSent: $bytesSent\n";

  RRDs::update( $file, "N:$received:$delivered:$forwarded:" . scalar keys( %msgDeferred ) .":$deferred:$bounced:$rejected:$reject_warnings:$held:$discarded:$bytesReceived:$bytesSent" );
  my $error = RRDs::error;
  die "Unable to update $file: $error" if $error;
}

sub create() {
  shift;
  my $file = shift;
  my $inc = shift;
  RRDs::create( $file, 
    '--step', $inc,
    'DS:received:DERIVE:660:0:18446744073709551616',
    'DS:delivered:DERIVE:660:0:18446744073709551616',
    'DS:forwarded:DERIVE:660:0:18446744073709551616',
    'DS:deferred:DERIVE:660:0:18446744073709551616',
    'DS:deferrals:DERIVE:660:0:18446744073709551616',
    'DS:bounced:DERIVE:660:0:18446744073709551616',
    'DS:rejected:DERIVE:660:0:18446744073709551616',
    'DS:reject_warnings:DERIVE:660:0:18446744073709551616',
    'DS:held:DERIVE:660:0:18446744073709551616',
    'DS:discarded:DERIVE:660:0:18446744073709551616',
    'DS:bytesReceived:DERIVE:660:0:18446744073709551616',
    'DS:bytesSent:DERIVE:660:0:18446744073709551616',
        
    'RRA:AVERAGE:0.5:1:1800',
    'RRA:AVERAGE:0.5:30:1440',
    'RRA:AVERAGE:0.5:150:2016',
    'RRA:AVERAGE:0.5:450:7440',
    'RRA:AVERAGE:0.5:1800:8760'
  );
  my $error = RRDs::error;
  die "Unable to create $file: $error" if $error;
}

1;
