Parse::Syslog::Mail - Parse mailer logs from syslog

    use Parse::Syslog::Mail;

    my $maillog = Parse::Syslog::Mail->new('/var/log/syslog');

    while(my $log = $maillog->next) {
	# do something with $log
        # ...
    }

package Parse::Syslog::Mail;
use strict;
use warnings;
use Carp;
use Parse::Syslog;

{
    no strict;
    $VERSION = '0.17';
}

sub new {
    my $self = {
        syslog => undef, 
    };
    my $class = ref $_[0] ? ref shift : shift;
    bless $self, $class;

    my $file = shift;
    my %args = @_;

    croak "fatal: Expected an argument" unless defined $file;

    $self->{syslog} = eval { Parse::Syslog->new($file, %args) } or do {
        $@ =~ s/ at .*$//;
        croak "fatal: Can't create new Parse::Syslog object: $@";
    };

    return $self
}

sub next {
    my $self = shift;
    my %mail = ();
    my @fields = qw(host program timestamp text);
    my %delivery2id = ();  # used to map delivery id with msg id (Qmail)

    LINE: {
        my $log = $self->{syslog}->next;
        return undef unless defined $log;
        @mail{@fields} = @$log{@fields};
        my $text = $log->{text};

        # Sendmail & Postfix format parsing ------------------------------------
        if ($log->{program} =~ /^(?:sendmail|sm-mta|postfix)/) {
            redo LINE if $text =~ /^(?:NOQUEUE|STARTTLS|TLS:)/;
            redo LINE if $text =~ /prescan: (?:token too long|too many tokens|null leading token) *$/;
            redo LINE if $text =~ /possible SMTP attack/;

            $text =~ s/^(\w+): *// and my $id = $1;         # gather the MTA transient id
            redo LINE unless $id;

            redo LINE if $text =~ /^\s*(?:[<-]--|[Mm]ilter|SYSERR)/;   # we don't treat these

            $text =~ s/^(\w+): *clone:/clone=$1/;           # handle clone messages
            $text =~ s/stat=/status=/;                      # renaming 'stat' field to 'status'
            $text =~ s/message-id=/msgid=/;                 # renaming 'message-id' field to 'msgid' (Postfix)
            $text =~ s/^\s*([^=]+)\s*$/status=$1/;          # format other status messages

            # format other status messages (2)
            if ($text =~ s/^\s*([^=]+)\s*;\s*/status=$1, /) {
                $text =~ s/(\S+)\s+([\w-]+)=/$1, $2=/g;
            }

            $text =~ s/collect: /collect=/;                 # treat collect messages as field identifiers
            $text =~ s/(\S+),\s+([\w-]+)=/$1\t$2=/g;        # replace fields seperator with tab character

            %mail = (%mail, map {
                    s/,$//;  s/^ +//;  s/ +$//; # cleaning spaces
                    s/^\s+([\w-]+=)/$1/;        # cleaning up field names
                    split /=/, $_, 2            # no more than 2 elements
                 } split /\t/, $text);

            if (exists $mail{ruleset} and exists $mail{arg1}) {
                $mail{ruleset} eq 'check_mail'  and $mail{from}  = $mail{arg1};
                $mail{ruleset} eq 'check_rcpt'  and $mail{to}    = $mail{arg1};
                $mail{ruleset} eq 'check_relay' and $mail{relay} = $mail{arg1};

                unless (exists $mail{status}) {
                    $mail{reject}     and $mail{status} = "reject: $mail{reject}";
                    $mail{quarantine} and $mail{status} = "quarantine: $mail{quarantine}";
                }
            }

            $mail{id} = $id;

        # Courier ESMTP -------------------------------------------------------
        } elsif ($log->{program} =~ /^courier/) {
            redo LINE if $text =~ /^(?:NOQUEUE|STARTTLS|TLS:)/;

            $text =~ s/,status: /,status=/;     # treat status as a field
            $text =~ s/,(\w+)=/\t$1=/g;         # replace fields separator with tab character

            %mail = (%mail, map { split /=/, $_, 2 } split /\t/, $text);

        # Qmail format parsing -------------------------------------------------
        } elsif ($log->{program} =~ /^qmail/) {
            $text =~ s/^(\d+\.\d+) // and $mail{qmail_timestamp} = $1;   # Qmail timestamp
            # use Time::TAI64 to parse that timestamp?
            redo LINE if $text =~ /^(?:status|bounce|warning)/;

            # record 'new' and 'end' events in the status
            $text =~ s/^(new|end) msg (\d+)$// 
                and $mail{status} = "$1 message" and $mail{id} = $2 and last;

            # record 'triple bounce' events in the status
            $text =~ s/^(triple bounce: discarding bounce)\/(\d+)$// 
                and $mail{status} = $1 and $mail{id} = $2 and last;

            # mail id and its size
            $text =~ s/^info msg (\d+): bytes (\d+) from (<[^>]*>) // 
                and $mail{id} = $1 and $mail{size} = $2 and $mail{from} = $3;
            
            # begining of the delivery
            $text =~ s/^(starting delivery (\d+)): msg (\d+) to (local|remote) (.+)$// 
                and $mail{status} = $1 and $mail{id} = $3 and $delivery2id{$2} = $3 
                and $mail{delivery_id} = $2 and $mail{delivery_type} = $4 and $mail{to} = $5;

            $text =~ s/^delivery (\d+): +// 
                and $mail{delivery_id} = $1 and $mail{id} = $delivery2id{$1} || '';
            
            # status of the delivery
            $text =~ s/^(success|deferral|failure): +(\S+)// 
                and $mail{status} = "$1: $2" and $mail{status} =~ tr/_/ /;

            # in case of missing MTA transient id, generate one
            $mail{id} ||= 'psm' . time;

        # Exim format parsing --------------------------------------------------
        } elsif ($log->{program} =~ /^exim/) {
            # format seems to be DATE TIME TID DIR ADDRESS ?
            # where DIR is
            #   => for outgoing email, recipient follows in <>
            #   <= for incoming email
            #   == for informational message
            #   s= for ???
            # 
            # possible errors/warnings:
            #   cancelled by system filter:

        } else {
            redo LINE
        }
    }

    return \%mail
}

1; # End of Parse::Syslog::Mail