summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--fml/lib/Mail/Bounce/.cvsignore1
-rw-r--r--fml/lib/Mail/Bounce/00_PARSE.ja.txt311
-rw-r--r--fml/lib/Mail/Bounce/00_README.ja.txt12
-rw-r--r--fml/lib/Mail/Bounce/Makefile15
-rw-r--r--fml/lib/Mail/Bounce/Status.pm105
-rw-r--r--fml/lib/Mail/Bounce/index.ja.html27
6 files changed, 471 insertions, 0 deletions
diff --git a/fml/lib/Mail/Bounce/.cvsignore b/fml/lib/Mail/Bounce/.cvsignore
new file mode 100644
index 00000000..b643ba41
--- /dev/null
+++ b/fml/lib/Mail/Bounce/.cvsignore
@@ -0,0 +1 @@
+@@doc
diff --git a/fml/lib/Mail/Bounce/00_PARSE.ja.txt b/fml/lib/Mail/Bounce/00_PARSE.ja.txt
new file mode 100644
index 00000000..2b6f66cf
--- /dev/null
+++ b/fml/lib/Mail/Bounce/00_PARSE.ja.txt
@@ -0,0 +1,311 @@
+### VERY FUNDAMENTAL CONFIG ###
+$ErrorCodePat = '55\d|5\.\d\.\d';
+$TrapWord = 'unknown \S+|\S+ unknown|\S+ not known| not found';
+
+# regexp
+$RE_SJIS_C = '[\201-\237\340-\374][\100-\176\200-\374]';
+$RE_SJIS_S = "($RE_SJIS_C)+";
+$RE_EUC_C = '[\241-\376][\241-\376]';
+$RE_EUC_S = "($RE_EUC_C)+";
+$RE_JIN = '\033\$[\@B]';
+$RE_JOUT = '\033\([BJ]';
+###############################
+
+
+
+
+
+
+sub Parse
+{
+ my ($new_block, $gobble, $curf, $first_header_part);
+ my ($mp_block, $p, $pmax);
+
+ $new_block = 1;
+ $gobble = 0;
+ $curf = $NULL;
+ $first_header_part = 1;
+
+ # gobble error mail
+ {
+ $pmax = sysread(STDIN,
+ $MessageBuffer,
+ $MEAD_INCOMING_MAIL_SIZE_LIMIT);
+
+ if ($pmax >= $MEAD_INCOMING_MAIL_SIZE_LIMIT) {
+ &Log("warn: input mail is too large");
+ &Log("warn: check the fisrt $MEAD_INCOMING_MAIL_SIZE_LIMIT bytes");
+ }
+ &Log("log: read $pmax bytes") if $debug;
+ }
+
+ my ($msgbufp, $msgbufp1);
+ for ($msgbufp = 0; $msgbufp <= $pmax; ) {
+ $msgbufp1 = index($MessageBuffer, "\n", $msgbufp);
+ last if $msgbufp1 < 0;
+ $_ = substr($MessageBuffer, $msgbufp, $msgbufp1 - $msgbufp);
+ $msgbufp = $msgbufp1 + 1;
+
+ # reread input buffer since this buffer ends incomletely.
+ # we ends it up with "\n" correctly.
+ $SavedBuffer .= $_."\n" if $InputLines++ < 1024;
+
+ # ignore the first header
+ # we should ignore header for <maintainer>
+ $first_header_part = 0 if /^$/;
+
+ # save excursion
+ $PrevLine = $CurLine;
+ $CurLine = $_;
+
+ # check the current block
+ if (/^Content-Type:\s*(.*)/i) {
+ &Debug("<<< $_ >>>");
+ $mp_block = $1;
+ }
+
+ if (/^(Content-Description:\s*Notification).*/i) {
+ &Debug("<<< $_ >>>");
+ $mp_block = $1;
+ }
+
+ # Store Received: field
+ if (! $first_header_part) {
+ if (/^([-A-Za-z]+):(.*)/) {
+ $curf = $1;
+ $value = $2;
+ $Received .= "\n".$value if $curf =~ /Received/i;
+ }
+ elsif (/^\s+(.*)/) {
+ $value = $1;
+ $Received .= $value if $curf =~ /Received/i;
+ }
+ }
+
+ 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/) {
+ undef %return_addr;
+ $original_mail = $found = 0;
+ undef $MTA;
+ undef $CurAddr;
+ }
+
+ # guess MTA ...
+ if (/^Message-ID:\s+\<[\w\d]+\-[\w\d]+\-[\w\d]+\@/i) {
+ $MTA = "exim";
+ next;
+ }
+ if (/qmail-send/) {
+ $MTA = "qmail";
+ next;
+ }
+
+ # get returned addresses
+ if ($first_header_part) {
+ if (/^(To|Cc):.*/i) {
+ if ($new_block && $gabbble == 0) {
+ &Debug("$new_block, $gobble> rset \%return_addr\n") if $debug;
+ undef %return_addr;
+ }
+
+ $new_block = 0;
+ $gabbble = 1;
+
+ &ExtractAddr($_);
+ next;
+ }
+ elsif (/^X\-MLServer:/i) { # this is the commnd mail from fml.
+ $NotSavedBuffer = 1;
+ }
+ # 822 folding
+ elsif (/^\s+/ && $gobble) {
+ &ExtractAddr($_);
+ next;
+ }
+ }
+
+
+ ###
+ ### RFC1891,1894 DSN
+ ###
+ if ($mp_block =~ /delivery\-status/i) {
+ if (/^Final-Recipient:.*\s+(\S+\@\S+)/i) {
+ $DSN_FinalRecipient = &BareAddr($1);
+ }
+ elsif (/^Original-Recipient:.*\s+(\S+\@\S+)/i) {
+ $DSN_OriginalRecipient = &BareAddr($1);
+ }
+ elsif (/^Status:\s*5/i) {
+ if ($DSN_OriginalRecipient) {
+ &CacheOn($DSN_OriginalRecipient, " ");
+ }
+ if ($DSN_FinalRecipient) {
+ &CacheOn($DSN_FinalRecipient, " ");
+ }
+
+ $found++;
+ }
+ }
+
+ # smtpfeed -1 -F hack
+ if (/^To: \(original recipient in envelope at \S+\) <(\S+)>/) {
+ &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);
+ $CurAddr =~ s/[\<\>]//g;
+ $CurAddr =~ s/\s*//g;
+ &Debug("CurAddr => $CurAddr") if $debug && $CurAddr;
+ }
+
+ $gobble = 0;
+
+ # ignore Japanese strings.
+ next if /$RE_JIN/;
+ next if /$RE_JOUT/;
+ next if /$RE_SJIS_S/;
+ next if /$RE_EUC_S/;
+
+ ### unknown MTA ###
+ if (/(\S+\@[-A-Z0-9\.]+)/i) {
+ /(\S+\@[-A-Z0-9\.]+)/i && ($P_CurAddr = $1); # pseudo
+ $P_CurAddr =~ s/[\<\>]//g;
+ $P_CurAddr =~ s/\s*//g;
+ &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++;}
+
+ if (/\@/ && /(5\d\d)/) { &AnalyzeErrorCode($_); $found++; }
+ if (/\@/ && /$TrapWord/i) { &AnalyzeErrorWord($_); $found++; }
+
+ ### unknown MTA
+ # e.g. uset not known
+ if (/$TrapWord/i && $P_CurAddr) {
+ &AnalyzeErrorWord($_, $P_CurAddr);
+ $found++;
+ }
+
+ ### postfix
+ if (/$TrapWord/i && $MTA eq 'postfix') {
+ &AnalyzeErrorWord($_, $CurAddr);
+ $found++;
+ }
+
+ ###
+ ### exim
+ ###
+ if (/$TrapWord/i && $MTA eq 'exim') {
+ &AnalyzeErrorWord($_, $CurAddr);
+ $found++;
+ }
+
+ # EXIM pattern
+ if (/failed/i && $MTA eq 'exim') {
+ $trap_want_addr = $_;
+ next;
+ }
+ if ($trap_want_addr && /\@/ && $MTA eq 'exim') {
+ local($a);
+ /^\s*(\S+\@\S+)/ && ($a = $1);
+ $a =~ s/[\<\>:]//g;
+ &CacheOn($a, " ") if $a; # space is a dummy
+ undef $trap_want_addr;
+ }
+
+ if (/($ErrorCodePat)/ && $MTA eq 'exim') {
+ &AnalyzeErrorWord($_, $CurAddr);
+ $found++;
+ }
+
+ ###
+ ### qmail
+ ###
+ if (/\#5\.\d+\.\d+/ && $MTA eq 'qmail') {
+ &AnalyzeErrorWord($_, $CurAddr);
+ $found++;
+ }
+
+ if ($MTA eq 'qmail' && $CurAddr && $RABuf) {
+ &AnalyzeErrorWord($RABuf, $CurAddr);
+ $found++;
+ }
+
+ ###
+ ### sendmail
+ ###
+ if ($fatal) {
+ local($a);
+ /^\s*(\S+\@\S+)/ && ($a = $1);
+ $a =~ s/[\<\>]//g;
+ &CacheOn($a, " ") if $a; # space is a dummy
+ }
+ # end of fatal block
+ if ($fatal && /^$/) {
+ undef $fatal;
+ }
+ }
+
+ # VERPs: qmail specific
+ # Suppose list-admin-account=domain@$mydomain syntax, ...
+ {
+ local($ra, $addr);
+
+ $addr = $ENV{'RECIPIENT'};
+ $ra = $ENV{'RECIPIENT'};
+
+ if ($addr =~ /=/) {
+ $addr =~ s/\@\S+$//;
+ $addr =~ s/=/\@/;
+ $addr =~ s/^\S+\-admin\-//; # fml specific
+
+ $ra =~ s/admin\-\S+\@/admin@/;
+
+ &Debug("qmail:". $addr);
+ &Debug("qmail return_addr:". $ra);
+ $return_addr{$ra} = 1;
+ &CacheOn($addr, " ");
+ }
+ }
+}
+
+
diff --git a/fml/lib/Mail/Bounce/00_README.ja.txt b/fml/lib/Mail/Bounce/00_README.ja.txt
new file mode 100644
index 00000000..622b3e3a
--- /dev/null
+++ b/fml/lib/Mail/Bounce/00_README.ja.txt
@@ -0,0 +1,12 @@
+ エラーメッセージのコレクション
+
+入力は
+ Mailinglist::Messages オブジェクトの形で
+
+
+出力は
+ ハッシュで {
+
+ 駄目そうなメールアドレス => 理由
+
+ }
diff --git a/fml/lib/Mail/Bounce/Makefile b/fml/lib/Mail/Bounce/Makefile
new file mode 100644
index 00000000..2eadbd96
--- /dev/null
+++ b/fml/lib/Mail/Bounce/Makefile
@@ -0,0 +1,15 @@
+all: anal
+
+anal:
+ @ find . | sort | grep -v CVS | sed 's@./@@'
+
+html: index.ja.html
+
+index.ja.html: *.pm
+ ../../../doc/bin/dir2url.pl > index.ja.html
+
+_clean:
+ rm -f index.ja.html */index.ja.html
+
+clean:
+ (cd ../../..;make clean)
diff --git a/fml/lib/Mail/Bounce/Status.pm b/fml/lib/Mail/Bounce/Status.pm
new file mode 100644
index 00000000..6f8398ce
--- /dev/null
+++ b/fml/lib/Mail/Bounce/Status.pm
@@ -0,0 +1,105 @@
+#-*- 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.
+#
+# $Id$
+# $FML: Status.pm,v 1.3 2001/04/03 09:45:39 fukachan Exp $
+#
+
+package ErrorStatus;
+
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK);
+use Carp;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(error_set error error_clear);
+
+=head1 NAME
+
+ErrorStatus - error handling component
+
+=head1 SYNOPSIS
+
+Use this module in your C<Something> class module like this:
+
+ package Something;
+ use ErrorStatus qw(error_set error error_clear);
+
+ sub xxx
+ {
+ if something errors ...
+ $self->error_set( why this error occurs ... );
+ }
+
+You use C<Something> module like this.
+
+ use Something;
+ $obj = new Something;
+ $obj->xxx();
+ unless ($obj->error) { $obj->do_somting( ...); };
+
+=head1 DESCRIPTION
+
+simple utility functions to manipulate error messages.
+
+=head1 METHODS
+
+=head2 C<error_set($message)>
+
+save $message as an error message.
+
+=head2 C<error()>
+
+return $message which is saved by C<error_set($msg)>.
+
+=cut
+
+
+sub error_set
+{
+ my ($self, $mesg) = @_;
+ $self->{'_error_reason'} = $mesg;
+}
+
+
+sub error
+{
+ my ($self, $args) = @_;
+ return $self->{'_error_reason'};
+}
+
+
+sub error_clear
+{
+ my ($self, $args) = @_;
+ my $msg = $self->{'_error_reason'};
+ undef $self->{'_error_reason'} if defined $self->{'_error_reason'};
+ undef $self->{'_error_action'} if defined $self->{'_error_action'};
+ return $msg;
+}
+
+
+=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
+
+ErrorStatus appeared in fml5 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;
diff --git a/fml/lib/Mail/Bounce/index.ja.html b/fml/lib/Mail/Bounce/index.ja.html
new file mode 100644
index 00000000..51438276
--- /dev/null
+++ b/fml/lib/Mail/Bounce/index.ja.html
@@ -0,0 +1,27 @@
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
+<HTML>
+<HEAD>
+<TITLE>
+ErrorMessages::* classes
+</TITLE>
+<META http-equiv="Content-Type"
+ content="text/html; charset=EUC-JP">
+</HEAD>
+
+<BODY BGCOLOR="#E6E6FA">
+<CENTER><EM>ErrorMessages class modules</EM></CENTER>
+<HR>
+<A HREF="00_PARSE.ja.txt">PARSE(Japanese)</A>
+<A HREF="00_README.ja.txt">README(Japanese)</A>
+<HR>
+<TABLE>
+<TR>
+<TD>
+ Status.pm <TD>
+<A HREF="Status.pm">[source]</A>
+<TD>
+<A HREF="@@doc/Status.txt">[manual]</A>
+<TD>
+</TABLE>
+</BODY>
+</HTML>