#! @PATHTOPERL@ -w

# vim:syntax=perl

use strict;
use lib '@LR_PERL5LIBDIR@';
use Lire::Email;
use Lire::Program qw( :msg :dlf );
use Lire::DlfSchema;

my $debug = 0;
sub debug {
    $debug and lr_debug($_[0]);
}

my $schema = eval { Lire::DlfSchema::load_schema( "email" ) };
lr_err( "failed to load email schema: $@" ) if $@;
my $dlf_maker = 
  $schema->make_hashref2asciidlf_func( qw/time logrelay queueid msgid 
		      from_user from_domain from_relay_host from_relay_ip 
		      size delay
		      to_user to_domain to_relay_host to_relay_ip 
		      stat xstat
				       /);
my $lines	= 0;
my $dlflines	= 0;
my $errorlines  = 0;
#
# we should get this thing in Lire::Email .... XXX ...
#
sub print_dlf
{
    my $c = shift;

    my $subroutine = 'print_dlf';

    if (! defined $c->{'recipients'}) {
        lr_warn "$subroutine would want to print dlf " .
	  "about ' " . (defined $c->{'queueid'} ? $c->{'queueid'} : '-') . 
            "', but didn't find recipients, skipping";
    } else {
	foreach my $i ( 0 .. $c->{recipients} - 1 ) {
	    my %dlf = map { $_ => $c->{$_} } 
	      qw/time logrelay queueid msgid from_user from_domain 
		 from_relay_host from_relay_ip size/;
	    foreach my $f ( qw/delay to_user to_domain to_relay_host 
			       to_relay_ip stat xstat/ ) 
	    {
		$dlf{$f} = $c->{$f}[$i];
	    }
	    my $dlf = $dlf_maker->( \%dlf );
	    print join( " ", @$dlf ), "\n";
	    $dlflines++;
	}
    }
}

my %msgs = ();
my $oldqid = '';
my $qid = '';

sub parse_receive {
    my ( $type, $log ) = @_;

    $msgs{$qid}{time} = $log->{timestamp};

    if ( $type eq 'pickup' ) {
	$msgs{$qid}{'from_relay_host'} = "localhost";
	$msgs{$qid}{'from_relay_ip'} = '127.0.0.1';
    } else {
	unless ( defined $log->{client} ) {
	    lr_notice ( "no client= field found for queueid '$qid', ",
			"will use default" );
	    $log->{client} = '-';
	}
	($msgs{$qid}{from_relay_host}, 
	 $msgs{$qid}{from_relay_ip}) = splitrelay($log->{client} );

	my $fromrelayhost = $msgs{$qid}{from_relay_host};
	sanitize( 'relayhost', $fromrelayhost, $msgs{$qid}{from_relay_host} );
	
	my $fromrelayip = $msgs{$qid}{from_relay_ip};
	sanitize('relayip', $fromrelayip, $msgs{$qid}{from_relay_ip});
    }
}

sub parse_cleanup {
    my ( $log ) = $_[0];

    my $mid;
    if (defined $log->{'message-id'}) {
	$mid = $log->{'message-id'};
    } elsif (defined $log->{'resent-message-id'}) {
	$mid = $log->{'resent-message-id'};
    } else {
	lr_warn "no (resent-)message-id= field found for " .
	  "queueid '$qid', using default";
	$mid = '-';
    }

    sanitize( 'msgid', $mid, $msgs{$qid}{'msgid'} );
}

sub parse_send {
    my ( $log ) = $_[0];

    $msgs{$qid}{time} = $log->{timestamp};

    for my $k ('to', 'delay', 'status', 'relay') {
	die "missing '$k'= field\n"
	  unless defined $log->{$k} 
    }

    my $tmp;
    sanitize( 'emailadress', $log->{'to'}, $tmp);

    my ($touser, $todomain) = splitemailadress($tmp);

    sanitize('stat', $log->{'status'}, $tmp);

    my ($stat, $xstat)	    = splitstat($tmp);
    my ($tmphost, $tmpip)   = splitrelay($log->{relay});

    my $torelayhost;
    sanitize('relayhost', $tmphost, $torelayhost);

    my $torelayip;
    sanitize('relayip', $tmpip, $torelayip);

    push(@{ $msgs{$qid}{to_user} }, $touser);
    push(@{ $msgs{$qid}{to_domain} }, $todomain);
    push(@{ $msgs{$qid}{to_relay_host} }, $torelayhost);
    push(@{ $msgs{$qid}{to_relay_ip} }, $torelayip);
    push(@{ $msgs{$qid}{delay} }, $log->{'delay'});
    push(@{ $msgs{$qid}{stat} }, $stat);
    push(@{ $msgs{$qid}{xstat} }, $xstat);

    $msgs{$qid}{'recipients'}++;
}

