Base version: DadaMail 2.10.12
#!/usr/bin/perl use strict; #---------------------------------------------------------------------# # dada_bounce_handler.pl (Mystery Girl) # For instructions, see the pod of this file. try: # pod2text ./dada_bounce_handler.pl | less # # Or try online: # http://mojo.skazat.com/support/documentation/dada_bounce_handler.pl.html # #---------------------------------------------------------------------# # Required: #Change! the lib paths use lib qw( ../ ../DADA ../DADA/perllib /home/account/www/cgi-bin/dada /home/account/www/cgi-bin/dada/DADA /home/account/www/cgi-bin/dada/DADA/perllib /usr/local/lib/perl5/site_perl/5.8.0/mach /usr/local/lib/perl5/site_perl/5.8.0 /usr/local/lib/perl5/site_perl /usr/local/lib/perl5/5.8.0/BSDPAN /usr/local/lib/perl5/5.8.0/mach /usr/local/lib/perl5/5.8.0 ); # What is the POP3 mail server of the bounce email address? my $Server = ''; # And the username? my $Username = ''; # Password? my $Password = ''; use DADA::Config; #---------------------------------------------------------------------# # Optional Settings - # ####################### # The bounce handler log should be written at: my $Log = $LOGS . '/bounces.txt'; # Message sent from the bounce handler should go to.. # (Leave, undef, if you'd like these messages to go to the list owner) my $Send_Messages_To = undef; # How many messages should I check in one go? my $MessagesAtOnce = 100; # "Soft" bounces are given a score of: my $Default_Soft_Bounce_Score = 1; # "Hard" bounces are given a score of: my $Default_Hard_Bounce_Score = 4; # What score does an email address need to go until they're unsubscribed? my $Score_Threshold = 10; # End of Optional Settings. #---------------------------------------------------------------------# my $Score_Card = {}; my $Rules = [ { qmail_delivery_delay_notification => { Examine => { Message_Fields => { Guessed_MTA => [qw(Qmail)], 'Diagnostic-Code_regex' => [qr/The mail system will continue delivery attempts/], }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { #nothing! } } }, { over_quota => { Examine => { Message_Fields => { Action => [qw(failed Failed)], Status => [qw(5.2.2 4.2.2 5.0.0 5.1.1)], 'Final-Recipient_regex' => [(qr/822/)], 'Diagnostic-Code_regex' => [(qr/552|exceeded storage allocation|over quota|storage full|mailbox full|disk quota exceeded|Mail quota exceeded|Quota violation/)] }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { #mail_list_owner => 'over_quota_message', add_to_score => $Default_Soft_Bounce_Score, } } }, { hotmail_over_quota => { Examine => { Message_Fields => { Action => [qw(failed)], Status => [qw(5.2.3)], 'Final-Recipient_regex' => [(qr/822/)], 'Diagnostic-Code_regex' => [(qr/larger than the current system limit/)] }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { #mail_list_owner => 'over_quota_message', add_to_score => $Default_Soft_Bounce_Score, } } }, { over_quota_obscure_mta => { Examine => { Message_Fields => { Action => [qw(failed)], Status => [qw(5.0.0)], 'Final-Recipient_regex' => [(qr/LOCAL\;\<\>/)], }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { #mail_list_owner => 'over_quota_message', add_to_score => $Default_Soft_Bounce_Score, } } }, { over_quota_obscure_mta_two => { Examine => { Message_Fields => { Action => [qw(failed)], Status => [qw(4.2.2)], }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { #mail_list_owner => 'over_quota_message', add_to_score => $Default_Soft_Bounce_Score, } } }, { yahoo_over_quota => { Examine => { Message_Fields => { Action => [qw(failed)], Status => [qw(5.0.0)], 'Remote-MTA_regex' => [(qr/yahoo.com/)], 'Final-Recipient_regex' => [(qr/822/)], 'Diagnostic-Code_regex' => [(qr/over quota/)], }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { #mail_list_owner => 'over_quota_message', add_to_score => $Default_Soft_Bounce_Score, } } }, { yahoo_over_quota_two => { Examine => { Message_Fields => { 'Remote-MTA' => [qw(yahoo.com)], 'Diagnostic-Code_regex' => [(qr/over quota/)], }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { #mail_list_owner => 'over_quota_message', add_to_score => $Default_Soft_Bounce_Score, } } }, { qmail_over_quota => { Examine => { Message_Fields => { Guessed_MTA => [qw(Qmail)], Status => [qw(5.2.2 5.x.y)], 'Diagnostic-Code_regex' => [(qr/mailbox is full|Exceeded storage allocation|recipient storage full|mailbox full|storage full/)], }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { #mail_list_owner => 'over_quota_message', add_to_score => $Default_Soft_Bounce_Score, } } }, { over_quota_552 => { Examine => { Message_Fields => { 'Diagnostic-Code_regex' => [(qr/552 recipient storage full/)], }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { #mail_list_owner => 'over_quota_message', add_to_score => $Default_Soft_Bounce_Score, } } }, { qmail_tmp_disabled => { Examine => { Message_Fields => { Guessed_MTA => [qw(Qmail)], Status => [qw(4.x.y)], 'Diagnostic-Code_regex' => [(qr/temporarily disabled/)], }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { add_to_score => $Default_Soft_Bounce_Score, } } }, { delivery_time_expired => { Examine => { Message_Fields => { Status_regex => [qr(/4.4.7|delivery time expired/)], Action_regex => [qr(/Failed|failed/)], 'Final-Recipient_regex' => [qr(/822/)], }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { # TODO: # Not sure what to put here ATM. } } }, { status_over_quota => { Examine => { Message_Fields => { Action => [qw(Failed failed)], #originally Failed Status =>[qr/mailbox full/], # like, wtf? }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { #mail_list_owner => 'over_quota_message', add_to_score => $Default_Soft_Bounce_Score, } } }, { earthlink_over_quota => { Examine => { Message_Fields => { 'Diagnostic-Code_regex' => [qr/522|Quota violation/], 'Remote-MTA' => [qw(Earthlink)], }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { #mail_list_owner => 'over_quota_message', add_to_score => $Default_Soft_Bounce_Score, } } }, { qmail_error_5dot5dot1 => { Examine => { Message_Fields => { Guessed_MTA => [qw(Qmail)], #Status => [qw(5.1.1)], 'Diagnostic-Code_regex' => [(qr/551/)], }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { unsubscribe_bounced_email => 'from_list', #unsubscribe_bounced_email => 'from_list', add_to_score => $Default_Hard_Bounce_Score, } } }, { qmail2_error_5dot5dot1 => { Examine => { Message_Fields => { Guessed_MTA => [qw(Qmail)], Status => [qw(5.1.1)], 'Diagnostic-Code_regex' => [(qr/no mailbox here by that name/)], }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { unsubscribe_bounced_email => 'from_list', } } }, { # AOL, apple.com, mac.com, altavista.net, pobox.com... delivery_error_550 => { Examine => { Message_Fields => { Action => [qw(failed)], Status => [qw(5.1.1)], 'Final-Recipient_regex' => [(qr/822/)], 'Diagnostic-Code_regex' => [(qr/SMTP\; 550|550 MAILBOX NOT FOUND|550 5\.1\.1 unknown or illegal alias|User unknown|No such mail drop/)], }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { #unsubscribe_bounced_email => 'from_list', #mail_list_owner => 'user_unknown_message', add_to_score => $Default_Hard_Bounce_Score, } } }, { # same as above, but without the Diagnostic_Code_regex. delivery_error_5dot5dot1_status => { Examine => { Message_Fields => { Action => [qw(failed)], Status => [qw(5.1.1)], 'Final-Recipient_regex' => [(qr/822/)], }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { #unsubscribe_bounced_email => 'from_list', #mail_list_owner => 'user_unknown_message', add_to_score => $Default_Hard_Bounce_Score, } } }, { # Yahoo! delivery_error_554 => { Examine => { Message_Fields => { Action => [qw(failed)], Status => [qw(5.0.0)], 'Diagnostic-Code_regex' => [(qr/554 delivery error/)], }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { #unsubscribe_bounced_email => 'from_list', #mail_list_owner => 'user_unknown_message', add_to_score => $Default_Hard_Bounce_Score, } } }, { qmail_user_unknown => { Examine => { Message_Fields => { Status => [qw(5.x.y)], Guessed_MTA => [qw(Qmail)], }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { #unsubscribe_bounced_email => 'from_list', add_to_score => $Default_Hard_Bounce_Score, } } }, { qmail_error_554 => { Examine => { Message_Fields => { 'Diagnostic-Code_regex' => [(qr/554/)], Guessed_MTA => [qw(Qmail)], }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { #unsubscribe_bounced_email => 'from_list', #mail_list_owner => 'user_unknown_message', add_to_score => $Default_Hard_Bounce_Score, } } }, { qmail_error_550 => { Examine => { Message_Fields => { 'Diagnostic-Code_regex' => [(qr/550/)], Guessed_MTA => [qw(Qmail)], }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { #unsubscribe_bounced_email => 'from_list', #mail_list_owner => 'user_unknown_message', add_to_score => $Default_Hard_Bounce_Score, } } }, { qmail_unknown_domain => { Examine => { Message_Fields => { Status => [qw(5.1.2)], Guessed_MTA => [qw(Qmail)], }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { #unsubscribe_bounced_email => 'from_list', #mail_list_owner => 'user_unknown_message', add_to_score => $Default_Hard_Bounce_Score, } } }, { # more info: # http://www.qmail.org/man/man1/bouncesaying.html qmail_bounce_saying => { Examine => { Message_Fields => { 'Diagnostic-Code_regex' => [qr/This address no longer accepts mail./], Guessed_MTA => [qw(Qmail)], }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { #unsubscribe_bounced_email => 'from_list', add_to_score => $Default_Hard_Bounce_Score, } } }, { exim_user_unknown => { Examine => { Message_Fields => { Status => [qw(5.x.y)], Guessed_MTA => [qw(Exim)], }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { #unsubscribe_bounced_email => 'from_list', add_to_score => $Default_Hard_Bounce_Score, }, } }, { exchange_user_unknown => { Examine => { Message_Fields => { #Status => [qw(5.x.y)], Guessed_MTA => [qw(Exchange)], 'Diagnostic-Code_regex' => [(qr/Unknown Recipient/)], }, Data => { Email => 'is_valid', List => 'is_valid', }, }, Action => { #unsubscribe_bounced_email => 'from_list', add_to_score => $Default_Hard_Bounce_Score, } } }, #{ #novell_access_denied => { # Examine => { # Message_Fields => { # #Status => [qw(5.x.y)], # 'X-Mailer_regex' => [qw(Novell)], # 'Diagnostic-Code_regex' => [(qr/access denied/)], # }, # Data => { # Email => 'is_valid', # List => 'is_valid', # }, # # }, # Action => { # #unsubscribe_bounced_email => 'from_list', # add_to_score => $Default_Hard_Bounce_Score, # } # } #}, { # note! this should really make no sense, but I believe this is a bounce.... aol_user_unknown => { Examine => { Message_Fields => { Status => [qw(2.0.0)], Action => [qw(failed)], 'Reporting-MTA_regex' => [(qr/aol\.com/)], 'Final-Recipient_regex' => [(qr/822/)], 'Diagnostic-Code_regex' => [(qr/250 OK/)], # no for real, everything's "OK" # }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { #unsubscribe_bounced_email => 'from_list', #mail_list_owner => 'user_unknown_message', add_to_score => $Default_Hard_Bounce_Score, }, } }, { user_unknown_5dot3dot0_status => { Examine => { Message_Fields => { Action => [qw(failed)], Status => [qw(5.3.0)], 'Final-Recipient_regex' => [(qr/822/)], 'Diagnostic-Code_regex' => [(qr/No such user|Addressee unknown/)], }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { #unsubscribe_bounced_email => 'from_list', #mail_list_owner => 'user_unknown_message', add_to_score => $Default_Hard_Bounce_Score, } } }, { user_inactive => { Examine => { Message_Fields => { Status_regex => [(qr/5\.0\.0/)], Action => [qw(failed)], 'Final-Recipient_regex' => [(qr/822/)], 'Diagnostic-Code_regex' => [(qr/user inactive|Bad destination|bad destination/)], }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { #unsubscribe_bounced_email => 'from_list', add_to_score => $Default_Hard_Bounce_Score, }, } }, { postfix_5dot0dot0_error => { Examine => { Message_Fields => { Status => [qw(5.0.0)], Guessed_MTA => [qw(Postfix)], Action => [qw(failed)], #said_regex => [(qr/550\-Mailbox unknown/)], }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { #unsubscribe_bounced_email => 'from_list', add_to_score => $Default_Hard_Bounce_Score, }, } }, { permanent_move_failure => { Examine => { Message_Fields => { Status => [qw(5.1.6)], Action => [qw(failed)], 'Final-Recipient_regex' => [(qr/822/)], 'Diagnostic-Code_regex' => [(qr/551 not our customer|User unknown|ecipient no longer/)], }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { #unsubscribe_bounced_email => 'from_list', add_to_score => $Default_Hard_Bounce_Score, }, } }, { unknown_domain => { Examine => { Message_Fields => { Status => [qw(5.1.2)], Action => [qw(failed)], 'Final-Recipient_regex' => [(qr/822/)], }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { #unsubscribe_bounced_email => 'from_list', add_to_score => $Default_Hard_Bounce_Score, }, } }, { relaying_denied => { Examine => { Message_Fields => { Status => [qw( 5.7.1)], Action => [qw(failed)], 'Final-Recipient_regex' => [(qr/822/)], 'Diagnostic-Code_regex' => [(qr/Relaying denied|relaying denied/)], }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { # TODO # Again, not sure quite what to put here - will be silently ignored. # NOTE: Sometimes this message is sent by servers of spammers. }, } }, #{ # Supposively permanent error. #access_denied => { # Examine => { # Message_Fields => { # # Status => [qw(5.7.1)], # Action => [qw(failed)], # 'Final-Recipient_regex' => [(qr/822/)], # 'Diagnostic-Code_regex' => [(qr/ccess denied/)], # # }, # Data => { # Email => 'is_valid', # List => 'is_valid', # } # }, # Action => { # #unsubscribe_bounced_email => 'from_list', # add_to_score => $Default_Hard_Bounce_Score, # }, # } #}, { unknown_bounce_type => { Examine => { Data => { Email => 'is_valid', List => 'is_valid', }, }, Action => { #mail_list_owner => 'unknown_bounce_type_message', #append_message_to_file => $Log, add_to_score => $Default_Soft_Bounce_Score, } } }, { email_not_found => { Examine => { Data => { Email => 'is_invalid', List => 'is_valid', }, }, Action => { # mail_list_owner => 'email_not_found_message', } } }, #{ #who_knows => { # Examine => { # Message_Fields => {}, # }, # Action => {append_message_to_file => $Log}, # }, #}, ]; my $Bounce_Handler_Name = 'Mystery Girl'; my $Over_Quota_Subject = "Bounce Handler - warning user over quota"; my $Over_Quota_Message = qq{ Hello, This is $Bounce_Handler_Name, the bounce handler for $PROGRAM_NAME I received a message and it needs your attention. It seems that the user, [subscriber_email] is over their email quota. This is probably a * temporary * problem, but if the problem persists, you may want to unbsubscribe this address. I've attached what I was sent, if you're curious (or bored, what have you). You can remove this address from your list by clicking this link: [list_unsubscribe_link] Below is the nerdy diagnostic report: ----------------------------------------------------------------------- [report] [status_report] ----------------------------------------------------------------------- - $Bounce_Handler_Name }; my $User_Unknown_Subject = "Bounce Handler - warning user doesn't exist"; my $User_Unknown_Message = qq{ Hello, This is $Bounce_Handler_Name, the bounce handler for $PROGRAM_NAME I received a message and it needs your attention. It seems that the user, [subscriber_email] doesn't exist, was deleted from the system, kicked the big can, etc. This is probably a * permanent * problem and I suggest you unsubscribe the email address, but I'll let you have the last judgement. I've attached what I was sent, if you're curious (or bored, what have you). You can remove this address from your list by clicking this link: [list_unsubscribe_link] Below is the nerdy diagnostic report: ----------------------------------------------------------------------- [report] [status_report] ----------------------------------------------------------------------- - $Bounce_Handler_Name }; my $Email_Not_Found_Subject = "Bounce Handler - warning"; my $Email_Not_Found_Message = qq{ Hello, This is $Bounce_Handler_Name, the bounce handler for $PROGRAM_NAME I received a message and it needs your attention. The message was bounced, but I cannot find the email associated with the bounce. Either I can't understand the bounced report, or there's a bug in my sourcecode. Internet time is lighting fast and I fear I may already be reduced to wasted 1's and 0's, *sigh*. I've attached what I was sent, if you're curious (or bored, what have you). Below is the nerdy diagnostic report: ----------------------------------------------------------------------- [report] [status_report] ----------------------------------------------------------------------- - $Bounce_Handler_Name }; my $Email_Unknown_Bounce_Type_Subject = "Bounce Handler - warning"; my $Email_Unknown_Bounce_Type_Message = qq{ Hello, This is $Bounce_Handler_Name, the bounce handler for $PROGRAM_NAME I received a message and it needs your attention. The message was bounced, but I dont know for what reason. Either I can't understand the bounced report, or there's a bug in my sourcecode. Internet time is lighting fast and I fear I may already be reduced to wasted 1's and 0's, *sigh*. I've attached what I was sent, if you're curious (or bored, what have you). You can remove this address from your list by clicking this link: [list_unsubscribe_link] Below is the nerdy diagnostic report: ----------------------------------------------------------------------- [report] [status_report] ----------------------------------------------------------------------- - $Bounce_Handler_Name }; my $Email_Unsubscribed_Because_Of_Bouncing_Subject = "Unsubscribed from: [list_name] because of excessive bouncing"; my $Email_Unsubscribed_Because_Of_Bouncing_Message = qq{ Hello, This is $Bounce_Handler_Name, the bounce handler for $PROGRAM_NAME This is a notie that your email address: [email] has been unsubscribed from: [list_name] Because your email address has been bouncing messages sent to it, originating from this list. If this is in error, please re-subscribe to this list, by following this link: [list_confirm_subscribe_link] If you have any questions, please email the list owner of this list at: [list_owner_email] for more information. - $Bounce_Handler_Name }; #---------------------------------------------------------------------# # Nothing else to be configured. # my $App_Version = '1.6'; use DADA::App::Guts; use DADA::Mail::Send; use DADA::MailingList::Subscribers; use DADA::MailingList::Settings; use DADA::Template::HTML; use CGI; my $q = new CGI; my %Global_Template_Options = ( #debug => 1, path => [$TEMPLATES], die_on_bad_params => 0, ( ($CPAN_DEBUG_SETTINGS{HTML_TEMPLATE} == 1) ? (debug => 1, ) : () ), ); use Getopt::Long; use Mail::Verp; use MIME::Parser; use MIME::Entity; use Net::POP3; my $parser = new MIME::Parser; $parser = optimize_mime_parser($parser); my $Remove_List = {}; my $Bounce_History = {}; my $Rules_To_Carry_Out = []; my $debug = 0; my $help = 0; my $test; my $server; my $username; my $password; my $verbose = 0; my $log; my $Have_Log = 0; my $messages = 0; my $erase_score_card = 0; my $version; my $list; my $admin_list; my $root_login; GetOptions("help" => \$help, "test=s" => \$test, "server=s" => \$server, "username=s" => \$username, "password=s" => \$password, "verbose" => \$verbose, "log=s" => \$log, "messages=i" => \$messages, "erase_score_card" => \$erase_score_card, "version" => \$version, ); &main; sub main { if(!$ENV{GATEWAY_INTERFACE}){ &cl_main(); }else{ &cgi_main(); } } sub cgi_main { ($admin_list, $root_login) = check_list_security(-cgi_obj => $q, -Function => 'dada_bounce_handler'); $list = $admin_list; my $ls = DADA::MailingList::Settings->new(-List => $list); my $li = $ls->get(); my $flavor = $q->param('flavor') || 'cgi_default'; my %Mode = ( 'cgi_default' => \&cgi_default, 'cgi_parse_bounce' => \&cgi_parse_bounce, ); if(exists($Mode{$flavor})) { $Mode{$flavor}->(); #call the correct subroutine }else{ &cgi_default; } } sub cgi_default { require HTML::Template; my $ls = DADA::MailingList::Settings->new(-List => $list); my $li = $ls->get(); my $tmpl = default_cgi_template(); my @amount = (1,2,3,4,5,6,7,8,9,10,25,50,100,150,200, 250,300,350, 400,450, 500,550,600,650,700, 750,800,850,900,950,1000 ); my $parse_amount_widget = $q->popup_menu(-name => 'parse_amount', -id => 'parse_amount', '-values' => [@amount], -default => $MessagesAtOnce, -label => '', ); print(admin_html_header( -Title => "Bounce Handling", -List => $list, -Form => 0, -Root_Login => $root_login, )); my $template = HTML::Template->new(%Global_Template_Options, scalarref => \$tmpl, ); $template->param( Username => $Username ? $Username : "Not Set!", Server => $Server ? $Server : "Not Set!", self_url => $q->url, parse_amount_widget => $parse_amount_widget, send_via_smtp => $li->{send_via_smtp}, add_sendmail_f_flag => $li->{add_sendmail_f_flag}, print_return_path_header => $li->{print_return_path_header}, set_smtp_sender => $li->{set_smtp_sender}, admin_email => $li->{admin_email},, list_owner_email => $li->{list_owner_email}, MAIL_SETTINGS => $MAIL_SETTINGS, ); print $template->output(); print admin_html_footer(-Form => 0, -List => $list, ); } sub cgi_parse_bounce { print(admin_html_header( -Title => "Parsing Bounces...", -List => $list, -Form => 0, -Root_Login => $root_login )); $test = $q->param('test') if $q->param('test'); $MessagesAtOnce ||= $q->param('parse_amount') if $q->param('parse_amount'); $verbose = 1; print '<pre>'; cl_main(); print '</pre>'; print '<p><a href="#" onclick="history.back()">Back...</a></p>'; print admin_html_footer(-Form => 0, -List => $list, ); } sub cl_main { &init; if($help == 1){ show_help(); }elsif($erase_score_card){ erase_score_card(); }elsif(defined($test) && $test ne 'bounces'){ test_script(); }elsif(defined($version)){ &version(); } print "Making POP3 Connection...\n" if $verbose; my $pop = Net::POP3->new($Server, ( ($CPAN_DEBUG_SETTINGS{NET_POP3} == 1) ? (Debug => 1, ) : () ), ) or warn "Connection to '$Server' wasn't successful: $!"; my $messagecount; eval {require Digest::MD5}; if(!$@){ print "Trying secure login...\n" if $verbose; $messagecount = $pop->apop($Username,$Password); if(!$messagecount){ print "Hmm, secure login failed, switching to regular login...\n" if $verbose; $pop = Net::POP3->new($Server, ( ($CPAN_DEBUG_SETTINGS{NET_POP3} == 1) ? (Debug => 1, ) : () ), ) or warn "Connection to '$Server' wasn't successful: $!"; $messagecount = $pop->login($Username,$Password); } }else{ $messagecount = $pop->login($Username,$Password); } if(($messagecount ne '') && ($messagecount >= 0)){ print "POP3 Connection worked!\n" if $verbose; if($verbose){ print "Mailbox is empty, no bounces to handle.\n\n" if $messagecount == 0; } my $i; my $end = $messagecount; $end = $MessagesAtOnce if $MessagesAtOnce < $end; for($i = 1; $i <= $end; $i++){ my $message_array_ref = []; $message_array_ref = $pop->get($i); my $m_message; foreach(@$message_array_ref){ $m_message .= $_; } parse_bounce(-message => $m_message); } for($i = 1; $i <= $end; $i++){ $pop->delete($i) if ! $debug; } } $pop->quit(); print "\nSaving Scores...\n\n" if $verbose; save_scores($Score_Card); remove_bounces($Remove_List) if ! $debug; &close_log; } sub init { $Server = $server if $server; $Username = $username if $username; $Password = $password if $password; $Log = $log if $log; $MessagesAtOnce = $messages if $messages > 0; if($test){ $debug = 1 if $test eq 'bounces'; } $verbose = 1 if $debug == 1; # init a hashref of hashrefs # for unsub optimization my @a_Lists = DADA::App::Guts::available_lists(); foreach(@a_Lists){ $Remove_List->{$_} = {}; } open_log($Log); } sub parse_bounce { my %args = (-message => undef, @_); my $message = $args{-message}; my $email = ''; my $list = ''; my $diagnostics = {}; my $entity; eval { $entity = $parser->parse_data($message) }; if(!$entity){ warn "No MIME entity found, this message could be garbage, skipping"; print "No MIME entity found, this message could be garbage, skipping" if $verbose; }else{ if($verbose){ print '-' x 72 . "\n"; $entity->dump_skeleton; print '-' x 72 . "\n"; } $email = find_verp($entity); my ($gp_list, $gp_email, $gp_diagnostics) = generic_parse($entity); $list = $gp_list if $gp_list; $email ||= $gp_email; $diagnostics = $gp_diagnostics if $gp_diagnostics; if((!$list) || (!$email) || !keys %{$diagnostics}){ my ($qmail_list, $qmail_email, $qmail_diagnostics) = parse_for_qmail($entity); $list ||= $qmail_list; $email ||= $qmail_email; %{$diagnostics} = (%{$diagnostics}, %{$qmail_diagnostics}) if $qmail_diagnostics; } if((!$list) || (!$email) || !keys %{$diagnostics}){ my ($exim_list, $exim_email, $exim_diagnostics) = parse_for_exim($entity); $list ||= $exim_list; $email ||= $exim_email; %{$diagnostics} = (%{$diagnostics}, %{$exim_diagnostics}) if $exim_diagnostics; } if((!$list) || (!$email) || !keys %{$diagnostics}){ my ($ms_list, $ms_email, $ms_diagnostics) = parse_for_f__king_exchange($entity); $list ||= $ms_list; $email ||= $ms_email; %{$diagnostics} = (%{$diagnostics}, %{$ms_diagnostics}) if $ms_diagnostics; } if((!$list) || (!$email) || !keys %{$diagnostics}){ my ($nv_list, $nv_email, $nv_diagnostics) = parse_for_novell($entity); $list ||= $nv_list; $email ||= $nv_email; %{$diagnostics} = (%{$diagnostics}, %{$nv_diagnostics}) if $nv_diagnostics; } if((!$list) || (!$email) || !keys %{$diagnostics}){ my ($g_list, $g_email, $g_diagnostics) = parse_for_gordano($entity); $list ||= $g_list; $email ||= $g_email; %{$diagnostics} = (%{$diagnostics}, %{$g_diagnostics}) if $g_diagnostics; } if((!$list) || (!$email) || !keys %{$diagnostics}){ my ($y_list, $y_email, $y_diagnostics) = parse_for_overquota_yahoo($entity); $list ||= $y_list; $email ||= $y_email; %{$diagnostics} = (%{$diagnostics}, %{$y_diagnostics}) if $y_diagnostics; } if((!$list) || (!$email) || !keys %{$diagnostics}){ my ($el_list, $el_email, $el_diagnostics) = parse_for_earthlink($entity); $list ||= $el_list; $email ||= $el_email; %{$diagnostics} = (%{$diagnostics}, %{$el_diagnostics}) if $el_diagnostics; } # This is a special case - since this outside module adds pseudo diagonistic # reports, we'll say, add them if they're NOT already there: my ($bp_list, $bp_email, $bp_diagnostics) = parse_using_m_ds_bp($entity); # There's no test for these in the module itself, so we # won't even look for them. #$list ||= $bp_list; #$email ||= $bp_email; %{$diagnostics} = (%{$bp_diagnostics}, %{$diagnostics}) if $bp_diagnostics; chomp($email) if $email; #small hack, turns, %2 into, '-' $list =~ s/\%2d/\-/g; $list = trim($list); if(!$diagnostics->{'Message-Id'}){ $diagnostics->{'Message-Id'} = find_message_id_in_headers($entity); if(!$diagnostics->{'Message-Id'}){ $diagnostics->{'Message-Id'} = find_message_id_in_body($entity); } } if($diagnostics->{'Message-Id'}){ $diagnostics->{'Simplified-Message-Id'} = $diagnostics->{'Message-Id'}; $diagnostics->{'Simplified-Message-Id'} =~ s/\<|\>//g; $diagnostics->{'Simplified-Message-Id'} =~ s/\.(.*)//; #greedy } print generate_nerd_report($list, $email, $diagnostics) if $verbose; my $rule = find_rule_to_use($list, $email, $diagnostics); print "\nUsing Rule: $rule\n\n" if $verbose; if(!bounce_from_me($entity)){ if(!$debug){ #push(@$Rules_To_Carry_Out, [$rule, $list, $email, $diagnostics, $message]); carry_out_rule($rule, $list, $email, $diagnostics, $message); } }else{ warn "Whoop! Bounced message was sent by myself... kinda going to ignore and delete..."; } } #sleep(1); } sub bounce_from_me(){ my $entity = shift; my $bh = $entity->head->get('X-BounceHandler', 0); $bh =~ s/\n//g; $bh = trim($bh); $bh eq $Bounce_Handler_Name ? return 1 : return 0; } sub carry_out_rule { my ($title, $list, $email, $diagnostics, $message) = @_; my $actions = {}; my $i = 0; foreach my $rule(@$Rules){ if((keys %$rule)[0] eq $title){ $actions = $Rules->[$i]->{$title}->{Action}; # wooo that was fun. } $i++; } foreach my $action(keys %$actions){ if($action eq 'add_to_score'){ add_to_score($list, $email, $diagnostics, $actions->{$action}); }elsif($action eq 'unsubscribe_bounced_email'){ unsubscribe_bounced_email($list, $email, $diagnostics, $actions->{$action}); }elsif($action eq 'mail_list_owner'){ mail_list_owner($list, $email, $diagnostics, $actions->{$action}, $message); }elsif($action eq 'append_message_to_file'){ append_message_to_file($list, $email, $diagnostics, $actions->{$action}, $message); }elsif($action eq 'default'){ default_action($list, $email, $diagnostics, $actions->{$action}, $message); }else{ warn "unknown rule trying to be carried out, ignoring"; } log_action($list, $email, $diagnostics, "$action $actions->{$action}"); } } sub default_action { warn "Parsing... really didn't work. Ignoring and deleting bounce."; } sub add_to_score { my ($list, $email, $diagnostics, $action) = @_; if($Score_Card->{$email}){ $Score_Card->{$email} += $action; # Hmm. That was easy. }else{ $Score_Card->{$email} = $action; } print "Email, '$email' - adding $Score_Card->{$email} to total score. Will remove after score reaches, $Score_Threshold\n" if $verbose; } sub unsubscribe_bounced_email { my ($list, $email, $diagnostics, $action) = @_; my @delete_list; if($action eq 'from_list'){ $delete_list[0] = $list; }elsif($action eq 'from_all_lists'){ @delete_list = DADA::App::Guts::available_lists(); }else{ warn "unknown action: '$action', no unsubscription will be made from this email!"; } $Bounce_History->{$list}->{$email} = [$diagnostics, $action]; print "\n" if $verbose; foreach(@delete_list){ $Remove_List->{$_}->{$email} = 1; print "$email to be deleted off of: '$_'\n" if $verbose; } } sub mail_list_owner { my ($list, $email, $diagnostics, $action, $message) = @_; my $Body; my $Subject; if($action eq 'over_quota_message'){ $Subject = $Over_Quota_Subject; $Body = $Over_Quota_Message; }elsif($action eq 'user_unknown_message'){ $Subject = $User_Unknown_Subject; $Body = $User_Unknown_Message; }elsif($action eq 'email_not_found_message'){ $Subject = $Email_Not_Found_Subject; $Body = $Email_Not_Found_Message; }elsif($action eq 'unknown_bounce_type_message'){ $Subject = $Email_Unknown_Bounce_Type_Subject; $Body = $Email_Unknown_Bounce_Type_Message; }else{ warn "There's been a misconfiguration somewhere, $Bounce_Handler_Name is about to die..., "; warn "AARRGGGGH!"; } my $ls = DADA::MailingList::Settings->new(-List => $list); my $lh = DADA::MailingList::Subscribers->new(-List => $list); my $li = $ls->get; my ($sub_status, $sub_errors) = $lh->unsubscription_check(-Email => $email); # A little sanity check... if($email eq $li->{admin_email}){ warn "Bounce is from bounce handler, stopping '$action'"; }elsif(($sub_errors->{not_subscribed} == 1) && (($action ne 'user_unknown_message') || ($action ne 'over_quota_message')|| ($action ne 'email_not_found_message')) ){ print "parsed message contains an email ($email) that's not even subscribed. No reason to tell list owner\n" if $verbose; }else{ my $report = generate_nerd_report($list, $email, $diagnostics); my $status_report = rfc1893_status($diagnostics->{Status}); $Body =~ s/\[report\]/$report/i; $Body =~ s/\[status_report\]/$status_report/i; my $mh = DADA::Mail::Send->new($li); my $to = $Send_Messages_To || $li->{list_owner_email}; my $msg = MIME::Entity->build( To => $email, From => $li->{admin_email}, Subject => $Subject, Type => 'multipart/mixed', ); $msg->attach(Type => 'text/plain', Disposition => 'inline', Data => $Body, Encoding => $li->{plaintext_encoding} ); $msg->attach(Type => 'message/rfc822', Disposition => "attachment", Data => $message); require DADA::App::FormatMessages; my $fm = DADA::App::FormatMessages->new(-List => $list); $fm->use_header_info(1); $fm->use_email_templates(0); my ($header_str, $body_str) = $fm->format_headers_and_body(-msg => $msg->as_string); $mh->send( # Trust me on these :) $mh->return_headers($header_str), 'X-BounceHandler' => $Bounce_Handler_Name, To => $to, Body => $body_str, ); print "mail for: $action is on its way!\n" if $verbose; } } sub append_message_to_file { my ($list, $email, $diagnostics, $action, $message) = @_; print "Appending Email to '$action'\n" if $verbose; $action = DADA::App::Guts::make_safer($action); open(APPENDLOG, ">>$action") or die $!; chmod($FILE_CHMOD, $action); print APPENDLOG $message; close(APPENDLOG) or die $!; } sub generate_nerd_report { my ($list, $email, $diagnostics) = @_; my $report; $report = "List: $list\nEmail: $email\n\n"; foreach(keys %$diagnostics){ $report .= "$_: " . $diagnostics->{$_} . "\n"; } return $report; } sub find_rule_to_use { my ($list, $email, $diagnostics) = @_; my $ir = 0; RULES: for ($ir = 0; $ir <= $#$Rules; $ir++){ my $rule = $Rules->[$ir]; my $title = (keys %$rule)[0]; next if $title eq 'default'; my $match = {}; my $examine = $Rules->[$ir]->{$title}->{Examine}; my $message_fields = $examine->{Message_Fields}; my %ThingsToMatch; foreach my $m_field(keys %$message_fields){ my $is_regex = 0; my $real_field = $m_field; $ThingsToMatch{$m_field} = 0; if($m_field =~ m/_regex$/){ $is_regex = 1; $real_field = $m_field; $real_field =~ s/_regex$//; } MESSAGEFIELD: foreach my $pos_match(@{$message_fields->{$m_field}}){ if($is_regex == 1){ if($diagnostics->{$real_field} =~ m/$pos_match/){ $ThingsToMatch{$m_field} = 1; next MESSAGEFIELD; } }else{ if($diagnostics->{$real_field} eq $pos_match){ $ThingsToMatch{$m_field} = 1; next MESSAGEFIELD; } } } } # If we miss one, the rule doesn't work, # All or nothin', just like life. foreach(keys %ThingsToMatch){ if($ThingsToMatch{$_} == 0){ next RULES; } } if(keys %{$examine->{Data}}){ if($examine->{Data}->{Email}){ my $valid_email = 0; my $email_match; if(DADA::App::Guts::check_for_valid_email($email) == 0){ $valid_email = 1; } if((($examine->{Data}->{Email} eq 'is_valid') && ($valid_email == 1)) || (($examine->{Data}->{Email} eq 'is_invalid') && ($valid_email == 0))){ $email_match = 1; }else{ next RULES; } } if($examine->{Data}->{List}){ my $valid_list = 0; my $list_match; if(DADA::App::Guts::check_if_list_exists(-List=>$list) != 0){ $valid_list = 1; } if((($examine->{Data}->{List} eq 'is_valid') && ($valid_list == 1)) || (($examine->{Data}->{List} eq 'is_invalid') && ($valid_list == 0))){ $list_match = 1; }else{ next RULES; } } } return $title; } return 'default'; } sub find_verp { my $entity = shift; my $mv = Mail::Verp->new; $mv->separator($MAIL_VERP_SEPARATOR); my ($sender, $recipient) = $mv->decode($entity->head->get('To', 0)); return $recipient || undef; } sub generic_parse { my $entity = shift; my ($email, $list); my $diag = {}; ($email, $diag) = find_delivery_status($entity); $list = find_list_in_list_headers($entity); $list ||= generic_body_parse_for_list($entity); $email = DADA::App::Guts::strip($email); $email =~ s/^\<|\>$//g if $email; $list = DADA::App::Guts::strip($list) if $list; return ($list, $email, $diag); } sub find_delivery_status { my $entity = shift; my @parts = $entity->parts; my $email; my $diag = {}; if(!@parts){ if($entity->head->mime_type eq 'message/delivery-status'){ ($email, $diag) = generic_delivery_status_parse($entity); return ($email, $diag); } }else{ my $i; foreach $i (0 .. $#parts) { my $part = $parts[$i]; ($email, $diag) = find_delivery_status($part); if(($email) && (keys %$diag)){ return ($email, $diag); } } } } sub find_mailer_bounce_headers { my $entity = shift; my $mailer = $entity->head->get('X-Mailer', 0); $mailer =~ s/\n//g; return $mailer if $mailer; } sub find_list_in_list_headers { my $entity = shift; my @parts = $entity->parts; my $list; if($entity->head->mime_type eq 'message/rfc822'){ my $orig_msg_copy = $parts[0]; my $list_header = $orig_msg_copy->head->get('List', 0); $list = $list_header if $list_header !~ /\:/; if(!$list){ my $list_id = $orig_msg_copy->head->get('List-ID', 0); if($list_id =~ /\<(.*?)\./){ $list = $1 if $1 !~ /\:/; } } if(!$list){ my $list_sub = $orig_msg_copy->head->get('List-Subscribe', 0); if($list_sub =~ /l\=(.*?)\>/){ $list = $1; } } return $list; }else{ my $i; foreach $i (0 .. $#parts) { my $part = $parts[$i]; $list = find_list_in_list_headers($part); return $list if $list; } } } sub find_message_id_in_headers { my $entity = shift; my @parts = $entity->parts; my $m_id; if($entity->head->mime_type eq 'message/rfc822'){ my $orig_msg_copy = $parts[0]; $m_id = $orig_msg_copy->head->get('Message-ID', 0); chomp($m_id); return $m_id; }else{ my $i; foreach $i (0 .. $#parts) { my $part = $parts[$i]; $m_id = find_message_id_in_headers($part); return $m_id if $m_id; } } } sub find_message_id_in_body { my $entity = shift; my $m_id; my @parts = $entity->parts; # for singlepart stuff only. if(!@parts){ my $body = $entity->bodyhandle; my $IO; return undef if ! defined($body); if($IO = $body->open("r")){ # "r" for reading. while (defined($_ = $IO->getline)){ chomp($_); if($_ =~ m/^Message\-Id\:(.*?)$/ig){ #yeah, sometimes the headers are in the body of #an attached message. Go figure. $m_id = $1; } } } $IO->close; return $m_id; }else{ return undef; } } sub generic_delivery_status_parse { my $entity = shift; my $diag = {}; my $email; # sanity check #if($delivery_status_entity->head->mime_type eq 'message/delivery-status'){ my $body = $entity->bodyhandle; my @lines; my $IO; my %bodyfields; if($IO = $body->open("r")){ # "r" for reading. while (defined($_ = $IO->getline)){ if ($_ =~ m/\:/){ my ($k, $v) = split(':', $_); chomp($v); #$bodyfields{$k} = $v; $diag->{$k} = $v; } } $IO->close; } if($diag->{'Diagnostic-Code'} =~ /X\-Postfix/){ $diag->{Guessed_MTA} = 'Postfix'; } my ($rfc, $remail) = split(';', $diag->{'Final-Recipient'}); if($remail eq '<>'){ #example: Final-Recipient: LOCAL;<> ($rfc, $remail) = split(';', $diag->{'Original-Recipient'}); } $email = $remail; foreach(keys %$diag){ $diag->{$_} = DADA::App::Guts::strip($diag->{$_}); } return ($email, $diag); } sub generic_body_parse_for_list { my $entity = shift; my $list; my @parts = $entity->parts; if(!@parts){ $list = find_list_from_unsub_list($entity); return $list if $list; }else{ my $i; foreach $i (0 .. $#parts) { my $part = $parts[$i]; $list = generic_body_parse_for_list($part); if($list){ return $list; } } } } sub find_list_from_unsub_list { my $entity = shift; my $list; my $body = $entity->bodyhandle; my $IO; return undef if ! defined($body); if($IO = $body->open("r")){ # "r" for reading. while (defined($_ = $IO->getline)){ chomp($_); if($_ =~ m/^List\:(.*?)$/){ #yeah, sometimes the headers are in the body of #an attached message. Go figure. $list = $1; }elsif($_ =~ m/(.*?)\?l\=(.*?)\&f\=u\&e\=/){ $list = $2; }elsif($_ =~ m/(.*?)\?f\=u\&l\=(.*?)\&e\=/){ $list = $2; } } } $IO->close; return $list; } sub parse_for_qmail { # When I'm bored # => http://cr.yp.to/proto/qsbmf.txt # => http://mikoto.sapporo.iij.ad.jp/cgi-bin/cvsweb.cgi/fmlsrc/fml/lib/Mail/Bounce/Qmail.pm my $entity = shift; my ($email, $list); my $diag = {}; my @parts = $entity->parts; my $state = 0; my $pattern = 'Hi. This is the'; my $pattern2 = 'Your message has been enqueued by'; my $end_pattern = '--- Undelivered message follows ---'; my $end_pattern2 = '--- Below this line is a copy of the message.'; my $end_pattern3 = '--- Enclosed is a copy of the message.'; my $end_pattern4 = 'Your original message headers are included below.'; my ($addr, $reason); if(!@parts){ my $body = $entity->bodyhandle; my $IO; if($body){ if($IO = $body->open("r")){ # "r" for reading. while (defined($_ = $IO->getline)){ my $data = $_; $state = 1 if $data =~ /$pattern|$pattern2/; $state = 0 if $data =~ /$end_pattern|$end_pattern2|$end_pattern3/; if ($state == 1) { $data =~ s/\n/ /g; if($data =~ /\t(\S+\@\S+)/){ $email = $1; } elsif ($data =~ /\<(\S+\@\S+)\>:\s*(.*)/) { ($addr, $reason) = ($1, $2); $diag->{Action} = $reason; my $status = '5.x.y'; if($data =~ /\#(\d+\.\d+\.\d+)/) { $status = $1; }elsif ($data =~ /\s+(\d{3})\s+/) { my $code = $1; $status = '5.x.y' if $code =~ /^5/; $status = '4.x.y' if $code =~ /^4/; $diag->{Status} = $status; $diag->{Action} = $code; } $email = $addr; $diag->{Guessed_MTA} = 'Qmail'; }elsif ($data =~ /(.*)\s\(\#(\d+\.\d+\.\d+)\)/){ # Recipient's mailbox is full, message returned to sender. (#5.2.2) $diag->{'Diagnostic-Code'} = $1; $diag->{Status} = $2; $diag->{Guessed_MTA} = 'Qmail'; }elsif($data =~ /Remote host said:\s(\d{3})\s(\d+\.\d+\.\d+)\s\<(\S+\@\S+)\>(.*)/){ # Remote host said: 550 5.1.1 <xxx@xxx>... Account is over quota. Please try again later..[EOF] $diag->{Status} = $2; $email = $3; $diag->{'Diagnostic-Code'} = $4; $diag->{Action} = 'failed'; #munging this for now... $diag->{'Final-Recipient'} = 'rfc822'; #munging, again. }elsif($data =~ /Remote host said:\s(.*?)\s(\S+\@\S+)\s(.*)/){ my $status; $email ||= $2; $status ||= $1; $diag->{Status} ||= '5.x.y' if $status =~ /^5/; $diag->{Status} ||= '4.x.y' if $status =~ /^4/; $diag->{'Diagnostic-Code'} = $data; $diag->{Guessed_MTA} = 'Qmail'; }elsif ($data =~ /Remote host said:\s(\d{3}.*)/){ $diag->{'Diagnostic-Code'} = $1; }elsif ($data =~ /(.*)\s\(\#(\d+\.\d+\.\d+)\)/){ $diag->{'Diagnostic-Code'} = $1; $diag->{Status} = $2; }elsif ($data =~ /(No User By That Name)/){ $diag->{'Diagnostic-Code'} = $data; $diag->{Status} = '5.x.y'; }elsif ($data =~ /(This address no longer accepts mail)/){ $diag->{'Diagnostic-Code'} = $data; }elsif($data =~ /The mail system will continue delivery attempts/){ $diag->{Guessed_MTA} = 'Qmail'; $diag->{'Diagnostic-Code'} = $data; } } } } $list ||= generic_body_parse_for_list($entity); return ($list, $email, $diag); }else{ # no body part to parse return (undef, undef, {}); } }else{ my $i; foreach $i (0 .. $#parts) { my $part = $parts[$i]; ($list, $email, $diag) = parse_for_qmail($part); if(($email) && (keys %$diag)){ return ($list, $email, $diag); } } } } sub parse_for_exim { my $entity = shift; my ($email, $list); my $diag = {}; my @parts = $entity->parts; if(!@parts){ if($entity->head->mime_type =~ /text/){ # Yeah real hard. Bring it onnnn! if($entity->head->get('X-Failed-Recipients', 0)){ $email = $entity->head->get('X-Failed-Recipients', 0); $email =~ s/\n//; $email = trim($email); $list = generic_body_parse_for_list($entity); $diag->{Status} = '5.x.y'; $diag->{Guessed_MTA} = 'Exim'; return ($list, $email, $diag); }else{ my $body = $entity->bodyhandle; my $IO; if($body){ if($IO = $body->open("r")){ # "r" for reading. my $pattern = 'This message was created automatically by mail delivery software (Exim).'; my $end_pattern = '------ This is a copy of the message'; my $state = 0; while (defined($_ = $IO->getline)){ my $data = $_; $state = 1 if $data =~ /\Q$pattern/; $state = 0 if $data =~ /$end_pattern/; if ($state == 1) { $diag->{Guessed_MTA} = 'Exim'; if($data =~ /(\S+\@\S+)/){ $email = $1; $email = trim($email); }elsif($data =~ m/unknown local-part/){ $diag->{'Diagnostic-Code'} = 'unknown local-part'; $diag->{'Status'} = '5.x.y'; } } } } } return ($list, $email, $diag); } }else{ return (undef, undef, {}); } }else{ # no body part to parse return (undef, undef, {}); } } sub parse_for_f__king_exchange { my $entity = shift; my @parts = $entity->parts; my $email; my $diag = {}; my $list; my $state = 0; my $pattern = 'Your message'; if(!@parts){ if($entity->head->mime_type eq 'text/plain'){ my $body = $entity->bodyhandle; my $IO; if($body){ if($IO = $body->open("r")){ # "r" for reading. while (defined($_ = $IO->getline)){ my $data = $_; $state = 1 if $data =~ /$pattern/; if ($state == 1) { $data =~ s/\n/ /g; if($data =~ /\s{2}To:\s{6}(\S+\@\S+)/){ $email = $1; } elsif($data =~ /(MSEXCH)(.*?)(Unknown\sRecipient|Unknown|)/){ # I know, not perfect. $diag->{Guessed_MTA} = 'Exchange'; $diag->{'Diagnostic-Code'} = 'Unknown Recipient'; }else{ #... #warn "nope: " . $data; } } } } } } return ($list, $email, $diag); }else{ my $i; foreach $i (0 .. $#parts) { my $part = $parts[$i]; ($list, $email, $diag) = parse_for_f__king_exchange($part); if(($email) && (keys %$diag)){ return ($list, $email, $diag); } } } } sub parse_for_novell { #like, really... my $entity = shift; my @parts = $entity->parts; my $email; my $diag = {}; my $list; my $state = 0; my $pattern = 'The message that you sent'; if(!@parts){ if($entity->head->mime_type eq 'text/plain'){ my $body = $entity->bodyhandle; my $IO; if($body){ if($IO = $body->open("r")){ # "r" for reading. while (defined($_ = $IO->getline)){ my $data = $_; $state = 1 if $data =~ /$pattern/; if ($state == 1) { $data =~ s/\n/ /g; if($data =~ /\s+(\S+\@\S+)\s\((.*?)\)/){ $email = $1; $diag->{'Diagnostic-Code'} = $2; }else{ #... } } } } } } return ($list, $email, $diag); }else{ my $i; foreach $i (0 .. $#parts) { my $part = $parts[$i]; ($list, $email, $diag) = parse_for_novell($part); if(($email) && (keys %$diag)){ $diag->{'X-Mailer'} = find_mailer_bounce_headers($entity); return ($list, $email, $diag); } } } } sub parse_for_gordano { # what... ever that is there... my $entity = shift; my @parts = $entity->parts; my $email; my $diag = {}; my $list; my $state = 0; my $pattern = 'Your message to'; my $end_pattern = 'The message headers'; if(!@parts){ if($entity->head->mime_type eq 'text/plain'){ my $body = $entity->bodyhandle; my $IO; if($body){ if($IO = $body->open("r")){ # "r" for reading. while (defined($_ = $IO->getline)){ my $data = $_; $state = 1 if $data =~ /$pattern/; $state = 0 if $data =~ /$end_pattern/; if ($state == 1) { $data =~ s/\n/ /g; if($data =~ /RCPT To:\<(\S+\@\S+)\>/){ # RCPT To:<xxx@usnews.com> $email = $1; }elsif($data =~ /(.*?)\s(\d+\.\d+\.\d+)\s(.*)/){ # 550 5.1.1 No such mail drop defined. $diag->{Status} = $2; $diag->{'Diagnostic-Code'} = $3; $diag->{'Final-Recipient'} = 'rfc822'; #munge; $diag->{Action} = 'failed'; #munge; }else{ #... } } } } } } return ($list, $email, $diag); }else{ my $i; foreach $i (0 .. $#parts) { my $part = $parts[$i]; ($list, $email, $diag) = parse_for_gordano($part); if(($email) && (keys %$diag)){ $diag->{'X-Mailer'} = find_mailer_bounce_headers($entity); return ($list, $email, $diag); } } } } sub parse_for_overquota_yahoo { my $entity = shift; my @parts = $entity->parts; my $email; my $diag = {}; my $list; my $state = 0; my $pattern = 'Message from yahoo.com.'; if(!@parts){ if($entity->head->mime_type eq 'text/plain'){ my $body = $entity->bodyhandle; my $IO; if($body){ if($IO = $body->open("r")){ # "r" for reading. while (defined($_ = $IO->getline)){ my $data = $_; $state = 1 if $data =~ /$pattern/; $diag->{'Remote-MTA'} = 'yahoo.com'; if ($state == 1) { $data =~ s/\n/ /g; #what's up with that? if($data =~ /\<(\S+\@\S+)\>\:/){ $email = $1; }else{ if($data =~ m/(over quota)/){ $diag->{'Diagnostic-Code'} = $data; } } } } } } } return ($list, $email, $diag); }else{ my $i; foreach $i (0 .. $#parts) { my $part = $parts[$i]; ($list, $email, $diag) = parse_for_overquota_yahoo($part); if(($email) && (keys %$diag)){ $diag->{'X-Mailer'} = find_mailer_bounce_headers($entity); return ($list, $email, $diag); } } } } sub parse_for_earthlink { my $entity = shift; my @parts = $entity->parts; my $email; my $diag = {}; my $list; my $state = 0; my $pattern = 'Sorry, unable to deliver your message to'; if(!@parts){ if($entity->head->mime_type eq 'text/plain'){ my $body = $entity->bodyhandle; my $IO; if($body){ if($IO = $body->open("r")){ # "r" for reading. while (defined($_ = $IO->getline)){ my $data = $_; $state = 1 if $data =~ /$pattern/; if ($state == 1) { $diag->{'Remote-MTA'} = 'Earthlink'; $data =~ s/\n/ /g; #what's up with that? if($data =~ /(\d{3})\s(.*?)\s(\S+\@\S+)/){ # 552 Quota violation for postmaster@example.com $diag->{'Diagnostic-Code'} = $1 . ' ' . $2; $email = $3; } } } } } } return ($list, $email, $diag); }else{ my $i; foreach $i (0 .. $#parts) { my $part = $parts[$i]; ($list, $email, $diag) = parse_for_overquota_yahoo($part); if(($email) && (keys %$diag)){ $diag->{'X-Mailer'} = find_mailer_bounce_headers($entity); return ($list, $email, $diag); } } } } sub parse_using_m_ds_bp { eval { require Mail::DeliveryStatus::BounceParser; }; return (undef, undef, {}) if $@; # else, let's get to work; my $entity = shift; my $message = $entity->as_string; my $bounce = eval { Mail::DeliveryStatus::BounceParser->new($message); }; if ($@) { # couldn't parse. return (undef, undef, {}) if $@; } # examples: # my @addresses = $bounce->addresses; # email address strings # my @reports = $bounce->reports; # Mail::Header objects # my $orig_message_id = $bounce->orig_message_id; # <ABCD.1234@mx.example.com> # my $orig_message = $bounce->orig_message; # Mail::Internet object return (undef, undef, {}) if $bounce->is_bounce != 1; my ($report) = $bounce->reports; return (undef, undef, {}) if ! defined $report; my $diag = {}; $diag->{'Message-Id'} = $report->get('orig_message_id') if $report->get('orig_message_id'); $diag->{Action} = $report->get('action') if $report->get('action'); $diag->{Status} = $report->get('status') if $report->get('status'); $diag->{'Diagnostic-Code'} = $report->get('diagnostic-code') if $report->get('diagnostic-code'); $diag->{'Final-Recipient'} = $report->get('final-recipient') if $report->get('final-recipient'); # these aren't used particularily in Dada Mail, but let's play around with them... $diag->{std_reason} = $report->get('std_reason') if $report->get('std_reason'); $diag->{reason} = $report->get('reason') if $report->get('reason'); $diag->{host} = $report->get('host') if $report->get('host'); $diag->{smtp_code} = $report->get('smtp_code') if $report->get('smtp_code'); my $email = $report->get('email') || undef; return (undef, $email, $diag); } #sub carry_out_all_rules { # my $array_ref = shift; # foreach my $dead(@$Rules_To_Carry_Out){ # carry_out_rule(@$dead); #hope this works # } # #} sub save_scores { my $score = shift; if(keys %$score){ my @delete_list = DADA::App::Guts::available_lists(); require DADA::App::BounceScoreKeeper; my $bsk = DADA::App::BounceScoreKeeper->new; my $give_back_scores = $bsk->tally_up_scores($score); if(keys %$give_back_scores){ print "\nScore Totals:\n\n" if $verbose; foreach(keys %$give_back_scores){ print "\tEmail: $_ total score: " . $give_back_scores->{$_} . "\n" if $verbose; } } my $removal_list = $bsk->removal_list($Score_Threshold); foreach my $bad_email(@$removal_list){ foreach(@delete_list){ $Remove_List->{$_}->{$bad_email} = 1; print "$bad_email to be deleted off of: '$_'\n" if $verbose; } } $bsk->flush_old_scores($Score_Threshold); }else{ print "No scores to tally.\n" if $verbose; } } sub remove_bounces { my $report = shift; foreach my $list(keys %$report){ my $lh = DADA::MailingList::Subscribers->new(-List => $list); my $ls = DADA::MailingList::Settings->new(-List => $list); my $li = $ls->get; # removing them all at once # optimization so it won't thrash a plain text list $lh->remove_from_list(-Email_List => [keys %{$report->{$list}}]); # As a Fuck son, you sucked. $lh->add_to_email_list(-Email_Ref => [keys %{$report->{$list}}], -Type => 'black_list', ) if( ($li->{black_list} == 1) && ($li->{add_unsubs_to_black_list} == 1) ); # Bang Bang Baby, The Bigger The Better. # Bang Bang Baby, The Bigger The Better. # Bang Bang Baby, The Bigger The Better. # Bang Bang Baby, The Bigger The Better. # You aint a baby no more baby # You aint no bigger than before baby # I'll rub that cheap black off your lips baby # so take a swallow as i spit baby if($li->{get_unsub_notice} == 1){ require DADA::App::Messages; my $r; if($li->{enable_bounce_logging}){ require DADA::Logging::Clickthrough; $r = DADA::Logging::Clickthrough->new($list); } print "\n" if $verbose; foreach my $d_email(keys %{$report->{$list}}){ if($lh->check_for_double_email(-Email => $d_email, -Type => 'list') == 1) { DADA::App::Messages::send_owner_happenings($list, $d_email, 'unsubscribed', $lh, $ls, 'Reason: Address is bouncing messages.'); #DADA::App::Messages::send_unsubscription_email(-List => $list, # -Email => $d_email, # -List_Info => $li); DADA::App::Messages::send_generic_email( -List => $list, -Email => $d_email, -Settings_obj => $ls, -Subject => $Email_Unsubscribed_Because_Of_Bouncing_Subject, -Message => $Email_Unsubscribed_Because_Of_Bouncing_Message, ); if($li->{enable_bounce_logging}){ $r->bounce_log($Bounce_History->{$list}->{$d_email}->[0]->{'Simplified-Message-Id'}, $d_email); } } else { print $d_email . " not subscribed on $list - suppressing actions... \n" if $verbose; } } } } } sub test_script { $verbose = 1; my @files_to_test; if($test eq 'pop3'){ test_pop3(); }elsif(-d $test){ @files_to_test = dir_list($test); }elsif(-f $test){ push(@files_to_test, $test); } my $i = 1; foreach my $testfile(@files_to_test){ print "test #$i: $testfile\n" . '-' x 60 . "\n"; parse_bounce(-message => openfile($testfile)); ++$i; } exit; } sub test_pop3 { my $pop; eval { $pop = Net::POP3->new($Server, ( ($CPAN_DEBUG_SETTINGS{NET_POP3} == 1) ? (Debug => 1, ) : () ), ) or warn "Connection to '$Server' wasn't successful: $!"; }; if ($@) { print "Problems creating Net::POP3 object: $@" if $verbose; return; } if(!$pop){ print "Couldn't estabilish a connection to $Server!\n" if $verbose; }else{ my $messagecount; eval {require Digest::MD5}; if(!$@){ print "Trying secure login...\n"; eval { $messagecount = $pop->apop($Username,$Password); }; if($@){ print "Problems connecting via a secure login. Details: $@" if $verbose; return; } if(!$messagecount){ print "Hmm, secure login failed, switching to regular login...\n"; $pop = Net::POP3->new($Server, ( ($CPAN_DEBUG_SETTINGS{NET_POP3} == 1) ? (Debug => 1, ) : () ), ) or warn "Connection to '$Server' wasn't successful: $!"; $messagecount = $pop->login($Username,$Password); } }else{ $messagecount = $pop->login($Username,$Password); } if(($messagecount ne '') && ($messagecount >= 0)){ print "POP3 Login succeeded.\n"; print "Message count: $messagecount \n\n"; }else{ print "POP3 login failed.\n"; } $pop->quit(); } } sub version { #heh, subversion, wild. print "$Bounce_Handler_Name Version: $App_Version\n"; print "$PROGRAM_NAME Version: $DADA::Config::VER\n"; print "Perl Version: $]\n\n"; my @ap = ('No sane man will dance. - Cicero ', 'Be happy. It is a way of being wise. - Colette', 'There is more to life than increasing its speed. - Mahatma Gandhi', 'Life is short. Live it up. - Nikita Khrushchev'); print "Random Aphorism: " . $ap[int rand($#ap+1)] . "\n\n"; exit; } sub dir_list { my $dir = shift; my $file; my @files; $dir = DADA::App::Guts::make_safer($file); opendir(DIR, $dir) or die "$!"; while(defined($file = readdir DIR) ) { next if $file =~ /^\.\.?$/; $file =~ s(^.*/)(); if(-f $dir . '/' . $file ){ push(@files, $dir . '/' . $file); } } closedir(DIR); return @files; } sub openfile { my $file = shift; my $data = shift; $file = DADA::App::Guts::make_safer($file); open(FILE, "<$file") or die "$!"; $data = do{ local $/; <FILE> }; close(FILE); return $data; } sub open_log { my $log = shift; $log = DADA::App::Guts::make_safer($log); if($log){ open(BOUNCELOG, ">>$log") or warn "Can't open bounce log! $!"; chmod($FILE_CHMOD, $log); $Have_Log = 1; return 1; } } sub log_action { my ($list, $email, $diagnostics, $action) = @_; my $time = scalar(localtime()); if($Have_Log){ my $d; foreach(keys %$diagnostics){ $d .= $_ .': ' . $diagnostics->{$_} . ', '; } print BOUNCELOG "[$time]\t$list\t$action\t$email\t$d\n"; } } sub close_log{ if($Have_Log){ close(BOUNCELOG); } } sub show_help { print q{ arguments: ----------------------------------------------------------- --help --verbose --test ('bounces' | 'pop3'|filename | dirname) --messages n --server server --username username --password password --log filename --erase_score_card --version ----------------------------------------------------------- for instructions, try: pod2text ./dada_bounce_handler.pl | less ----------------------------------------------------------- }; exit; } sub erase_score_card { print "Removing the Bounce Score Card...\n\n"; require DADA::App::BounceScoreKeeper; my $bsk = DADA::App::BounceScoreKeeper->new; $bsk->erase; print "Kapow! All scores have been erased.\n\n"; exit; } sub trim { my $string = shift || undef; if($string){ $string =~ s/^\s+//o; $string =~ s/\s+$//o; return $string; }else{ return undef; } } sub rfc1893_status { my $status = shift; $status = trim($status); return "" if ! $status; my $key; my ($class, $subject, $detail) = split(/\./, $status); $key = 'X' . '.' . $subject . '.' . $detail; my %rfc1893; $rfc1893{'X.0.0'} = qq { Other undefined status is the only undefined error code. It should be used for all errors for which only the class of the error is known. }; $rfc1893{'X.1.0'} = qq { X.1.0 Other address status Something about the address specified in the message caused this DSN. }; $rfc1893{'X.1.1'} = qq { X.1.1 Bad destination mailbox address The mailbox specified in the address does not exist. For Internet mail names, this means the address portion to the left of the "@" sign is invalid. This code is only useful for permanent failures. }; $rfc1893{'X.1.2'} = qq { X.1.2 Bad destination system address The destination system specified in the address does not exist or is incapable of accepting mail. For Internet mail names, this means the address portion to the right of the "@" is invalid for mail. This codes is only useful for permanent failures. }; $rfc1893{'X.1.3'} = qq { X.1.3 Bad destination mailbox address syntax The destination address was syntactically invalid. This can apply to any field in the address. This code is only useful for permanent failures. }; $rfc1893{'X.1.4'} = qq { X.1.4 Destination mailbox address ambiguous The mailbox address as specified matches one or more recipients on the destination system. This may result if a heuristic address mapping algorithm is used to map the specified address to a local mailbox name. }; $rfc1893{'X.1.5'} = qq { X.1.5 Destination address valid This mailbox address as specified was valid. This status code should be used for positive delivery reports. }; $rfc1893{'X.1.6'} = qq { X.1.6 Destination mailbox has moved, No forwarding address The mailbox address provided was at one time valid, but mail is no longer being accepted for that address. This code is only useful for permanent failures. }; $rfc1893{'X.1.7'} = qq { X.1.7 Bad sender's mailbox address syntax The sender's address was syntactically invalid. This can apply to any field in the address. }; $rfc1893{'X.1.8'} = qq { X.1.8 Bad sender's system address The sender's system specified in the address does not exist or is incapable of accepting return mail. For domain names, this means the address portion to the right of the "@" is invalid for mail. }; $rfc1893{'X.2.0'} = qq { X.2.0 Other or undefined mailbox status The mailbox exists, but something about the destination mailbox has caused the sending of this DSN. }; $rfc1893{'X.2.1'} = qq { X.2.1 Mailbox disabled, not accepting messages The mailbox exists, but is not accepting messages. This may be a permanent error if the mailbox will never be re-enabled or a transient error if the mailbox is only temporarily disabled. }; $rfc1893{'X.2.2'} = qq { X.2.2 Mailbox full The mailbox is full because the user has exceeded a per-mailbox administrative quota or physical capacity. The general semantics implies that the recipient can delete messages to make more space available. This code should be used as a persistent transient failure. }; $rfc1893{'X.2.3'} = qq { X.2.3 Message length exceeds administrative limit A per-mailbox administrative message length limit has been exceeded. This status code should be used when the per-mailbox message length limit is less than the general system limit. This code should be used as a permanent failure. }; $rfc1893{'X.2.4'} = qq { X.2.4 Mailing list expansion problem The mailbox is a mailing list address and the mailing list was unable to be expanded. This code may represent a permanent failure or a persistent transient failure. }; $rfc1893{'X.3.0'} = qq { X.3.0 Other or undefined mail system status The destination system exists and normally accepts mail, but something about the system has caused the generation of this DSN. }; $rfc1893{'X.3.1'} = qq { X.3.1 Mail system full Mail system storage has been exceeded. The general semantics imply that the individual recipient may not be able to delete material to make room for additional messages. This is useful only as a persistent transient error. }; $rfc1893{'X.3.2'} = qq { X.3.2 System not accepting network messages The host on which the mailbox is resident is not accepting messages. Examples of such conditions include an immanent shutdown, excessive load, or system maintenance. This is useful for both permanent and permanent transient errors. }; $rfc1893{'X.3.3'} = qq { X.3.3 System not capable of selected features Selected features specified for the message are not supported by the destination system. This can occur in gateways when features from one domain cannot be mapped onto the supported feature in another. }; $rfc1893{'X.3.4'} = qq { X.3.4 Message too big for system The message is larger than per-message size limit. This limit may either be for physical or administrative reasons. This is useful only as a permanent error. }; $rfc1893{'X.3.5'} = qq { X.3.5 System incorrectly configured The system is not configured in a manner which will permit it to accept this message. }; $rfc1893{'X.4.0'} = qq { X.4.0 Other or undefined network or routing status Something went wrong with the networking, but it is not clear what the problem is, or the problem cannot be well expressed with any of the other provided detail codes. }; $rfc1893{'X.4.1'} = qq { X.4.1 No answer from host The outbound connection attempt was not answered, either because the remote system was busy, or otherwise unable to take a call. This is useful only as a persistent transient error. }; $rfc1893{'X.4.2'} = qq { X.4.2 Bad connection The outbound connection was established, but was otherwise unable to complete the message transaction, either because of time-out, or inadequate connection quality. This is useful only as a persistent transient error. }; $rfc1893{'X.4.3'} = qq { X.4.3 Directory server failure The network system was unable to forward the message, because a directory server was unavailable. This is useful only as a persistent transient error. The inability to connect to an Internet DNS server is one example of the directory server failure error. }; $rfc1893{'X.4.4'} = qq { X.4.4 Unable to route The mail system was unable to determine the next hop for the message because the necessary routing information was unavailable from the directory server. This is useful for both permanent and persistent transient errors. A DNS lookup returning only an SOA (Start of Administration) record for a domain name is one example of the unable to route error. }; $rfc1893{'X.4.5'} = qq { X.4.5 Mail system congestion The mail system was unable to deliver the message because the mail system was congested. This is useful only as a persistent transient error. }; $rfc1893{'X.4.6'} = qq { X.4.6 Routing loop detected A routing loop caused the message to be forwarded too many times, either because of incorrect routing tables or a user forwarding loop. This is useful only as a persistent transient error. }; $rfc1893{'X.4.7'} = qq { X.4.7 Delivery time expired The message was considered too old by the rejecting system, either because it remained on that host too long or because the time-to-live value specified by the sender of the message was exceeded. If possible, the code for the actual problem found when delivery was attempted should be returned rather than this code. This is useful only as a persistent transient error. }; $rfc1893{'X.5.0'} = qq { X.5.0 Other or undefined protocol status Something was wrong with the protocol necessary to deliver the message to the next hop and the problem cannot be well expressed with any of the other provided detail codes. }; $rfc1893{'X.5.1'} = qq { X.5.1 Invalid command A mail transaction protocol command was issued which was either out of sequence or unsupported. This is useful only as a permanent error. }; $rfc1893{'X.5.2'} = qq { X.5.2 Syntax error A mail transaction protocol command was issued which could not be interpreted, either because the syntax was wrong or the command is unrecognized. This is useful only as a permanent error. }; $rfc1893{'X.5.3'} = qq { X.5.3 Too many recipients More recipients were specified for the message than could have been delivered by the protocol. This error should normally result in the segmentation of the message into two, the remainder of the recipients to be delivered on a subsequent delivery attempt. It is included in this list in the event that such segmentation is not possible. }; $rfc1893{'X.5.4'} = qq { X.5.4 Invalid command arguments A valid mail transaction protocol command was issued with invalid arguments, either because the arguments were out of range or represented unrecognized features. This is useful only as a permanent error. }; $rfc1893{'X.5.5'} = qq { X.5.5 Wrong protocol version A protocol version mis-match existed which could not be automatically resolved by the communicating parties. }; $rfc1893{'X.6.0'} = qq { X.6.0 Other or undefined media error Something about the content of a message caused it to be considered undeliverable and the problem cannot be well expressed with any of the other provided detail codes. }; $rfc1893{'X.6.1'} = qq { X.6.1 Media not supported The media of the message is not supported by either the delivery protocol or the next system in the forwarding path. This is useful only as a permanent error. }; $rfc1893{'X.6.2'} = qq { X.6.2 Conversion required and prohibited The content of the message must be converted before it can be delivered and such conversion is not permitted. Such prohibitions may be the expression of the sender in the message itself or the policy of the sending host. }; $rfc1893{'X.6.3'} = qq { X.6.3 Conversion required but not supported The message content must be converted to be forwarded but such conversion is not possible or is not practical by a host in the forwarding path. This condition may result when an ESMTP gateway supports 8bit transport but is not able to downgrade the message to 7 bit as required for the next hop. }; $rfc1893{'X.6.4'} = qq { X.6.4 Conversion with loss performed This is a warning sent to the sender when message delivery was successfully but when the delivery required a conversion in which some data was lost. This may also be a permanant error if the sender has indicated that conversion with loss is prohibited for the message. }; $rfc1893{'X.6.5'} = qq { X.6.5 Conversion Failed A conversion was required but was unsuccessful. This may be useful as a permanent or persistent temporary notification. }; $rfc1893{'X.7.0'} = qq { X.7.0 Other or undefined security status Something related to security caused the message to be returned, and the problem cannot be well expressed with any of the other provided detail codes. This status code may also be used when the condition cannot be further described because of security policies in force. }; $rfc1893{'X.7.1'} = qq { X.7.1 Delivery not authorized, message refused The sender is not authorized to send to the destination. This can be the result of per-host or per-recipient filtering. This memo does not discuss the merits of any such filtering, but provides a mechanism to report such. This is useful only as a permanent error. }; $rfc1893{'X.7.2'} = qq { X.7.2 Mailing list expansion prohibited The sender is not authorized to send a message to the intended mailing list. This is useful only as a permanent error. }; $rfc1893{'X.7.3'} = qq { X.7.3 Security conversion required but not possible A conversion from one secure messaging protocol to another was required for delivery and such conversion was not possible. This is useful only as a permanent error. }; $rfc1893{'X.7.4'} = qq { A message contained security features such as secure authentication which could not be supported on the delivery protocol. This is useful only as a permanent error. }; $rfc1893{'X.7.5'} = qq { A transport system otherwise authorized to validate or decrypt a message in transport was unable to do so because necessary information such as key was not available or such information was invalid. }; $rfc1893{'X.7.6'} = qq { A transport system otherwise authorized to validate or decrypt a message was unable to do so because the necessary algorithm was not supported. }; $rfc1893{'X.7.7'} = qq { X.7.7 Message integrity failure A transport system otherwise authorized to validate a message was unable to do so because the message was corrupted or altered. This may be useful as a permanent, transient persistent, or successful delivery code. }; return "\n" . '-' x 72 . "\n" . $rfc1893{$key} . "\n"; } sub default_cgi_template { return q { <h2>Manually Parse Bounces</h1> <form action="<!-- tmpl_var self_url -->"> <input type="checkbox" name="test" id="test" value="bounces" /><label for="test">Only Test</label> <p><label for="parse_amount">Review</label> <!-- tmpl_var parse_amount_widget --> Messages.</p> <input type="hidden" name="flavor" value="cgi_parse_bounce" /> <div class="buttonfloat"> <input type="submit" class="cautionary" value="Parse Bounces..." /> </div> <div class="floatclear"></div> </form> <p><strong>Note!</strong> <em>Parsing Bounces will parse bounces for all lists.</em></p> <hr /> <h2>Bounce Handler Configuration</h2> <table cellpadding="5"> <tr> <td> <p><strong>Your Bounce Handler POP3 Username:</strong> </td> <td> <p><!-- tmpl_var Username --></p> </td> </tr> <tr> <td> <p><strong>On:</strong> </p> </td> <td> <p> <!-- tmpl_var Server --></p> </td> </tr> </table> <hr /> <h2>List Configuration</h2> <!-- tmpl_if send_via_smtp --> <p>Mailing is being sent via: <strong>SMTP</strong>. <!-- tmpl_if set_smtp_sender --> <p>The SMTP Sender is being set to: <strong><!-- tmpl_var admin_email --></strong>. This should be the same address as the above <strong>Bounce Handler POP3 Username</strong></p> <!-- tmpl_else --> <p>The SMTP Sender has not be explicitly set. Bounces may go to the list owner (<!-- tmpl_var list_owner_email -->) or to a server default address.</p> <!--/tmpl_if--> <!--tmpl_else--> <p>Mailing is being sent via <strong>the sendmail command <!-- tmpl_if add_sendmail_f_flag -->'-f' flagged added<!--/tmpl_if--></strong>:</p> <blockquote> <p><em><!-- tmpl_var MAIL_SETTINGS --><!-- tmpl_if add_sendmail_f_flag --> -f<!--tmpl_var admin_email --><!--/tmpl_if--></em></p> </blockquote> <!--/tmpl_if--> }; } END { $parser->filer->purge; } =pod =head1 NAME Mystery Girl - A Bounce Handler For Dada Mail =head1 DESCRIPTION Mystery Girl intelligently handles bounces from Dada Mail list messages. Each message is first B<parsed>. The parsed email will then be B<examined> and an B<action> will be taken. The examination and action are set in a collection of B<rules>. These rules can be tweaked, added, removed and generally mucked about with. The usual action that is taken is to apply a, B<score> to the offending email address, everytime the address bounces back a message. Once the, B<Threshold> is reached, the email address is unsubscribed from the list. This usually means that it takes a few bounces from a particular email address to get it removed from a list. This gives a bit of wiggle room and makes sure an email address that is bouncing is bouncing for a fairly good reason, for example: it no longer exists. =head1 OBTAINING A COPY OF THIS PROGRAM Mystery Girl is located in the, I<dada/plugins> directory of the main Dada Mail distribution, under the name, B<dada_bounce_handler.pl> =head1 REQUIREMENTS These points are absolutely necessary. Please make sure you have them before you try to install this plugin: =over =item * Dada Mail 2.10.9 You'll want to always use the version of Mystery Girl that comes bundled with the version of Dada Mail you're using. Mixing and matching versions may lead to some weird happenings. You're safer using an older version of Mystery Girl, with a newer version of Dada Mail. =item * A POP3 Email Account Mystery Girl works by checking a bounce email address via the POP3 protocol. You will need to setup a new email address for Mystery Girl to check. I usually set up an account named, "bounces@yourdomain.com", where, "yourdomain.com" is the name of the domain Dada Mail is installed on. Currently, Mystery Girl only can use non-SSL-encrypted connections to a POP3 server listening to port 110. Some things to consider: =over =item * Do NOT use this address for anything but Mystery Girl's functions Meaning: don't periodically check it yourself. Doing so will not break Dada Mail, but it will stop Mystery Girl from working correctly. Why? Because sometimes checking a POP3 address will download the messages awaiting in the POP3 Inbox and remove them from this inbox. If you need to periodically check this inbox, make sure to have your mail reader set to B<not> automatically remove the mssages. =item * The email address MUST belong to the domain you have Dada Mail installed Meaning, if your domain is, "yourdomain.com", the bounce email address should be something like, "bounces@yourdomain.com". In other words, do not use a Yahoo! Gmail, or Hotmail account for your bounce address. This will most likely disrupt all regular mail sending in Dada Mail. =back =back =head1 RECOMMENDED These points are not required, but recommended to have to use Mystery Girl: =over =item * Ability to set Cron Jobs. Mystery Girl can be configured to run automatically by using a cron tab - In Other Words: a scheduled task. If you do not know how to set up a cron job, attempting to set one up for Dada Mail will result in much aggravation. Please read up on the topic before attempting! =item * Shell Access to Your Hosting Account Shell Access is sometimes required to set up a cronjob, using the: crontab -e command. You may also be able to set up a cron tab using a web-based control panel tool, like Cpanel. Shell access also facilitates testing of the program. =back =head1 Configuration There's a few things you need to configure in this script, they're all at the top. =over =item * Change the lib path I<If you are not planning on running Mystery Girl via a cron tab, kindly gloss over this section.> If you are planning on running Mystery Girl via a cron tab, you will have to change the Path to Dada Mail's Perl Libraries. B<NOTE> This is not the same as your path to Perl (which is usually #!/usr/bin/perl). I get this asked frequently. You will need to explicitly state where both your path to the regular Perl libs are, and the Dada Mail libraries are. For example: use lib qw( /home/myaccount/www/cgi-bin/dada /home/myaccount/www/cgi-bin/dada/DADA /home/myaccount/www/cgi-bin/dada/DADA/perllib /usr/local/lib/perl5/site_perl/5.8.0/mach /usr/local/lib/perl5/site_perl/5.8.0 /usr/local/lib/perl5/site_perl /usr/local/lib/perl5/5.8.0/BSDPAN /usr/local/lib/perl5/5.8.0/mach /usr/local/lib/perl5/5.8.0 ); If you don't know where your Perl library is, trying running this via the command line: perl -e 'print $_ ."\n" foreach @INC'; If you do not know how to run the above command, visit Dada Mail in a web browser, log into your list and on the left hand menu and: click, B<About Dada Mail> Under B<Script Information>, click the, B<More...> link and under the, B<Perl Library Locations>, select each point that begins with a, "/" and use those as your site-wide path to your perl libraries. =item * POP3 server information. Your bounce email address login information is saved in the, B<dada_bounce_handler.pl> script itself - You need to change the B<$Server>, B<$Username> and B<$Password> variables to reflect the permissions for the email address you're going to use for the bounce handler. =back As far as required changes, that's it. We'll get to interesting optional things further down the line. =head1 Installation =head2 Setting up Mystery Girl to run as a CGI script I<(Optional)> Originally, Mystery Girl was a purely command line tool, to be used either on the command line, or run via a crontab. Now, you may run Mystery Girl via your web browser. Mystery Girl acts like a Dada Mail plugin. Usually, you'll set up Dada Mail in your cgi-bin: in your cgi-bin, there's a directory called, "dada". Inside the, "dada" directory, there are at least two directories, one called, "DADA" (uppercase) and the mail.cgi script. In the, "dada" directory, create a new directory called, "plugins". Upload the dada_bounce_handler.pl script, already configured, into this directory. Change its permissions to, "755". Visit the script in your web browser. To run the bounce handler on your bounced messages, click the, B<Parse Bounces...> button. Before the bounce handler will work, Dada Mail has to know to use it. Jump down to, B<Telling Dada Mail to use the Bounce Handler> for instructions on how to do that. If you would like have a link on the left hand side of the list control panel, find the following line in the Config.pm: # {-Title => 'Bounce Handler', # -Title_URL => $PLUGIN_URL."/dada_bounce_handler.pl", # -Function => 'dada_bounce_handler', # -Activated => 1, # }, And uncomment it (Take off the, "#" on each line). =head2 Setting up Mystery Girl to run via the command line. If you are not going to set up this program as a cgi script, I would just make a directory in your home directory and place the script there. If you've set up Dada Mail as outlined in the Magic Book, you may want to make another directory in the .dada_files directory, called .scripts, and install this script in there. You can still install the bounce handler in the, I<cgi-bin/dada/plugins/> directory as it's a nice convenience to run the program as both a command line/cronjob and also as a Dada Mail plugin. chmod 755 dada_bounce_handler.pl That's it as far as installation of the script. =head2 Running the script via the command line. Running the program without any arguments will have it check the mailbox for bounces, parse the messages and handle the bounces. ie: prompt>./dada_bounce_handler.pl I suggest before you do that, you test the dada_bounce_handler.pl. =head2 Testing You can pass the B<--test> argument to dada_bounce_handler.pl to make sure everything is workings as it should. The B<--test> argument needs to take one of a few paramaters: =over =item * pop3 prompt>./dada_bounce_handler.pl --test pop3 This will test only your POP3 login. If it's successful, it'll return the number of messages waiting: prompt>./dada_bounce_handler.pl --test pop3 POP3 Login succeeded. Message count: 5 If the login failed, you'll get back a message that reads: prompt>./dada_bounce_handler.pl --test pop3 POP3 login failed. =item * filename or directory if you pass an argument that's a filename, dada_bounce_handler.pl will attempt to parse that file as if it's a bounced message. If you pass a directory as an argument, dada_bounce_handler.pl will attempt to parse all the files in that directory as if they were bounced messages. dada_bounce_handler.pl won't act on these test messages, but will do everything until that point. You'll get back a verbose message of the going's on of the script: prompt> perl dada_bounce_handler.pl --test message8.txt test #1: message8.txt ------------------------------------------------------------ ------------------------------------------------------------------------ Content-type: multipart/report Effective-type: multipart/report Body-file: NONE Subject: Returned mail: see transcript for details Num-parts: 3 -- Content-type: text/plain Effective-type: text/plain Body-file: NONE -- Content-type: message/delivery-status Effective-type: message/delivery-status Body-file: NONE -- Content-type: message/rfc822 Effective-type: message/rfc822 Body-file: NONE Num-parts: 1 -- Content-type: text/plain Effective-type: text/plain Body-file: NONE Subject: Simoni Creative - Dada Mail Mailing List Confirmation -- ------------------------------------------------------------------------ List: skazat_design_newsletter Email: de4est@centurytel.net Last-Attempt-Date: Sun, 13 Apr 2003 20 Action: failed Status: 5.1.1 Diagnostic-Code: SMTP; 550 5.1.1 <de4est@centurytel.net>... User unknown Final-Recipient: RFC822; de4est@centurytel.net Remote-MTA: DNS; [209.142.136.158] Using Rule: default The first chunk of output is a skeleton of the bounced message. If it looks similar to what's above, you most likely gave the bounce handler a real email message. After that, will be listed the findings of the bounce handler. The List and Email address will be listed, followed by some diagnostic code. The last thing printed out is the rule, and we'll get to that shortly. =item * bounces Setting the test argument to B<bounces> will actually perform the test on any live bounce email messages in the mailbox. You'll see similar output that you would if you were testing a file. =back =head1 Setting The Schedule You could run dada_bounce_handler.pl every now and again from the command line, but you'd get very sick of it and I spent an entire weekend in May to write this script to be lazy. To accomplish that, you want to set this script to execute via a cron or scheduled, job. Here's what a theoretical cron tab for this script may look like: 0 1 * * * /usr/bin/perl /home/myaccount/cgi-bin/dada/plugins/dada_bounce_handler.pl >/dev/null 2>&1 This will run the script every day around 1am. You can run this script as often as you want, just be logical. I wouldn't run this script every five minutes, that's a bit overkill. Different hosts may have a control panel to set up crontabs, my host gives me the pleasure of the B<contrab> command. I type in: prompt> crontab -e and am launched into my favorite text editor to type in the crontab. =head1 Telling Dada Mail to use the Bounce Handler. You're going to have to tell Dada Mail explicitly that you want bounces to go to the bounce handler. The first step is to set the B<Dada List Administrator> to your bounce email address. You set this in the list control panel, under B<Change List Information> Once you do that, you need to tell Dada Mail that you want the correct headers in your list messages to say, "use the admin address for bounces" Usually, this means that the B<Return-path> header needs to be set. There are a few ways to accomplish this, some more preferable than others. =over =item * Setup using SMTP (prefered) If you're using SMTP sending, I almost guaruntee that this will work for you. In the list control panel, go to: B<Sending Options -> SMTP settings> and check the box labeled: B<Set the Sender of SMTP mailings to the list administration email address> =item * Setup using the Sendmail Command Your results will be mixed with this method, but it's worth a shot: =over =item * Technique 1: The -f flag In the list control panel, go to B<Sending Options -> Advanced> and check: B<Add the Sendmail '-f' flag when sending messages ...> This I<should> set the sending to the admin email, and in turn, set the B<Return-Path> header. =item * Technique 2: Return-Path header If that doesn't work, you can try to set the B<Return-Path> header explicitly. Go to: B<Sending Options -> Advanced> and check: B<Print the 'Return-Path' header in all list emails> This is generally a very bad, and stupid idea to do, but I've had great luck with it when the MTA is Qmail. I think Qmail allows you to do this. Go Qmail. =item * Technique 3: Errors-To header The Errors-To header seems to have been created just for this task, but it's actually a B<deprecated> header, so use with caution. For it to do anything, you need to configure Sendmail to actually see the Errors-To header. I don't recommend using this header, but if all else fails, go to: B<Sending Options -> Advanced> and check: B<Print the 'Errors-To' header in all list emails> =back =back To test out any of these configurations, Send yourself a test message and view the source of the message itself, in your mail reader. In the mail headers, you should see the B<Return-Path> header: Return-Path: <dadabounce@myhost.com> Delivered-To: justin@myhost.com Received: (qmail 75721 invoked from network); 12 May 2003 04:50:01 -0000 Received: from myhost.com (208.10.44.140) by hedwig.myhost.com with SMTP; 12 May 2003 04:50:01 -0000 Date:Sun, 11 May 2003 23:50:01 -0500 From:justin <justin@myhost.com> Subject:Test, Test, Test To:justin@myhost.com Sender:dadabounce@myhost.com Reply-To:justin <justin@myhost.com> Precedence:list Content-type:text/plain; charset=iso-8859-1 Notice that the first line has the B<Return-Path> header, correctly putting my bounce email address. My List Owner address, justin@myhost.com still occupies the To: and Reply-To headers, so whoever replies to my message will reply to me, not the bounce handler. Once you've dialed in your list to use the bounce handler, you should be all set. =head1 Optional Fun Things There's a slew of optional arguments you can give to this script: =over =item * pop3 server params: --server --username --password You can pass the POP3 server params to the script via these options. The arguments passed will writeover any set in the script. This comes in handy if, say, you're not comfortable putting the POP3 password in the script itself. You may be crafty and have the password saved in a more secure location and created a wrapper script that then calls this script - I'll leave that to your imagination. But anyways: prompt>./dada_bounce_handler \ --server mail.myhost.com\ --username dadabounce\ --password secretgodmoney All three of these options are optional and you can use them with any of the tests, discussed above. =item * --verbose passing the --verbose parameter is like giving this script some coffee. Similar to what you'd see if you ran the script using: prompt>./dada_bounce_handler --test bounces But bounce handling will go through to completion. =item * --help Obligatory help text printed out. Written as geeky as possible. =item * --version Will print out both the version of Mystery Girl and also of Dada Mail. Good for debugging. Looks like this: Mystery Girl version: 1.6 Dada Mail version: 2.10.9 =item * --log If you pass a filename to the script, it'll write a log of the action it takes per email. A log entry looks much like this: [Sun May 11 16:57:23 2003] justin unsubscribe_bounced_email from_list \ fdsafsa890sadf89@hotmail.com Status: 5.x.y, Action: , The format is: time \t list \t action \t email \t diagnostics If you don't want to pass the log each time, you can set a log in the B<$Log> variable - =over =item * Nifty Tip If you explicitly set the B<$LOGS> Config.pm variable to an absolute path to a directory, set $Log (in this script) to: my $Log = $LOGS . '/bounces.txt'; If you're using the Log Viewer plugin (part of the MagicBook), the plugin will automatically find this file and add it to the logs it will show. =back =item * --messages I decided that it would be silly to run dada_bounce_handler.pl by blindly trying to handle every bounced message that may be waiting for it every time its run. Perhaps you have a list that created 1,000 bounces (not unheard of), rummaging through 1,000 messages may take time, so instead, I encourage you to set how many messages should be looked at every time the script is run. I like to use this as a final test; I can test one real message towards completion and make sure everything is OK. If you do want to handle, say 1000 messages at a day, I would suggest to set the number of messages it handles to something like 100 and set your cronjob to run 10 times, perhaps 15 minutes apart. Your call, though. =item * --erase_score_card Removes the score card of bounced email addresses. This makes sense, once you read, "More on Scores..." thingy below. =back =head2 Rules, Rule! dada_bounce_handler.pl figures out what to do with the bounce messages receives by consulting a group of rules. These rules are highly configurable, so if you need to change the behavior of this script, you don't have to change the code. These rules are stored in the B<$Rules> hashref. An example rule: { exim_user_unknown => { Examine => { Message_Fields => { Status => [qw(5.x.y)], Guessed_MTA => [qw(Exim)], }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { add_to_score => $Default_Hard_Bounce_Score, }, } }, B<exim_user_unknown> is the title of the rule - just a label, nothing else. B<Examine> holds a set of parameters that the handler looks at when trying to figure out what to do with a bounced message. This example has a B<Message_Fields> entry and inside that, a B<Status> entry. The B<Status> entry holds a list of status codes. The ones in shown there all correspond to hard bounces; the mailbox probably doesn't exist. B<Message_Fields> also hold a, B<Guessed_MTA> entry - it's explicitly looking for a bounce back from the, I<Exim> mail server. B<Examine> also holds a B<Data> entry, which holds the B<Email> or B<List> entries, or both. Their values are either 'is_valid', or 'is_invalid'. So, to sum this all up, this rule will match a message that has B<Status:> B<Message Field> contaning a user unknown error code, B<(5.1.1, etc)> and also a B<Guessed_MTA> B<Message Field> containing, B<Exim>. The message also has to be parsed to have found a valid email and list name. Pretty Slick, eh? If this all matches, the B<Action> is... acted upon. In this case, the offending email address will be appended a, B<Bounce Score> of, whatever, B<$Default_Hard_Bounce_Score>, which is by default, B<4>. If you would like to have the bounced address automatically removed, without any sort of scoring happening, change the B<action> from, add_to_score => $Default_Hard_Bounce_Score to: unsubscribe_bounced_email => 'from_list' Also, changing B<from_list>, to B<from_all_lists> will do the trick. I could change the line: unsubscribe_bounced_email => 'from_list', to: mail_list_owner => 'user_unknown_message' This will, instead of deleting the email automatically, send a message to the list owner, stating that, "Hey, the message bounced, what do you want to do?" Another example: { over_quota => { Examine => { Message_Fields => { Status => [qw(5.2.2)] }, Data => { Email => 'is_valid', List => 'is_valid', } }, Action => { mail_list_owner => 'over_quota_message', }, } This time, I created a list for messages that get bounced because the mailbox is full. This is still considered a hard bounce, but I don't want the subscriber removed because they haven't check their inbox during the week. In this case, the B<Action> has been set to: mail_list_owner => 'over_quota_message', Which will do what it sounds like, it'll mail the list owner a message explaining the circumstances. Here's a schematic of all the different things you can do: { rule_name => { Examine => { Message_Fields => { Status => qw([ ]), Last-Attempt-Date => qw([ ]), Action => qw([ ]), Status => qw([ ]), Diagnostic-Code => qw([ ]), Final-Recipient => qw([ ]), Remote-MTA => qw([ ]), # etc, etc, etc }, Data => { Email => 'is_valid' | 'is_invalid' List => 'is_valid' | 'is_invalid' } }, Action => { add_to_score => $x, # where, "$x" is a number mail_list_owner => 'user_unknown_message', mail_list_owner => 'email_not_found_message', mail_list_owner => 'over_quota_message', unsubscribe_bounced_email => 'from_list' | 'from_all_lists', }, }, Mystery Girl also supports the use of regular expressions for matching any of the B<Message_Fields>. To tell the parser that you're using a regular expression, make the Message_Field key end in '_regex': 'Final-Recipient_regex' => [(qr/RFC822/)], Setting rules is sort of the super advanced part of the configuration, but it may come in handy. =head1 More on Scores, Thresholds, etc We talked about scoring, but not in great detail, so let's do that: By default, The Bounce Handler assigns a particular score to each email address that bounces back a message. These scores are tallied each time an email address bounces a message. Since Dada Mail understands the differences between B<Hard Bounces> and B<Soft Bounces>, it'll append a smaller score for soft bounces, and a larger score for hard bounces. Once the email address's B<Bounce Score> reaches the B<Threshold>, the email address is then removed from the list. You can manipulate the Soft and Hard Bounce Scores and Threshold pretty easily. On the top of this script, you'll see the necessary variables to tweak, =over =item * $Default_Soft_Bounce_Score =item * $Default_Hard_Bounce_Score =item * $Score_Threshold =back Fairly self-explanitory. If you want even greater control over what kind of bounces give what scores, you can manipulate the B<Bounce Rules> themselves, as described above. Some things to understand: Currently, Scores are B<Global> - they work for all lists at once. Once an email address reaches the B<Threshold>, they will be removed from B<all lists> that are handled by Dada Mail. In one sense, this seems limiting, but if an email address is not receiving mail from one list, or doesn't exist, it doesn't have much worth on any list of yours. If you would like to periodically erase the saved scores, you may do so, by running this script via the command line, like so: ./dada_bounce_handler.pl --erase_score_card =head1 FAQs =over =item * Does the bounce handler differentiate between "hard' bounces and 'soft' bounces? Yes. Because of the Rules, you can set what happens, depending on what type of bounce you receive. By default, the bounce handler is set up to think, "hard bounces" are email addresses that are invalid because they simply don't exist, and soft bounces as email addresses that because the email box is full, or there was some sort of problem actually sending the message to the subscriber. Dada Mail basically works by saying, I<After x amount of bounces, just remove from the list.> =item * I keep getting, 'permission denied' errors, what's wrong? It's very possible that Mystery Girl can't read your subscription database or the list settings database. This is because Dada Mail may be running under the webserver's username, usually, B<nobody>, and not what Mystery Girl is running under, usually your account username. You'll need to do a few things: =over =item * Change the permissions of the list subscription and settings databases You'll most likely need to change the permissions of these files to, '777'. PlainText subscription databases have the format of B<listshortname.list> and are usually located where you set the B<$FILES> Config file variable. .List settings Databases have the format of B<mj-listshortname> and are usually located in the same location. =item * Change the $FILE_CHMOD variable So you don't need to change the permissions of the list files for every new list you create, set the $FILE_CMOD Config variable to 0777: $FILE_CHMOD = 0777; Notice there are no quotes around 0777. =back =item * The program is working great; but bounces aren't being handled at all Make sure that you have checked, B<Print list-specific headers in all list emails> in Sending Options -> Advanced. Mystery Girl uses the I<List> header to figure out what list the bounce is coming from. =item * I found a bug in this program, what do I do? Report it to the bug tracker: http://sourceforge.net/tracker/?group_id=13002&atid=113002 =item * I keep getting this bounced message, but Mystery Girl isn't handling it, what do I do? You'll most likely have to make a new rule for it. If you want, attach a copy of the bounced message to the bug tracker: http://sourceforge.net/tracker/?group_id=13002&atid=113002 And we'll see if we can't get that kind of bounce in a new version. =item * What's up with the name, Mystery Girl? It's from a I<Yeah Yeah Yeahs> song: B<Mystery Girl>. A bounce handler is sort of a mysterious tool, making decisions for you and a mysterious girl just seems to be one full of power and allusion. The song itself is about rejecting a guy that just doesn't make it anymore, so that gives a good metaphor to a bounced mail, in a slightly weird, nerdy, nerdy, nerdy... artsy way. When the bounce handler emails a list owner, you can do nothing but answer back to it. Yeah Yeah Yeah. B<(colophon)> Actually, the lyrics I'm thinking of aren't from the song, Mystery Girl, but from the song, "Bang!" off of the YYY's self titled release. Mystery Girl is the next song on that album. The song after that is one called, "Art Star", which is what I am in the daytime! The next song is called, "Miles Away", which is where you probably are to me. All this in, "Our Time" (the last song) See? it's like this was all written in the stars. http://yeahyeahyeahs.com Here's a small clip of the YYY's performing "Mystery Girl" at the Gothic on 11.20.03 that I took: http://mojo.skazat.com/media/YYYs_Mystery_Girl_Clip.mov hot! =back =head1 History I<NOTE: Most of the history of this program is located in the main Dada Mail changelog.> =over =item * 1.4 5/05 Black List Settings should be honored by Mystery Girl now. 1.3 *says* they were, I tend not to believe that. VERP support was added to Dada Mail. This should make finding what email bounced the message easier. The MIME-Tools CPAN Perl Module collection is included with Dada Mail now! You do NOT have to install it manually anymore! =item * 1.3 11/12/04 Bugfix: Emails were not added to the blacklist if the prefs deemed that so. Lots of other stuff too. Lots. =item * 1.2 1/1/04 initial support for Microsoft Exchange and Novell Groupware. Much better support for Exim and Qmail; more Rules added. Bugs fixed, spirits lifted. Huzzah! =item * 1.1 10/6/03 Much work was done to relieve this particular error: Can't use an undefined value as an ARRAY reference at dada_bounce_handler.pl There was also a small issue were either the list or email were found in the bounce, but this information was thrown away if both weren't found in some instances. This should be fixed and allow some better bounce handling for Exim and Postfix users. More Rules have added =item * 1.0 9/20/03 There was a small bit of debug code still in the program - erased that. I also added to the FAQ. =item * .9 7/6/03 There was a bug with the B<unknown_bounce_type_message>, mailing, the body and the subject were mixed up, so, you'd get the body of the message as the subject, and the subject as the body. How humiliating. That should be B<fixed>. I also added a few more rules, the B<delivery_error_550> was much too strict, as not all bounced messages have a Diagnostic Code; so I made another rule that's very similar, but doesn't have the <Diagnostic-Code_regex> Emails sent from Mystery Girl to a list owner now should have a description of what the status of a bounce means, if there is a Status. This should allow someone to have a better idea on what they should do with a report from Mystery Girl. All descriptions have been taken right out of rfc1893: http://www.ietf.org/rfc/rfc1893.txt =item * .8 - 6/26/03 The new Exim and Qmail rules weren't really working. ... Why not? Well, Mystery Girl really didn't know about anything * but * the "Status" and "Action" Message Fields. Furthermore, I didn't follow my own scheme for the bounce rules and put Qmail and Exim as a scalar, not an array ref. So, now Mystery Girl knows about the Guessed_MTA message field, and should know about every other one as well. If you were having trouble having your own rules work, above is why. Everything should be patched up and fixed. The new code is actually half the size and works much better. Go... stuff! Furthermore, I've changed the format of the rules, The Rules themselves are a array ref, instead of a hash ref, which means that the rules are tried in order. I've also added regular expression function to Examine, if you have a message field, say, Status, that you want to do a regular expression on, you can say this: Status_regex => [(qr/^5(\.0\.0|\.1\.1)$/)], instead of: Status => [qw(5.0.0 5.1.1)]; This version was introduced in Dada Mail 2.8.8, it should work for any version of Dada Mail from 2.8.5 on. =item * .7 - 6/5/03 Exim support has been added. Thanks to Tracy Gibson (sf: tntmom5) and Adam Henry hank _at_ marinar.com for the exim reports. I also added a separate rule for both qmail and Exim, since both don't produce real status codes, just '5.x.y' or '4.x.y', you may, for some reason, treat these as special cases. I also added a new flag, B<--version>, so you can report just exactly what version you have of the proggy. =item * .6 - 5/22/03 Ok, I need sleep. Fixed a mispelling in a method call on guess what line? 440? THAT is fixed. No even amusingly funny comments about how this script should work now. I<It is a common experience that a problem difficult at night is resolved in the morning after a committee of sleep has worked on it. > - B<John Steinbeck> I also took the -w flag off, since it was creating some line noise i'll deal with sooner than later. =item * .5 - 5/21/03 Fixed another stupid bug. (line 440) Script should work now should work... =item * .4 - 5/21/03 see that note in .2 that said it "should" work? Well, it didn't, since the change wasn't applied. Now it is. No for real. =item * .3 - 5/20/03 Removed some list debug code. Fix fix from yesterday ( released with 2.8.6 as well) =item * .2 - 5/19/03 The script should work... now. Tweaked the rules a bit to be more lenient. Edited the docs a bit First inclusion into main Dada Mail distro ( 2.8.6 ) =item * .1 - 5/11/03 Initial Release .1 =back =head1 To Do Perhaps think about making filters specifically for Postfix. They seem to have their own way of doing things, like Qmail. Add onto that custom a filter for AOL/Compuserve/Netscape =head1 Thanks Thanks to: Jake Ortman Henry Hughes for some prelim bounce examples. Thanks to Eryq ( http://www.zeegee.com ) for the amazing MIME-tools collection. It's a gnarly group of modules. =head1 COPYRIGHT Copyright (c) 1999 - 2006 Justin Simoni http://justinsimoni.com All rights reserved. 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; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. Parts of this script were swiped from Mail::Bounce::Qmail module, fetched from here: http://mikoto.sapporo.iij.ad.jp/cgi-bin/cvsweb.cgi/fmlsrc/fml/lib/Mail/Bounce/Qmail.pm The copyright of that code stated: Copyright (C) 2001,2002,2003 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. Thanks Ken'ichi =cut
cvs-admin@eby-sarna.com Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |