#!/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

); 
	
my $Server   = '';
my $Username = ''; 
my $Password = '';


use DADA::Config;
#---------------------------------------------------------------------#
my $Log = $LOGS . '/bounces.txt';

# leave blank to be sent to the list's list owner.
my $Send_Messages_To = undef; 

my $MessagesAtOnce = 100; 
 

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|mailbox full|disk quota exceeded|Mail quota exceeded|Quota violation/)]	
			},
				
			Data => { 
				Email => 'is_valid', 
				List  => 'is_valid',
			}
		},
		Action => { 
			mail_list_owner => 'over_quota_message', 
		}
	}
},


{	
	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', 
		}
	}
},



{
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', 
		}
	}
},




{
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', 
		}
	}
},




{
	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', 
		}
	}
},


{
	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', 
		}
	}
},


{	
	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|mailbox full|storage full/)],
					
			},
				
			Data => { 
				Email => 'is_valid', 
				List  => 'is_valid',
			}
		},
		Action => { 
			mail_list_owner => 'over_quota_message', 
		}
	}
},


{	
	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 => { 
			# TODO:
			# Not sure what to put here ATM. 
		}
	}
},




{	
	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', 
		}
	}
},


{	
	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', 
		}
	}
},





{	
	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', 
		}
	}
},


{
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', 
		}
	}
},





{ 
	# 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', 
		}
	}
},





{ 
	# 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', 
		}
	}
},





{
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', 
		} 
	}
}, 





{
	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', 
		}
	}
},





{ 
	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', 
		}
	}
},





{ 
	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', 
		}
	}
},


{ 
	# 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', 
		}
	}
},


{
	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', 
			}, 
		}
}, 




{
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', 
		} 
	}
},




#{
#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', 
#		} 
#	}
#}, 





{
# 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', 
	},
	}
},	





{

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', 
		}
	}
},





{
	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', 
		},
	}
},	





{
	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', 
		},
	}
},	




{
	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', 
		},
	}
},	





{
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', 
		},
	}
},	




{
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', 
#					},
#					}
#},	



{ 

	unknown_bounce_type => {
					Examine => { 
						Data => { 
							Email => 'is_valid', 
							List  => 'is_valid', 
						},
					}, 
					Action => { 
						mail_list_owner => 'unknown_bounce_type_message', 
						#append_message_to_file => $Log,
					}
					
					}
},



{
	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

}; 



#---------------------------------------------------------------------#
# Nothing else to be configured.                                      #


my $App_Version = '1.5';

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,									
);


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 $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, 
		   "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(defined($test) && $test ne 'bounces'){
		test_script(); 
	}elsif(defined($version)){ 
		&version(); 
	}
	
	print "Making POP3 Connection...\n" if $verbose; 
	
	my $pop = Net::POP3->new($Server) 
		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) 
				 	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(); 
	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"; 
	}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; 
		}	

		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 $entity->as_string;
		
		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 '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 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];	
	
	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')) ){ 
		warn "parsed message contains an email ($email) that's not even subscribed. No reason to tell list owner";
	}else{ 
	
		my $report        = generate_nerd_report($list, $email, $diagnostics); 
		my $status_report = rfc1893_status($diagnostics->{Status});
		
		
		my $unsub_link = DADA::App::Guts::unsubscribe_link(-email   => $email,
														   -list    => $list,  
														   -make_pin => 1);
															
		$Body =~ s/\[report\]/$report/i; 
		$Body =~ s/\[status_report\]/$status_report/i; 
		
		$Body =~ s/\[list_unsubscribe_link\]/$unsub_link/g; 
		
		#}
		$Body = DADA::App::Guts::interpolate_string(-String      => $Body, 		
													-List_Db_Ref => $li, 
													-Email       => $email); 		
		
		my $mh = DADA::Mail::Send->new($li); 
	 
		my $to  = $Send_Messages_To || $li->{list_owner_email}; 
		
		my $msg = MIME::Entity->build(To      => $to, 
									  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); 
		
		$mh->send(
				  # Trust me on these :) 
				  $mh->return_headers($msg->stringify_header),
				  'X-BounceHandler' => $Bounce_Handler_Name,
				  Body => $msg->stringify_body
				 );

		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 carry_out_all_rules { 
#	my $array_ref = shift; 
#	foreach my $dead(@$Rules_To_Carry_Out){
#		 carry_out_rule(@$dead); #hope this works
#	}
#
#}




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; 
		
		
		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); 
					
			}
			
			
			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); 
					
					DADA::App::Messages::send_unsubscription_email(-List      => $list,
											                       -Email     => $d_email,
									                               -List_Info => $li); 
					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 - suppressing actions... \n"
						if $verbose;
				}
			}
		}

			
		# 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 
		
		
	}
	
}




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 = Net::POP3->new($Server) 
		or warn "Connection to '$Server' wasn't successful: $!";
	
	if(!$pop){ 
		print "Couldn't estabilish a connection to $Server!\n";
	}else{	
		my $messagecount;
		
		eval {require Digest::MD5};
		if(!$@){ 
			print "Trying secure login...\n";
			$messagecount = $pop->apop($Username,$Password);			
			if(!$messagecount){ 
				print "Hmm, secure login failed, switching to regular login...\n";
				 $pop = Net::POP3->new($Server) 
				 	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: $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 "$!"; 
	{
		local $/ = undef;
		$data = <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
--version
-----------------------------------------------------------
for instructions, try:

pod2text ./dada_bounce_handler.pl | less


-----------------------------------------------------------

};
	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. 

=head1 OBTAINING A COPY OF THIS PROGRAM

Mystery Girl is located in the, I<dada/extensions> 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 extension: 

=over

=item * Dada Mail 2.10

Do not use this copy of Mystery Girl with a lesser 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. 

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. 

=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

=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 by a crontab. 

Now, you may run Mystery Girl via your web browser. Mystery Girl acts like a Dada Mail plugin. 

If you are not planning on running Mystery Girl as a crontab, you will need to set up Mystery Girl in the following way: 

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 on 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. 

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 con
or scheduled, job. Here's what a theoretical cron tab for this script
may look like: 

 0  1   *   *  * /usr/bin/perl /home/myaccount/dada_scripts/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

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

Obligory 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: .7
 Dada Mail version: 2.8.5


=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. 

=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:

 {
 user_unknown => {
	 Examine => {
		Message_Fields => {
			Status => [qw(5.1.1 550 5.x.y)]
		},
		Data => { 
			Email => 'is_valid', 
			List  => 'is_valid',
		}
	},
	Action => { 
		unsubscribe_bounced_email => 'from_list', 
	},
}

B<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<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). 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 
email will be unsubscribed from the list. We could tell the bounce handler
to unsubscribe the message from all the lists that Dada Mail handles, since, hey, 
if the email address isn't valid anymore, why wait for your other lists to find out? 
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 => { 
			   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 
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 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
automatically remove bounces because the email address is invalid, and
email you alerting you of a bounce if the bounce is because a email box
is full. 

You cannot say, "After x amount of bounces, just remove from the list." 
The reson behind this is the subscription database only holds the email
address and doesn't support any other fields. I'm working on that. 

=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 - 2005 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