sub parse_qmgr {
    my ( $log ) = @_;

    for my $k ('size', 'from') {
	# lr_err " expected to find " .
	#  "'$k'= field, substituting default for queueid '$qid', " .
	#    "type '$type'\n"

	# can occurr in case message delivery gets deferred.  we find the
	# real from and size later, in such cases.  no need to warn.
	$log->{$k} ||= '-';
    }

    my $size;
    sanitize('size', $log->{'size'}, $size);

    if (!$msgs{$qid}{'size'} or $msgs{$qid}{'size'} eq '-') {
        # only update size if we can 'improve' it.  some qmgr lines have
        # to=, relay=, delay= and status=, but no size=
        debug("parse_qmgr: size was " . $log->{'size'} . ", assigning $size\n");
        $msgs{$qid}{'size'} = $size;
    }
    $msgs{$qid}{'from_relay_host'} ||= "localhost";
    $msgs{$qid}{'from_relay_ip'}   ||= "127.0.0.1";

    my $tmp;
    sanitize('emailadress', $log->{'from'}, $tmp);
    ( $msgs{$qid}{'from_user'}, 
      $msgs{$qid}{'from_domain'}) = splitemailadress($tmp);
}

sub parse_postfix {
    my ( $log ) = $_[0];

    $oldqid = $qid;
    $qid = $log->{queueid};

    my ($type) = $log->{process} =~ m!^postfix/(.*)!;

    # Initialize default
    $msgs{$qid} ||= {
		     recipients => 0,
		     queueid	=> $qid,
		     logrelay	=> $log->{hostname},
		     delay	=> [],
		     stat	=> [],
		     to_relay	=> [],
		     to_domain	=> [],
		     to_user	=> [],
		    };

  SWITCH:
    for ($type) {
	/^(pickup|smtpd)$/ && do {
	    parse_receive( $type, $log );
	    last SWITCH;
	};
	/^cleanup$/ && do {
	    parse_cleanup( $log );
	    last SWITCH;
	};

        # lmtp: lmtp delivery via unix socket. looks like:
        # Aug 27 04:02:08 mailhost postfix/lmtp[28560]: C15C085E:
        #  to=<joe.user@example.com>,
        #  relay=/var/imap/socket/lmtp[/var/imap/socket/lmtp], delay=1,
        #  status=sent (250 2.1.5 Ok)
        #
        # my goodness! we have 
        # Jun 21 20:41:29 tiggr postfix/smtp[17847]: AE4255DEB: 
        #   to=<log@bind8.logreport.org>, 
        #   relay=my.host.com[001:10:108:201:50:fcff:fe0b:28ec],
        #   delay=1, status=sent (250 Ok: queued as 076EFD980)
        # but also:
        # Jun 21 20:41:28 tiggr postfix/qmgr[520]: AE4255DEB:
        #   to=<-a@local.host.com>, relay=none, delay=0, status=bounced 
        #   (invalid recipient syntax: "-a@local.host.com")
        # (under regular circumstances, qmgr lines look like
        # Jun 21 20:47:08 tiggr postfix/qmgr[520]: 718E85DEB: 
        #    from=<xaa@host.com>, size=685, nrcpt=1 (queue active)
        #
        # Jan 14 14:18:13 srv1 postfix/virtual[25001]: D33803A9E07: 
        #  to=<toto@example.com>, relay=virtual, delay=126, status=sent 
        #  (mailbox)
	(/^(local|smtp|lmtp|virtual)$/ || $type eq 'qmgr' &&
          defined $log->{to} ) && do {
	    parse_send( $log );
	    last SWITCH;
	};
	/^(qmgr|nqmgr)$/ && do {
	    parse_qmgr( $log );
	    last SWITCH;
	};
	/^(master|pipe)$/ && do {
	    # Ignore those
	    last SWITCH;
	};
	# Default
	die "unknown type '$type'\n";
    }

    if ($oldqid and $qid ne $oldqid) {
        # flush it

        debug("parse_postfix: gonna print $oldqid dlf\n");
        print_dlf( $msgs{$oldqid} );
        delete $msgs{$oldqid};
    }
}

if (!open IN, "sort -k 6,6 |") {
    lr_err "stopped: cannot open sort input pipe";
}

init_dlf_converter( "email" );
my $parser = new Lire::Email();
while (<IN>) {
    $lines++;
    chomp;
    my $log;
    eval {
	$log = $parser->parse( $_ );
    };
    if ($@) {
	lr_warn( $@ );
	lr_warn( "failed to parse '$_'. skipping" );
	$errorlines++;
	next;
    }
    next unless $log->{process} =~ m!^postfix/!;

    # skip lines like
    #  Dec 1 06:58:22 internetsrv postfix/smtpd[21142]: connect from ...
    #  Dec 1 06:59:22 internetsrv postfix/smtpd[21142]: disconnect from ....
    # we're not using this information.
    next unless defined $log->{'queueid'};

    eval {
	parse_postfix( $log );
    };
    if ($@) {
	lr_warn( $@ );
	lr_warn( "failed to parse '$_'. skipping" );
	$errorlines++;
    }
}

close IN or lr_err "cannot close sort pipe: $!";

# flush last buffer
debug("postfix2dlf: gonna print $qid dlf\n");
print_dlf(\%{ $msgs{$qid} });

end_dlf_converter( $lines, $dlflines, $errorlines );

__END__

=pod 

=head1 NAME

postfix2dlf - convert postfix logfiles to dlf format

=head1 SYNOPSIS

B<postfix2dlf>

=head1 DESCRIPTION

...

=head1 EXAMPLE

A logfile

 Dec 1 04:02:56 internetsrv postfix/pickup[20919]: 
  693A3578E: uid=0 from=<root>
 Dec 1 04:02:56 internetsrv postfix/cleanup[20921]: 
  693A3578E: message-id=<john.doe.1@example.com>
 Dec 1 04:02:57 internetsrv postfix/qmgr[20164]: 693A3578E: 
  from=<john.doe.2@example.com>, size=617 (queue active)
 Dec 1 04:02:57 internetsrv postfix/cleanup[20921]: 
  E325C578D: message-id=<john.doe.1@example.com>
 Dec 1 04:02:58 internetsrv postfix/local[20924]: 
  693A3578E: to=<john.doe.2@example.com>, relay=local, 
  delay=3, status=sent (forwarded as E325C578D)
 Dec 1 04:02:58 internetsrv postfix/qmgr[20164]: E325C578D: 
  from=<john.doe.2@example.com>, size=769 (queue active)
 Dec 1 04:02:59 internetsrv postfix/smtp[20925]: E325C578D: 
  to=<john.doe.3@example.com>, 
  relay=1.example.com.vp.pt[10.0.0.1], delay=2, status=sent 
  (250 Requested mail action Ok.)
 Dec 1 06:58:22 internetsrv postfix/smtpd[21142]: connect 
  from 2.example.com.fi[10.0.0.2]
 Dec 1 06:58:23 internetsrv postfix/smtpd[21142]: 
  42BFE578D: client=2.example.com.fi[10.0.0.2]
 Dec 1 06:58:24 internetsrv postfix/cleanup[21143]: 
  42BFE578D: message-id=<john.doe.4@example.com>
 Dec 1 06:58:24 internetsrv postfix/qmgr[20164]: 42BFE578D: 
  from=<john.doe.5@example.com>, size=2473 (queue active)
 Dec 1 06:58:26 internetsrv postfix/smtp[21145]: 42BFE578D: 
  to=<john.doe.6@example.com>, 
  relay=1.example.com.vp.pt[10.0.0.1], delay=3, status=sent 
  (250 Requested mail action Ok.)
 Dec 1 06:59:22 internetsrv postfix/smtpd[21142]: 
  disconnect from 2.example.com.fi[10.0.0.2]
 Dec 1 07:08:28 internetsrv postfix/smtpd[21160]: connect 
  from 2.example.com.fi[10.0.0.2]
 Dec 1 07:08:28 internetsrv postfix/smtpd[21160]: 
  C7B39578D: client=2.example.com.fi[10.0.0.2]
 Dec 1 07:08:29 internetsrv postfix/cleanup[21161]: 
  C7B39578D: message-id=<john.doe.7@example.com>
 Dec 1 07:08:29 internetsrv postfix/qmgr[20164]: C7B39578D: 
  from=<john.doe.8@example.com>, size=2173 (queue active)
 Dec 1 07:08:32 internetsrv postfix/smtp[21163]: C7B39578D: 
  to=<john.doe.9@example.com>, 
  relay=3.example.com.vp.pt[10.0.0.3], delay=4, status=sent 
  (250 Requested mail action Ok.)
 Dec 1 07:08:33 internetsrv postfix/smtpd[21160]: 
  disconnect from 2.example.com.fi[10.0.0.2]
 Dec 1 07:18:42 internetsrv postfix/smtpd[21166]: connect 
  from 2.example.com.fi[10.0.0.2]

