#!/usr/bin/perl package bounce_handler; use strict; $|++; #---------------------------------------------------------------------# # bounce_handler # # Documentation: # # https://dadamailproject.com/d/bounce_handler.html # #---------------------------------------------------------------------# BEGIN { if ( $] > 5.008 ) { require Errno; require Config; } } $ENV{PATH} = "/bin:/usr/bin"; delete @ENV{ 'IFS', 'CDPATH', 'ENV', 'BASH_ENV' }; use FindBin; use lib "$FindBin::Bin/../"; use lib "$FindBin::Bin/../DADA/perllib"; BEGIN { my $b__dir = ( getpwuid($>) )[7] . '/perl'; push @INC, $b__dir . '5/lib/perl5', $b__dir . '5/lib/perl5/x86_64-linux-thread-multi', $b__dir . 'lib', map { $b__dir . $_ } @INC; } use CGI::Carp qw(fatalsToBrowser); use DADA::Config; use DADA::App::Guts; use DADA::Mail::Send; use DADA::MailingList::Subscribers; use DADA::MailingList::Settings; use DADA::Template::HTML; use DADA::App::BounceHandler; my $Plugin_Config = { Connection_Protocol => 'POP3', Server => undef, Username => undef, Password => undef, Port => 'AUTO', USESSL => 0, AUTH_MODE => 'POP', starttls => 0, SSL_verify_mode => 0, Log => $DADA::Config::LOGS . '/bounces.txt', MessagesAtOnce => 100, Max_Size_Of_Any_Message => 2621440, Enable_POP3_File_Locking => 1, Plugin_URL => $DADA::Config::S_PROGRAM_URL . '?flavor=plugins&plugin=bounce_handler', Plugin_Name => 'Bounce Handler', }; #---------------------------------------------------------------------# # Nothing else to be configured. # use Getopt::Long; use MIME::Entity; use Fcntl qw( O_CREAT O_RDWR LOCK_EX LOCK_NB ); my $debug; my $help; my $test; my $connection_protocol; my $server; my $username; my $password; my $verbose; my $log; my $messages; my $erase_score_card; my $version; my $list; my $admin_list; my $root_login; sub reset_globals { $debug = 0; $help = 0; $test = undef; $connection_protocol = undef; $server = undef; $username = undef; $password = undef; $verbose = 0; $log = undef; $messages = 0; $erase_score_card = 0; $version = undef; $list = undef; $admin_list = undef; $root_login = undef; } &init_vars; run() unless caller(); sub init_vars { # DEV: This NEEDS to be in its own module - perhaps DADA::App::PluginHelper or something? while ( my $key = each %$Plugin_Config ) { if ( exists( $DADA::Config::PLUGIN_CONFIGS->{Bounce_Handler}->{$key} ) ) { if ( defined( $DADA::Config::PLUGIN_CONFIGS->{Bounce_Handler}->{$key} ) ) { $Plugin_Config->{$key} = $DADA::Config::PLUGIN_CONFIGS->{Bounce_Handler}->{$key}; } } } } sub init { $Plugin_Config->{Connection_Protocol} = $server if $server; $Plugin_Config->{Server} = $server if $server; $Plugin_Config->{Username} = $username if $username; $Plugin_Config->{Password} = $password if $password; $Plugin_Config->{Log} = $log if $log; $Plugin_Config->{MessagesAtOnce} = $messages if $messages > 0; if ($test) { $debug = 1 if $test eq 'bounces'; } $verbose = 1 if $debug == 1; } sub test_sub { return 'Hello, World!'; } sub run { my $q = shift; reset_globals(); if ( !$ENV{GATEWAY_INTERFACE} ) { my $r = cl_main(); if ( $verbose || $help || $test || $version ) { print $r; } exit; } else { return cgi_main($q); } } sub test_sub { return "Hello, World!"; } sub cgi_main { my $q = shift; if ( keys %{ $q->Vars } && $q->param('run') && xss_filter( scalar $q->param('run') ) == 1 && $Plugin_Config->{Allow_Manual_Run} == 1 ) { return ( {}, cgi_manual_start() ); } else { my $prm = $q->param('prm') || 'cgi_default'; my $function = 'bounce_handler'; if($prm eq "cgi_bounce_score_search"){ $function .= ' tracker'; } ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => $function, ); $list = $admin_list; my $ls = DADA::MailingList::Settings->new( { -list => $list } ); my $li = $ls->get(); my %Mode = ( 'cgi_default' => \&cgi_default, 'cgi_parse_bounce' => \&cgi_parse_bounce, 'cgi_scorecard' => \&cgi_scorecard, 'export_scorecard_csv' => \&export_scorecard_csv, 'cgi_bounce_score_search' => \&cgi_bounce_score_search, 'cgi_show_plugin_config' => \&cgi_show_plugin_config, 'ajax_parse_bounces_results' => \&ajax_parse_bounces_results, 'manually_enter_bounces' => \&manually_enter_bounces, 'cgi_erase_scorecard' => \&cgi_erase_scorecard, 'edit_prefs' => \&edit_prefs, ); if ( exists( $Mode{$prm} ) ) { return $Mode{$prm}->($q); #call the correct subroutine } else { return cgi_default($q); } } } sub cgi_default { my $q = shift; my $ls = DADA::MailingList::Settings->new( { -list => $list } ); my $li = $ls->get(); my $done = $q->param('done') || 0; 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 ); require HTML::Menu::Select; my $bounce_handler_softbounce_score_popup_menu = HTML::Menu::Select::popup_menu( { name => 'bounce_handler_softbounce_score', values => [ ( 0 .. 10 ) ], default => $ls->param('bounce_handler_softbounce_score'), } ); my $bounce_handler_hardbounce_score_popup_menu = HTML::Menu::Select::popup_menu( { name => 'bounce_handler_hardbounce_score', values => [ ( 0 .. 10 ) ], default => $ls->param('bounce_handler_hardbounce_score'), } ); my $bounce_handler_decay_score_popup_menu = HTML::Menu::Select::popup_menu( { name => 'bounce_handler_decay_score', values => [ ( 0 .. 10 ) ], default => $ls->param('bounce_handler_decay_score'), } ); my $bounce_handler_threshold_score_popup_menu = HTML::Menu::Select::popup_menu( { name => 'bounce_handler_threshold_score', values => [ ( 0 .. 100 ) ], default => $ls->param('bounce_handler_threshold_score'), } ); my $curl_location = `which curl`; $curl_location = strip( make_safer($curl_location) ); my $parse_amount_widget = HTML::Menu::Select::popup_menu( { name => 'parse_amount', id => 'parse_amount', values => [@amount], default => $Plugin_Config->{MessagesAtOnce}, label => '', } ); my $plugin_configured = 1; if ( !defined( $Plugin_Config->{Server} ) || !defined( $Plugin_Config->{Username} ) || !defined( $Plugin_Config->{Password} ) ) { $plugin_configured = 0; } require DADA::MailingList::Subscribers; my $lh = DADA::MailingList::Subscribers->new( { -list => $list } ); my $ignore_bounces_list_count = $lh->num_subscribers( { -type => 'ignore_bounces_list' } ); require DADA::Template::Widgets; my $scrn = DADA::Template::Widgets::wrap_screen( { -screen => 'plugins/bounce_handler/default.tmpl', -with => 'admin', -expr => 1, -wrapper_params => { -Root_Login => $root_login, -List => $list, }, -vars => { screen => 'using_bounce_handler', MAIL_SETTINGS => $DADA::Config::MAIL_SETTINGS, Username => $Plugin_Config->{Username}, Server => $Plugin_Config->{Server}, Plugin_URL => $Plugin_Config->{Plugin_URL}, Plugin_Name => $Plugin_Config->{Plugin_Name}, Allow_Manual_Run => $Plugin_Config->{Allow_Manual_Run}, Manual_Run_Passcode => $Plugin_Config->{Manual_Run_Passcode}, curl_location => $curl_location, plugin_configured => $plugin_configured, parse_amount_widget => $parse_amount_widget, done => $done, bounce_handler_softbounce_score_popup_menu => $bounce_handler_softbounce_score_popup_menu, bounce_handler_hardbounce_score_popup_menu => $bounce_handler_hardbounce_score_popup_menu, bounce_handler_decay_score_popup_menu => $bounce_handler_decay_score_popup_menu, bounce_handler_threshold_score_popup_menu => $bounce_handler_threshold_score_popup_menu, ignore_bounces_list_count => $ignore_bounces_list_count, root_login => $root_login, }, -list_settings_vars_param => { -list => $list, -dot_it => 1, }, } ); return ( {}, $scrn ); } sub edit_prefs { my $q = shift; my $ls = DADA::MailingList::Settings->new( { -list => $list } ); my $also_save_for_list = $ls->also_save_for_list($q); $ls->save_w_params( { -associate => $q, -settings => { bounce_handler_softbounce_score => undef, bounce_handler_hardbounce_score => undef, bounce_handler_decay_score => undef, bounce_handler_threshold_score => undef, bounce_handler_forward_msgs_to_list_owner => 0, bounce_handler_forward_abuse_report_msgs_to_list_owner => 0, bounce_handler_send_unsub_notification => 0, bounce_handler_when_threshold_reached => undef, enable_ignore_bounces_list => 0, }, -also_save_for => $also_save_for_list, } ); return ( { -redirect_uri => $Plugin_Config->{Plugin_URL} . '&done=1' }, undef ); } sub ajax_parse_bounces_results { my $q = shift; if ( $q->param('test') ) { $test = $q->param('test'); } else { $test = undef; } if ( defined( xss_filter( scalar $q->param('parse_amount') ) ) ) { $Plugin_Config->{MessagesAtOnce} = xss_filter( scalar $q->param('parse_amount') ); } my $r = ''; $r .= '
';
$r .= encode_html_entities(scalar cl_main());
$r .= '';
return ( {}, $r );
}
sub cgi_parse_bounce {
my $q = shift;
require DADA::Template::Widgets;
my $scrn = DADA::Template::Widgets::wrap_screen(
{
-screen => 'plugins/bounce_handler/parse_bounce.tmpl',
-with => 'admin',
-wrapper_params => {
-Root_Login => $root_login,
-List => $list,
},
-vars => {
parse_amount => xss_filter( scalar $q->param('parse_amount') ),
test => xss_filter( scalar $q->param('test') ),
Plugin_Name => $Plugin_Config->{Plugin_Name},
Plugin_URL => $Plugin_Config->{Plugin_URL},
MessagesAtOnce => $Plugin_Config->{MessagesAtOnce},
},
}
);
return ( {}, $scrn );
}
sub cgi_manual_start {
my $q = shift;
# This is basically just a wrapper around, cl_main();
my $r = '';
if (
( xss_filter( scalar $q->param('passcode') ) eq $Plugin_Config->{Manual_Run_Passcode} )
|| ( $Plugin_Config->{Manual_Run_Passcode} eq '' )
)
{
my $verbose;
if ( defined( xss_filter( scalar $q->param('verbose') ) ) ) {
$verbose = xss_filter( scalar $q->param('verbose') );
}
else {
$verbose = 1;
}
if ( defined( xss_filter( scalar $q->param('test') ) ) ) {
$test = $q->param('test');
}
if ( defined( xss_filter( scalar $q->param('messages') ) ) ) {
$Plugin_Config->{MessagesAtOnce} =
xss_filter( scalar $q->param('messages') );
}
if ( defined( $q->param('list') ) ) {
$list = $q->param('list');
}
else {
$list = undef; # just to make that perfectly clear.
}
$r .= $q->header();
if ($verbose) {
$r .= '';
$r .= cl_main();
$r .= '';
}
else {
cl_main();
}
return $r;
}
else {
$r .= "$DADA::Config::PROGRAM_NAME $DADA::Config::VER Access Denied.";
}
return $r;
}
sub cgi_scorecard {
my $q = shift;
my $page = $q->param('page') || 1;
require DADA::App::BounceHandler::ScoreKeeper;
my $bsk = DADA::App::BounceHandler::ScoreKeeper->new( { -list => $list } );
my $num_rows = $bsk->num_scorecard_rows;
my $scorecard = $bsk->raw_scorecard(
{
-page => $page,
-entries => 100,
}
);
my $pager = undef;
my $pages_in_set = [];
require Data::Pageset;
my $page_info = Data::Pageset->new(
{
'total_entries' => $num_rows,
'entries_per_page' => 100, #$ls->param('tracker_record_view_count'), # needs to be tweakable...
'current_page' => $page,
'mode' => 'slide', # default fixed
}
);
foreach my $page_num ( @{ $page_info->pages_in_set() } ) {
if ( $page_num == $page_info->current_page() ) {
push( @$pages_in_set, { page => $page_num, on_current_page => 1 } );
}
else {
push( @$pages_in_set, { page => $page_num, on_current_page => undef } );
}
}
require DADA::Template::Widgets;
my $scrn = DADA::Template::Widgets::screen(
{
-screen => 'plugins/bounce_handler/scorecard.tmpl',
-vars => {
Plugin_URL => $Plugin_Config->{Plugin_URL},
Plugin_Name => $Plugin_Config->{Plugin_Name},
num_rows => $num_rows,
first_page => $page_info->first_page(),
last_page => $page_info->last_page(),
next_page => $page_info->next_page(),
previous_page => $page_info->previous_page(),
pages_in_set => $pages_in_set,
scorecard => $scorecard,
}
}
);
return ( {}, $scrn );
}
sub export_scorecard_csv {
my $q = shift;
require DADA::App::BounceHandler::ScoreKeeper;
my $bsk = DADA::App::BounceHandler::ScoreKeeper->new( { -list => $list } );
my $headers = {
-attachment => 'bounce_scorecard-' . $list . '-' . time . '.csv',
-type => 'text/csv',
};
return ( $headers, $bsk->csv_scorecard );
}
sub cgi_erase_scorecard {
require DADA::App::BounceHandler::ScoreKeeper;
my $bsk = DADA::App::BounceHandler::ScoreKeeper->new( { -list => $list } );
$bsk->erase;
return ( { -redirect_uri => $Plugin_Config->{Plugin_URL} }, undef );
}
sub cgi_show_plugin_config {
my $configs = [];
for ( sort keys %$Plugin_Config ) {
if ( $_ eq 'Password' ) {
push( @$configs, { name => $_, value => '(Not Shown)' } );
}
else {
push( @$configs, { name => $_, value => $Plugin_Config->{$_} } );
}
}
require DADA::Template::Widgets;
my $scrn = DADA::Template::Widgets::wrap_screen(
{
-screen => 'plugins/shared/plugin_config.tmpl',
-with => 'admin',
-wrapper_params => {
-Root_Login => $root_login,
-List => $list,
},
-vars => {
Plugin_URL => $Plugin_Config->{Plugin_URL},
Plugin_Name => $Plugin_Config->{Plugin_Name},
configs => $configs,
},
}
);
return ( {}, $scrn );
}
sub cgi_bounce_score_search {
my $q = shift;
my $query = xss_filter( scalar $q->param('query') );
my $chrome = 1;
if ( defined( $q->param('chrome') ) ) {
$chrome = $q->param('chrome') || 0;
}
if ( !defined($query) ) {
$q->redirect( -uri => $Plugin_Config->{Plugin_URL} );
return;
}
require DADA::App::BounceHandler::Logs;
my $bhl = DADA::App::BounceHandler::Logs->new;
my $results = $bhl->search(
{
-query => $query,
-list => $list,
-file => $Plugin_Config->{Log},
}
);
my $results_found = 0;
if ( $results->[0] ) {
$results_found = 1;
@$results = reverse(@$results);
}
require DADA::MailingList::Subscribers;
my $lh = DADA::MailingList::Subscribers->new( { -list => $list } );
my $valid_email = 0;
my $subscribed_address = 0;
if ( DADA::App::Guts::check_for_valid_email($query) == 0 ) {
$valid_email = 1;
if ( $lh->check_for_double_email( -Email => $query ) == 1 ) {
$subscribed_address = 1;
}
}
# This is just to add newlines to the values of the diagnostic stuff, so it's not all clumped together:
for (@$results) {
for my $pt_diags ( @{ $_->{diagnostics} } ) {
$pt_diags->{diagnostic_value} =
encode_html_entities( $pt_diags->{diagnostic_value} );
$pt_diags->{diagnostic_value} =~ s/(\n|\r)/\