enable to parse qmail error message (though not include VERPs)

3 files changed, 99 insertions, 51 deletions

diff --git a/fml/lib/Mail/Bounce/00_PARSE.ja.txt b/fml/lib/Mail/Bounce/00_PARSE.ja.txt
index 63067edf..b963b84a 100644
--- a/fml/lib/Mail/Bounce/00_PARSE.ja.txt
+++ b/fml/lib/Mail/Bounce/00_PARSE.ja.txt
@@ -63,13 +63,6 @@ sub Parse
 	    }
 	}
 
-	if ($original_mail && $found && $debug) {
-	    &Debug("   --- $_") if $debug;
-	}
-	elsif ($debug) {
-	    &Debug("   | $_") if $debug;
-	}
-
 	$new_block = 1 if /^\s*$/;
 
 	if (/^From:.*mailer-daemon/i || /^From:.*postmaster/) {
@@ -84,10 +77,7 @@ sub Parse
 	    $MTA = "exim";
 	    next;
 	}
-	if (/qmail-send/) {
-	    $MTA = "qmail";
-	    next;
-	}
+
 
 	# get returned addresses
 	if ($first_header_part) {
@@ -119,25 +109,6 @@ sub Parse
 	    &PickUpHint($1);
 	}
 
-	#####
-	##### MTA szpecific
-	#####
-	# postfix
-	# <uja@beth.fml.org>: unknown user
-	if ($mp_block eq 'Content-Description: Notification') {
-	    if (/^\s*(\S+\@\S+):\s*(unknown user|.*:\s+5\d\d\s+.*)/) {
-		$CurAddr = $1;
-		$CurAddr =~ s/[\<\>]//g;
-		$CurAddr =~ s/\s*//g;	
-		&Debug("CurAddr => $CurAddr") if $debug && $CurAddr;
-		$MTA = 'postfix';
-	    }
-	}
-
-	# exim || qmail
-	if ($MTA eq 'qmail' && /This is a permanent error/) {
-	    $RABuf .= $_;
-	}
 
 	if ($MTA eq 'exim' || $MTA eq 'qmail') {
 	    /^\s*(\S+\@\S+):\s*$/ && ($CurAddr = $1);
@@ -162,14 +133,6 @@ sub Parse
 	    &Debug("P_CurAddr => $P_CurAddr") if $debug && $P_CurAddr;
 	}
 
-	# error message line
-	# next if /<<<.*\@/;
-	# next if /^Diagnostic-Code:/i;
-
-	# ignore the original mails
-	# &Debug("next") if $original_mail && $found;
-	next if $original_mail && $found;
-	$original_mail = 1 if /^received:/i;
 
 	##### TRAP CODE #####
 	if (/fatal error/i) { $fatal++;}
@@ -217,19 +180,6 @@ sub Parse
 	}
 
 	###
-	### qmail
-	###
-	if (/\#5\.\d+\.\d+/ && $MTA eq 'qmail') { 
-	    &AnalyzeErrorWord($_, $CurAddr);
-	    $found++;
-	}
-
-	if ($MTA eq 'qmail' && $CurAddr && $RABuf) {
-	    &AnalyzeErrorWord($RABuf, $CurAddr);
-	    $found++;
-	}
-
-	###
 	### sendmail
 	###
 	if ($fatal) {
diff --git a/fml/lib/Mail/Bounce/00_README.ja.txt b/fml/lib/Mail/Bounce/00_README.ja.txt
index d7ce6f17..a9dbfb15 100644
--- a/fml/lib/Mail/Bounce/00_README.ja.txt
+++ b/fml/lib/Mail/Bounce/00_README.ja.txt
@@ -5,6 +5,9 @@
 
 	入力の最大値は？
 
+	エラーを起こした元のメールをどうとらえるか？
+	例えば、そのエラーになった Received: の系列をどう扱うか
+
 
 出力は
 	ハッシュで {
diff --git a/fml/lib/Mail/Bounce/Qmail.pm b/fml/lib/Mail/Bounce/Qmail.pm
new file mode 100644
index 00000000..9271b7a4
--- /dev/null
+++ b/fml/lib/Mail/Bounce/Qmail.pm
@@ -0,0 +1,95 @@
+#-*- perl -*-
+#
+#  Copyright (C) 2001 Ken'ichi Fukamachi
+#   All rights reserved. This program is free software; you can
+#   redistribute it and/or modify it under the same terms as Perl itself. 
+#
+# $FML: Qmail.pm,v 1.3 2001/04/09 15:31:48 fukachan Exp $
+#
+
+
+package Mail::Bounce::Qmail;
+
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use Carp;
+
+=head1 NAME
+
+Mail::Bounce::Qmail - Qmail error message format parser
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+Parse bounce messages generated by qmail.
+
+Qmail actually has a standard, called QSBMF (qmail-send bounce message
+format), as describbed in
+
+    http://cr.yp.to/proto/qsbmf.txt
+
+=head1 METHODS
+
+=head2 C<new()>
+
+=cut
+
+sub analyze
+{
+    my ($self, $msg) = @_;
+    my $result  = {};
+    my $state   = 0;
+    my $pattern = 'Hi. This is the';
+    my $end_pattern = '--- Undelivered message follows ---';
+
+    # search data
+    my ($addr, $reason);
+    my $m = $msg->{ next };
+    do {
+	if (defined $m) {
+	    my $num  = $m->num_paragraph;
+	    for ( my $i = 0; $i < $num ; $i++ ) {
+		my $data = $m->nth_paragraph( $i + 1 );
+
+		if ($data =~ /$pattern/)     { $state = 1;}
+		if ($data =~ /$end_pattern/) { $state = 0;}
+
+		if ($state == 1) {
+		    $data =~ s/\n/ /g;
+		    if ($data =~ /\<(\S+\@\S+)\>:\s*(.*)/) {
+			($addr, $reason) = ($1, $2);
+			$result->{ $addr }->{ 'Diagnostic-Code' } = $reason;
+			$result->{ $addr }->{ 'Status' }          = '5.x.y';
+		    }
+		} 
+	    }
+	}
+
+	$m = $m->{ next };
+    } while (defined $m);
+
+    $result;
+}
+
+
+=head1 AUTHOR
+
+Ken'ichi Fukamachi
+
+=head1 COPYRIGHT
+
+Copyright (C) 2001 Ken'ichi Fukamachi
+
+All rights reserved. This program is free software; you can
+redistribute it and/or modify it under the same terms as Perl itself. 
+
+=head1 HISTORY
+
+Mail::Bounce::Qmail appeared in fml5 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;