will get converted to

 975308306 internetsrv 42BFE578D <john.doe.4@example.com> 
  john.doe.5 example.com 2.example.com.fi 10.0.0.2 2473 3 
  xdelay john.doe.6 example.com 1.example.com.vp.pt 
  [10.0.0.1] sent (250_requested_mail_action_ok.)
 975297778 internetsrv 693A3578E <john.doe.1@example.com> 
  john.doe.2 example.com localhost 127.0.0.1 617 3 xdelay 
  john.doe.2 example.com localhost 127.0.0.1 sent 
  (forwarded_as_e325c578d)
 975308912 internetsrv C7B39578D <john.doe.7@example.com> 
  john.doe.8 example.com 2.example.com.fi 10.0.0.2 2173 4 
  xdelay john.doe.9 example.com 3.example.com.vp.pt 
  [10.0.0.3] sent (250_requested_mail_action_ok.)
 975297779 internetsrv E325C578D <john.doe.1@example.com> 
  john.doe.2 example.com localhost 127.0.0.1 769 2 xdelay 
  john.doe.3 example.com 1.example.com.vp.pt [10.0.0.1] 
  sent (250_requested_mail_action_ok.)


=head1 LOGFORMAT

Postfix logs look like this:

=head2 from local to remote

 postfix/pickup[81586]: 094BE204: uid=1001 from=<edwin>
 postfix/cleanup[81683]: 094BE204: 
  message-id=<20000531080729.L39824@cgmd76206.c.nl>
 postfix/qmgr[13460]: 094BE204: 
  from=<edwin@cgmd76206.c.nl>, size=1717 (queue active)
 postfix/smtp[81685]: 094BE204: to=<r.moeskops@c.nl>, 
  relay=smtp.c.nl[212.83.68.146], delay=4, status=sent (250 
  Message received: 
  20000531060722.ZCOV13476.relay02@cgmd76206.c.nl)

=head2 from local to local

 postfix/pickup[81849]: 473B9204: uid=1001 from=<edwin>
 postfix/cleanup[81916]: 473B9204: 
  message-id=<200005310901.LAA56567@kludge.mpn.cp.p.com>
 postfix/qmgr[13460]: 473B9204: 
  from=<edwin@cgmd76206.c.nl>, size=1997 (queue active)
 postfix/local[81918]: 473B9204: to=<edwin@cgmd76206.c.nl>, 
  relay=local, delay=0, status=sent 
  ("|exec /usr/local/bin/procmail -t")

=head2 from remote to local

 postfix/smtpd[82056]: A17131C5: 
  client=gw-nl1.o-it.com[193.79.128.34]
 postfix/cleanup[82057]: A17131C5: 
  message-id=<023201bfcad1$16365ba0$775910ac@ehvbos.nl.oit.com>
 postfix/qmgr[13460]: A17131C5: 
  from=<Jan.Stap@nl.o-it.com>, size=1692 (queue active)
 postfix/local[82059]: A17131C5: 
  to=<majordomo-org@cgmd76206.c.nl>, relay=local, delay=1, 
  status=sent ("|/usr/local/majordomo/wrapper majordomo")

=head2 from remote to remote

 postfix/smtpd[58567]: connect from 
  kweetal.t.nl[131.155.2.7]
 postfix/smtpd[58567]: 9A16E229: 
  client=kweetal.t.nl[131.155.2.7]
 postfix/cleanup[58570]: 9A16E229: 
  message-id=<200006041246.OAA23888@bw2.baub.bwk.t.nl>
 postfix/qmgr[236]: 9A16E229: 
  from=<edwin@bw2.baub.bwk.t.nl>, size=774 (queue active)
 postfix/smtpd[58567]: disconnect from 
  kweetal.t.nl[131.155.2.7]
 postfix/smtp[58574]: 9A16E229: to=<joostvb@x.nl>, 
  relay=mx3.x.nl[194.109.6.48], delay=15, status=sent (250 
  OAA23290 Message accepted for delivery)

=head1 THANKS

Brad Knowles, for supplying patches.  Emanuele "luca" for pointing out
the lmtp delivery.

=head1 SEE ALSO

sendmail2dlf(1), qmail2dlf(1), exim2dlf(1)

=head1 VERSION

$Id: postfix2dlf.in,v 1.24 2002/02/02 11:27:12 vanbaal Exp $

=head1 COPYRIGHT

Copyright (C) 2000-2001 Stichting LogReport Foundation LogReport@LogReport.org
 
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
 
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.
 
You should have received a copy of the GNU General Public License
along with this program (see COPYING); if not, check with
http://www.gnu.org/copyleft/gpl.html or write to the Free Software 
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111, USA.

=head1 AUTHOR

Joost van Baal, embrionic version by Edwin Groothuis. 

=cut

# Local Variables:
# mode: cperl
# End: