123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351 |
- package Parse::Syslog::Mail;
- use strict;
- use Carp;
- use Parse::Syslog;
- { no strict;
- $VERSION = '0.09';
- }
- 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;
-
- croak "fatal: First argument of new() must be a file path of a File::Tail object"
- unless -f $file or $file->isa('File::Tail') or $file->isa('IO::Handle');
-
- eval { $self->{syslog} = new Parse::Syslog $file, %args };
- if($@) {
- $@ =~ 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 = ();
- my $si_id = time();
-
- LINE: {
- my $log = $self->{syslog}->next;
- return undef unless defined $log;
- @mail{@fields} = @$log{@fields};
- my $text = $log->{text};
-
- 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) *$/;
- my $id;
- $text =~ s/^(\w+): *// and $id = $1;
- if ( $text =~ /^ruleset=/ && not $id ) {
- $id = "si_" . $si_id++;
- }
- redo LINE unless $id;
- redo LINE if $text =~ /^\s*(?:[<-]--|[Mm]ilter|SYSERR)/;
- $text =~ s/stat=/status=/;
- $text =~ s/^\s*([^=]+)\s*$/status=$1/;
- $text =~ s/^\s*([^=]+)\s*;\s*/status=$1, /;
- $text =~ s/collect: /collect=/;
- $text =~ s/(\S+),\s+([\w-]+)=/$1\t$2=/g;
- %mail = (%mail, map {
- s/,$//; s/^ +//; s/ +$//;
- s/.*\s+([\w-]+=)/$1/;
- split /=/, $_, 2
- } split /\t/, $text);
- ($mail{to}) = $1 if $mail{to} =~ /^(.+)\s.*/;
-
- 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;
-
- } elsif($log->{program} =~ /^courier/) {
- redo LINE if $text =~ /^(?:NOQUEUE|STARTTLS|TLS:)/;
- $text =~ s/,status: /,status=/;
- $text =~ s/,(\w+)=/\t$1=/g;
- %mail = (%mail, map {
- split /=/, $_, 2
- } split /\t/, $text);
-
- } elsif($log->{program} =~ /^qmail/) {
- $text =~ s/^(\d+\.\d+) // and $mail{qmail_timestamp} = $1;
- redo LINE if $text =~ /^(?:status|bounce|warning)/;
-
- $text =~ s/^(new|end) msg (\d+)$//
- and $mail{status} = "$1 message" and $mail{id} = $2 and last;
-
- $text =~ s/^(triple bounce: discarding bounce)\/(\d+)$//
- and $mail{status} = $1 and $mail{id} = $2 and last;
-
- $text =~ s/^info msg (\d+): bytes (\d+) from (<[^>]*>) //
- and $mail{id} = $1 and $mail{size} = $2 and $mail{from} = $3;
-
-
- $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} || '';
-
-
- $text =~ s/^(success|deferral|failure): +(\S+)//
- and $mail{status} = "$1: $2" and $mail{status} =~ tr/_/ /;
-
- $mail{id} ||= 'psm' . time;
- } else {
- redo LINE
- }
- }
- return \%mail
- }
- 1;
|