#!/usr/bin/perl package mail; use strict; use 5.008_001; use Encode qw(encode decode); # A weird fix. BEGIN { if ( $] > 5.008 ) { require Errno; require Config; } } #-----------# # Dada Mail # #-----------# # # Homepage: http://dadamailproject.com # # Support: http://dadamailproject.com/support # # Community Support: # http://dadamailproject.com/support/documentation/getting_help.pod.html # #---------------------------------------------------------------------# #---------------------------------------------------------------------# # The Path to your Perl *Libraries*: 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 set_message); BEGIN { sub handle_errors { my $TIME = scalar(localtime()); print qq{
We apologize, but the server encountered a problem when attempting to complete its task.
More information about this error may be available in the program's own error log.
Time of error: $TIME
$@"; # We're going to refresh, see if it gets better. $restart_time = 5; } if ( $should_be_restarted == 1 ) { # Provide a link in case browser redirect is working warn 'Reloading Message from Mailing Monitor'; print 'Reloading Mailing...'; } else { warn 'Refreshing Screen from Mailing Monitor'; print 'Refreshing Screen....'; } print " "; return; } elsif ( $q->param('process') eq 'ajax' ) { my $mailout = undef; my $status = {}; my $mailout_exists = 0; my $mailout_exists = 0; my $my_test_mailout_exists = 0; eval { $my_test_mailout_exists = DADA::Mail::MailOut::mailout_exists( $list, $id, $type ); }; if ( !$@ ) { $mailout_exists = $my_test_mailout_exists; } if ($mailout_exists) { $mailout_exists = 1; $mailout = DADA::Mail::MailOut->new( { -list => $list } ); $mailout->associate( $id, $type ); $status = $mailout->status(); } else { # Nothing - I believe this is handled in the template. } my ( $monitor_mailout_report, $total_mailouts, $active_mailouts, $paused_mailouts, $queued_mailouts, $inactive_mailouts ) = DADA::Mail::MailOut::monitor_mailout( { -verbose => 0, -list => $list } ); #warn '$status->{should_be_restarted} ' . $status->{should_be_restarted}; #warn q{$ls->param('auto_pickup_dropped_mailings') } # . $ls->param('auto_pickup_dropped_mailings'); #warn '$restart_count' . $restart_count; #warn '$status->{mailout_stale}' . $status->{mailout_stale}; #warn '$active_mailouts' . $active_mailouts; if ( $status->{should_be_restarted} == 1 && # It's dead in the water. $ls->param('auto_pickup_dropped_mailings') == 1 && # Auto Pickup is turned on... # $status->{total_sending_out_num} - $status->{total_sent_out} > 0 && # There's more subscribers to send out to $restart_count <= 0 && # We haven't *just* restarted this thing $status->{mailout_stale} != 1 && # The mailout hasn't been sitting around too long without being restarted, $active_mailouts < $DADA::Config::MAILOUT_AT_ONCE_LIMIT # There's not already too many mailouts going out. ) { warn "Yes, we need to restart!"; # Whew! Take that for making sure that the damn thing is supposed to be sent. my $reload_url = $DADA::Config::S_PROGRAM_URL . '?f=sending_monitor&id=' . $id . '&process=restart&type=' . $type . '&restart_count=1'; print $q->header(); print ""; return; } else { # warn "No, no need to restart."; $restart_count = 0; } my $sending_status = []; for ( keys %$status ) { next if $_ eq 'email_fields'; push( @$sending_status, { key => $_, value => $status->{$_} } ); } # If we're... say... 2x a batch setting and NOTHING has been sent, # let's say a mailing will be automatically started in... time since last - wait time. my $will_restart_in = undef; # $batch_wait if ( time - $status->{last_access} > ( $batch_wait * 1.5 ) ) { my $tardy_threshold = $batch_wait * 3; if ( $tardy_threshold < 60 ) { $tardy_threshold = 60; } $will_restart_in = $tardy_threshold - ( time - $status->{last_access} ); if ( $will_restart_in >= 1 ) { $will_restart_in = _formatted_runtime($will_restart_in); } else { $will_restart_in = undef; } } my $hourly_rate = 0; if ( $status->{mailing_time} > 0 ) { $hourly_rate = commify( int( ( $status->{total_sent_out} / $status->{mailing_time} ) * 60 * 60 + .5 ) ); } require DADA::Template::Widgets; my $header_subject_label = DADA::Template::Widgets::screen( { -data => \$status->{email_fields}->{Subject}, -list_settings_vars_param => { -list => $list, -dot_it => 1, }, -subscriber_vars_param => { -use_fallback_vars => 1, -list => $list, }, -decode_before => 1, } ); my $scrn = DADA::Template::Widgets::screen( { -screen => 'sending_monitor_screen.tmpl', -expr => 1, -vars => { screen => 'sending_monitor', mailout_exists => $mailout_exists, message_id => DADA::App::Guts::strip($id), message_type => $q->param('type'), total_sent_out => $status->{total_sent_out}, total_sending_out_num => $status->{total_sending_out_num}, mailing_time => $status->{mailing_time}, mailing_time_formatted => $status->{mailing_time_formatted}, hourly_rate => $hourly_rate, percent_done => $status->{percent_done}, status_bar_width => int( $status->{percent_done} ) * 5, negative_status_bar_width => 500 - ( int( $status->{percent_done} ) * 5 ), need_to_send_out => ( $status->{total_sending_out_num} - $status->{total_sent_out} ), time_since_last_sendout => _formatted_runtime( ( time - int( $status->{last_sent} ) ) ), its_killed => $status->{should_be_restarted}, header_subject => safely_decode( $status->{email_fields}->{Subject}, 1 ), header_subject_label => ( length($header_subject_label) > 50 ) ? ( substr( $header_subject_label, 0, 49 ) . '...' ) : ($header_subject_label), auto_pickup_dropped_mailings => $ls->param('auto_pickup_dropped_mailings'), sending_done => ( $status->{percent_done} < 100 ) ? 0 : 1, refresh_after => $refresh_after, killed_it => $q->param('killed_it') ? 1 : 0, sending_status => $sending_status, is_paused => $status->{paused} > 0 ? 1 : 0, paused => $status->{paused}, queue => $status->{queue}, queued_mailout => $status->{queued_mailout}, queue_place => ( $status->{queue_place} + 1 ), # adding one since humans like counting from, "1" queue_total => ( $status->{queue_total} + 1 ), # adding one since humans like counting from, "1" status_mailout_stale => $status->{mailout_stale}, MAILOUT_AT_ONCE_LIMIT => $DADA::Config::MAILOUT_AT_ONCE_LIMIT, will_restart_in => $will_restart_in, integrity_check => $status->{integrity_check}, }, } ); print $q->header(); e_print($scrn); } else { my $tracker_url = $DADA::Config::S_PROGRAM_URL; $tracker_url =~ m/(^.*\/)(.*?)/; #just use the url to get the filename with a regex $tracker_url = $1 . 'plugins/tracker.cgi'; require DADA::Template::Widgets; my $scrn = DADA::Template::Widgets::wrap_screen( { -screen => 'sending_monitor_container_screen.tmpl', -with => 'admin', -wrapper_params => { -Root_Login => $root_login, -List => $list, }, -vars => { screen => 'sending_monitor', message_id => DADA::App::Guts::strip($id), message_type => $q->param('type'), refresh_after => $refresh_after, tracker_url => $tracker_url, 'list_settings.tracker_show_message_reports_in_mailing_monitor' => $ls->param('tracker_show_message_reports_in_mailing_monitor'), list_type_isa_list => ( $q->param('type') eq 'list' ) ? 1 : 0, } } ); e_print($scrn); } } sub print_mass_mailing_log { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'sending_monitor' ); my $id = $q->param('id'); my $type = $q->param('type'); $list = $admin_list; require DADA::Mail::MailOut; my $mailout = DADA::Mail::MailOut->new( { -list => $list } ); $mailout->associate( $id, $type ); print $q->header('text/plain'); $mailout->print_log; } sub _formatted_runtime { my $d = shift || 0; my @int = ( [ 'second', 1 ], [ 'minute', 60 ], [ 'hour', 60 * 60 ], [ 'day', 60 * 60 * 24 ], [ 'week', 60 * 60 * 24 * 7 ], [ 'month', 60 * 60 * 24 * 30.5 ], [ 'year', 60 * 60 * 24 * 30.5 * 12 ] ); my $i = $#int; my @r; while ( ( $i >= 0 ) && ($d) ) { if ( $d / $int[$i]->[1] >= 1 ) { push @r, sprintf "%d %s%s", $d / $int[$i]->[1], $int[$i]->[0], ( sprintf "%d", $d / $int[$i]->[1] ) > 1 ? 's' : ''; } $d %= $int[$i]->[1]; $i--; } my $runtime; if (@r) { $runtime = join ", ", @r; } else { $runtime = '0 seconds'; } return $runtime; } sub send_url_email { require DADA::App::MassSend; my $ms = DADA::App::MassSend->new; $ms->send_url_email( { -cgi_obj => $q, } ); } sub list_invite { require DADA::App::MassSend; my $ms = DADA::App::MassSend->new; $ms->list_invite( { -cgi_obj => $q, } ); } sub mass_mailing_options { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'mass_mailing_options' ); $list = $admin_list; if ( !$process ) { my $can_use_css_inliner = 1; try { require CSS::Inliner; } catch { $can_use_css_inliner = 0; }; require DADA::Template::Widgets; my $scrn = DADA::Template::Widgets::wrap_screen( { -screen => 'mass_mailing_options_screen.tmpl', -with => 'admin', -expr => 1, -wrapper_params => { -Root_Login => $root_login, -List => $list, }, -vars => { done => $done, can_use_css_inliner => $can_use_css_inliner, }, -list_settings_vars_param => { -list => $list, -dot_it => 1, }, } ); e_print($scrn); } else { my $ls = DADA::MailingList::Settings->new( { -list => $list } ); $ls->save_w_params( { -associate => $q, -settings => { mass_mailing_convert_plaintext_to_html => 0, mass_mailing_block_css_to_inline_css => 0, } } ); print $q->redirect( -uri => $DADA::Config::S_PROGRAM_URL . '?flavor=mass_mailing_options&done=1' ); } } sub change_info { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'change_info' ); $list = $admin_list; require DADA::MailingList::Settings; my $ls = DADA::MailingList::Settings->new( { -list => $list } ); my $errors = 0; my $flags = {}; if ($process) { ( $errors, $flags ) = check_list_setup( -fields => { list => $list, list_name => $list_name, list_owner_email => $list_owner_email, admin_email => $admin_email, privacy_policy => $privacy_policy, info => $info, physical_address => $physical_address, }, -new_list => 'no', ); } undef $process if $errors >= 1; if ( !$process ) { my $err_word = 'was'; $err_word = 'were' if $errors && $errors > 1; my $errors_ending = ''; $errors_ending = 's' if $errors && $errors > 1; my $flags_list_name = $flags->{list_name} || 0; my $flags_list_name_bad_characters = $flags->{list_name_bad_characters} || 0; my $flags_invalid_list_owner_email = $flags->{invalid_list_owner_email} || 0; my $flags_list_info = $flags->{list_info} || 0; my $flags_privacy_policy = $flags->{privacy_policy} || 0; my $flags_physical_address = $flags->{physical_address} || 0; require DADA::Template::Widgets; my $scrn = DADA::Template::Widgets::wrap_screen( { -screen => 'change_info_screen.tmpl', -with => 'admin', -wrapper_params => { -Root_Login => $root_login, -List => $list, }, -vars => { screen => 'change_info', done => $done, errors => $errors, errors_ending => $errors_ending, err_word => $err_word, list => $list, list_name => $list_name ? $list_name : $ls->param('list_name'), list_owner_email => $list_owner_email ? $list_owner_email : $ls->param('list_owner_email'), admin_email => $admin_email ? $admin_email : $ls->param('admin_email'), info => $info ? $info : $ls->param('info'), privacy_policy => $privacy_policy ? $privacy_policy : $ls->param('privacy_policy'), physical_address => $physical_address ? $physical_address : $ls->param('physical_address'), flags_list_name => $flags_list_name, flags_invalid_list_owner_email => $flags_invalid_list_owner_email, flags_list_info => $flags_list_info, flags_privacy_policy => $flags_privacy_policy, flags_physical_address => $flags_physical_address, flags_list_name_bad_characters => $flags_list_name_bad_characters, }, } ); e_print($scrn); } else { $admin_email = $list_owner_email unless defined($admin_email); $ls->save( { list_owner_email => strip($list_owner_email), admin_email => strip($admin_email), list_name => $list_name, info => $info, privacy_policy => $privacy_policy, physical_address => $physical_address, } ); print $q->redirect( -uri => $DADA::Config::S_PROGRAM_URL . '?flavor=change_info&done=1' ); } } sub change_password { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'change_password', ); $list = $admin_list; require DADA::Security::Password; require DADA::MailingList::Settings; my $ls = DADA::MailingList::Settings->new( { -list => $list } ); if ( !$process ) { require DADA::Template::Widgets; my $scrn = DADA::Template::Widgets::wrap_screen( { -screen => 'change_password_screen.tmpl', -with => 'admin', -wrapper_params => { -Root_Login => $root_login, -List => $list, }, -list => $list, -vars => { screen => 'change_password', root_login => $root_login, }, } ); e_print($scrn); } else { my $old_password = $q->param('old_password'); my $new_password = $q->param('new_password'); my $again_new_password = $q->param('again_new_password'); if ( $root_login != 1 ) { my $password_check = DADA::Security::Password::check_password( $ls->param('password'), $old_password ); if ( $password_check != 1 ) { user_error( { -list => $list, -error => "invalid_password" } ); return; } } $new_password = strip($new_password); $again_new_password = strip($again_new_password); if ( $new_password ne $again_new_password || $new_password eq "" ) { user_error( { -list => $list, -error => "list_pass_no_match" } ); return; } $ls->save( { password => DADA::Security::Password::encrypt_passwd($new_password), } ); # -no_list_security_check, because the list password's changed, it wouldn't pass it anyways... logout( -no_list_security_check => 1, -redirect_url => $DADA::Config::S_PROGRAM_URL . '?f=' . $DADA::Config::SIGN_IN_FLAVOR_NAME . '&list=' . $list, ); return; } } sub delete_list { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'delete_list' ); my $list = $admin_list; my $ls = DADA::MailingList::Settings->new( { -list => $list } ); if ( !$process ) { require DADA::Template::Widgets; my $scrn = DADA::Template::Widgets::wrap_screen( { -screen => 'delete_list_screen.tmpl', -with => 'admin', -wrapper_params => { -Root_Login => $root_login, -List => $list, }, -list => $list, -vars => { screen => 'delete_list', }, -list_settings_vars_param => { -list => $list, -dot_it => 1, }, } ); e_print($scrn); } else { require DADA::MailingList; DADA::MailingList::Remove( { -name => $list, -delete_backups => xss_filter( $q->param('delete_backups') ), } ); $c->flush; my $logout_cookie = logout( -redirect => 0 ); require DADA::Template::Widgets; my $scrn = DADA::Template::Widgets::wrap_screen( { -screen => 'delete_list_success_screen.tmpl', -with => 'list', # -list => $list, # The list doesn't really exist anymore now, does it? -wrapper_params => { -header_params => { -COOKIE => $logout_cookie }, } } ); e_print($scrn); } } sub list_options { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'list_options' ); $list = $admin_list; require DADA::MailingList::Settings; my $ls = DADA::MailingList::Settings->new( { -list => $list } ); my $can_use_mx_lookup = 0; eval { require Net::DNS; }; if ( !$@ ) { $can_use_mx_lookup = 1; } my $can_use_captcha = 1; try { require DADA::Security::AuthenCAPTCHA; } catch { carp "CAPTCHA Not working correctly?: $_"; $can_use_captcha = 0; }; if ( !$process ) { my $send_subscription_notice_to_popup_menu = $q->popup_menu( -name => 'send_subscription_notice_to', -id => 'send_subscription_notice_to', -default => $ls->param('send_subscription_notice_to'), -labels => { list => 'Your Subscribers', 'list_owner' => 'The List Owner' }, '-values' => [qw(list list_owner)], ); my $send_unsubscription_notice_to_popup_menu = $q->popup_menu( -name => 'send_unsubscription_notice_to', -id => 'send_unsubscription_notice_to', -default => $ls->param('send_unsubscription_notice_to'), -labels => { list => 'Your Subscribers', 'list_owner' => 'The List Owner' }, '-values' => [qw(list list_owner)], ); require DADA::Template::Widgets; my $scrn = DADA::Template::Widgets::wrap_screen( { -screen => 'list_options_screen.tmpl', -with => 'admin', -wrapper_params => { -Root_Login => $root_login, -List => $list, }, -expr => 1, -list => $list, -vars => { screen => 'list_options', title => 'Optons', done => $done, CAPTCHA_TYPE => $DADA::Config::CAPTCHA_TYPE, can_use_mx_lookup => $can_use_mx_lookup, can_use_captcha => $can_use_captcha, send_subscription_notice_to_popup_menu => $send_subscription_notice_to_popup_menu, send_unsubscription_notice_to_popup_menu => $send_unsubscription_notice_to_popup_menu, list_owner_email_anonystar_address => DADA::App::Guts::anonystar_address_encode( $ls->param('list_owner_email') ), }, -list_settings_vars_param => { -list => $list, -dot_it => 1, }, } ); e_print($scrn); } else { if($q->param('anyone_can_subscribe') == 1){ $q->param('invite_only_list', 0); } else { $q->param('invite_only_list', 1); } $list = $admin_list; $ls->save_w_params( { -associate => $q, -settings => { private_list => 0, hide_list => 0, closed_list => 0, invite_only_list => 0, get_sub_notice => 0, get_unsub_notice => 0, enable_closed_loop_opt_in => 0, skip_sub_confirm_if_logged_in => 0, send_unsub_success_email => 0, send_sub_success_email => 0, send_newest_archive => 0, mx_check => 0, limit_sub_confirm => 0, limit_sub_confirm_use_captcha => 0, email_your_subscribed_msg => 0, email_you_are_not_subscribed_msg => 0, use_alt_url_sub_confirm_success => 0, alt_url_sub_confirm_success => '', alt_url_sub_confirm_success_w_qs => 0, use_alt_url_sub_confirm_failed => 0, alt_url_sub_confirm_failed => '', alt_url_sub_confirm_failed_w_qs => 0, use_alt_url_sub_success => 0, alt_url_sub_success => '', alt_url_sub_success_w_qs => 0, use_alt_url_sub_failed => 0, alt_url_sub_failed => '', alt_url_sub_failed_w_qs => 0, use_alt_url_subscription_approval_step => 0, alt_url_subscription_approval_step => '', alt_url_subscription_approval_step_w_qs => 0, use_alt_url_unsub_success => 0, alt_url_unsub_success => '', alt_url_unsub_success_w_qs => 0, unsub_show_email_hint => 0, enable_subscription_approval_step => 0, enable_mass_subscribe => 0, enable_mass_subscribe_only_w_root_login => 0, send_subscribed_by_list_owner_message => 0, send_unsubscribed_by_list_owner_message => 0, send_last_archived_msg_mass_mailing => 0, captcha_sub => 0, send_subscription_notice_to => undef, send_unsubscription_notice_to => undef, } } ); print $q->redirect( -uri => $DADA::Config::S_PROGRAM_URL . '?flavor=list_options&done=1' ); } } sub sending_preferences { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'sending_preferences' ); $list = $admin_list; require DADA::MailingList::Settings; my $ls = DADA::MailingList::Settings->new( { -list => $list } ); if ( !$process ) { require DADA::MailingList::Settings; my $ls = DADA::MailingList::Settings->new( { -list => $list } ); require DADA::Security::Password; my $decrypted_sasl_pass = ''; if ( $ls->param('sasl_smtp_password') ) { $decrypted_sasl_pass = DADA::Security::Password::cipher_decrypt( $ls->param('cipher_key'), $ls->param('sasl_smtp_password') ); } my $decrypted_pop3_pass = ''; if ( $ls->param('pop3_password') ) { $decrypted_pop3_pass = DADA::Security::Password::cipher_decrypt( $ls->param('cipher_key'), $ls->param('pop3_password') ); } # DEV: This is really strange, since if Net::SMTP isn't available, SMTP sending is completely broken. my $can_use_net_smtp = 0; eval { require Net::SMTP_auth }; if ( !$@ ) { $can_use_net_smtp = 1; } my $can_use_smtp_ssl = 0; eval { require Net::SMTP::SSL }; if ( !$@ ) { $can_use_smtp_ssl = 1; } my $can_use_ssl = 0; eval { require IO::Socket::SSL }; if ( !$@ ) { $can_use_ssl = 1; } my $mechanism_popup; if ($can_use_net_smtp) { $mechanism_popup = $q->popup_menu( -name => 'sasl_auth_mechanism', -id => 'sasl_auth_mechanism', -default => $ls->param('sasl_auth_mechanism'), '-values' => [qw(PLAIN LOGIN DIGEST-MD5 CRAM-MD5)], ); } my $pop3_auth_mode_popup = $q->popup_menu( -name => 'pop3_auth_mode', -id => 'pop3_auth_mode', -default => $ls->param('pop3_auth_mode'), '-values' => [qw(BEST PASS APOP CRAM-MD5)], -labels => { BEST => 'Automatic' }, ); my $wrong_uid = 0; $wrong_uid = 1 if $< != $>; my $no_smtp_server_set = 0; if ( !$ls->param('smtp_server') && $ls->param('sending_method') eq "smtp" ) { $no_smtp_server_set = 1; } require DADA::Template::Widgets; my $scrn = DADA::Template::Widgets::wrap_screen( { -screen => 'sending_preferences_screen.tmpl', -with => 'admin', -expr => 1, -wrapper_params => { -Root_Login => $root_login, -List => $list, }, -vars => { screen => 'sending_preferences', done => $done, no_smtp_server_set => $no_smtp_server_set, mechanism_popup => $mechanism_popup, can_use_ssl => $can_use_ssl, can_use_smtp_ssl => $can_use_smtp_ssl, 'list_settings.pop3_username' => $ls->param('pop3_username'), # DEV ? decrypted_pop3_pass => $decrypted_pop3_pass, wrong_uid => $wrong_uid, pop3_auth_mode_popup => $pop3_auth_mode_popup, can_use_ssl => $can_use_ssl, f_flag_settings => $DADA::Config::MAIL_SETTINGS . ' -f' . $ls->param('admin_email'), use_sasl_smtp_auth => $q->param('use_sasl_smtp_auth') ? $q->param('use_sasl_smtp_auth') : $ls->param('use_sasl_smtp_auth'), decrypted_pop3_pass => $q->param('pop3_password') ? $q->param('pop3_password') : $decrypted_pop3_pass, sasl_auth_mechanism => $q->param('sasl_auth_mechanism') ? $q->param('sasl_auth_mechanism') : $ls->param('sasl_auth_mechanism'), sasl_smtp_username => $q->param('sasl_smtp_username') ? $q->param('sasl_smtp_username') : $ls->param('sasl_smtp_username'), sasl_smtp_password => $q->param('sasl_smtp_password') ? $q->param('sasl_smtp_password') : $decrypted_sasl_pass, amazon_ses_requirements_widget => DADA::Template::Widgets::amazon_ses_requirements_widget(), }, -list_settings_vars_param => { -list => $list, -dot_it => 1, }, } ); e_print($scrn); } else { my $pop3_password = strip( $q->param('pop3_password') ) || undef; if ( defined($pop3_password) ) { $q->param( 'pop3_password', DADA::Security::Password::cipher_encrypt( $ls->param('cipher_key'), $pop3_password ) ); } my $sasl_smtp_password = strip( $q->param('sasl_smtp_password') ) || undef; if ( defined($sasl_smtp_password) ) { $q->param( 'sasl_smtp_password', DADA::Security::Password::cipher_encrypt( $ls->param('cipher_key'), $sasl_smtp_password ) ); } $ls->save_w_params( { -associate => $q, -settings => { sending_method => undef, add_sendmail_f_flag => 0, use_pop_before_smtp => 0, set_smtp_sender => 0, smtp_server => undef, pop3_server => undef, pop3_username => undef, pop3_password => undef, pop3_use_ssl => undef, pop3_auth_mode => 'BEST', use_smtp_ssl => 0, sasl_auth_mechanism => undef, use_sasl_smtp_auth => 0, sasl_smtp_username => undef, sasl_smtp_password => undef, smtp_port => undef, } } ); if ( $q->param('no_redirect') == 1 ) { # ... } else { print $q->redirect( -uri => $DADA::Config::S_PROGRAM_URL . '?flavor=sending_preferences&done=1' ); } } } sub mass_mailing_preferences { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'mass_mailing_preferences' ); $list = $admin_list; require DADA::MailingList::Settings; my $ls = DADA::MailingList::Settings->new( { -list => $list } ); if ( !$process ) { require DADA::Mail::MailOut; my $mo = DADA::Mail::MailOut->new( { -list => $list } ); my ( $batch_sending_enabled, $batch_size, $batch_wait ) = $mo->batch_params(); my $show_amazon_ses_options = 0; my $type_of_service = 'ses'; if ( ($ls->param('sending_method') eq 'amazon_ses' || ( $ls->param('sending_method') eq 'smtp' && $ls->param('smtp_server') =~ m/amazonaws\.com/ ) ) || ( ( $ls->param('sending_method') eq 'smtp' && $ls->param('smtp_server') =~ m/smtp\.mandrillapp\.com/ ) ) ) { $show_amazon_ses_options = 1; if( $ls->param('sending_method') eq 'smtp' && $ls->param('smtp_server') =~ m/smtp\.mandrillapp\.com/ ) { $type_of_service = 'mandrill'; } } my @message_amount = ( 1 .. 180 ); unshift( @message_amount, $batch_size ); my @message_wait = ( 1 .. 60, 70, 80, 90, 100, 110, 110, 120, 130, 140, 150, 160, 170, 180 ); unshift( @message_wait, $batch_wait ); my @message_label = (1); my %label_label = ( 1 => 'second(s)', ); my $mass_send_amount_menu = $q->popup_menu( -name => "mass_send_amount", -id => "mass_send_amount", -value => [@message_amount], -class => 'previewBatchSendingSpeed', ); my $bulk_sleep_amount_menu = $q->popup_menu( -name => "bulk_sleep_amount", -id => "bulk_sleep_amount", -value => [@message_wait], -class => 'previewBatchSendingSpeed', ); require DADA::Template::Widgets; my $scrn = DADA::Template::Widgets::wrap_screen( { -screen => 'mass_mailing_preferences_screen.tmpl', -with => 'admin', -expr => 1, -wrapper_params => { -Root_Login => $root_login, -List => $list, }, -vars => { screen => 'mass_mailing_preferences', done => $done, batch_sending_enabled => $batch_sending_enabled, mass_send_amount_menu => $mass_send_amount_menu, bulk_sleep_amount_menu => $bulk_sleep_amount_menu, batch_size => $batch_size, batch_wait => $batch_wait, show_amazon_ses_options => $show_amazon_ses_options, type_of_service => $type_of_service, }, -list_settings_vars_param => { -list => $list, -dot_it => 1, }, } ); e_print($scrn); } else { $ls->save_w_params( { -associate => $q, -settings => { mass_send_amount => undef, bulk_sleep_amount => undef, enable_bulk_batching => 0, adjust_batch_sleep_time => 0, get_finished_notification => 0, auto_pickup_dropped_mailings => 0, restart_mailings_after_each_batch => 0, smtp_connection_per_batch => 0, mass_mailing_send_to_list_owner => 0, amazon_ses_auto_batch_settings => 0, mass_mailing_save_logs => 0, } } ); print $q->redirect( -uri => $DADA::Config::S_PROGRAM_URL . '?flavor=mass_mailing_preferences&done=1' ); } } sub amazon_ses_verify_email { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'sending_preferences' ); my $valid_email = 1; my $status = undef; my $result = undef; my $amazon_ses_verify_email = xss_filter( strip( $q->param('amazon_ses_verify_email') ) ); if ( check_for_valid_email($amazon_ses_verify_email) == 1 ) { $valid_email = 0; } else { require DADA::App::AmazonSES; my $ses = DADA::App::AmazonSES->new; ( $status, $result ) = $ses->verify_sender( { -email => $amazon_ses_verify_email } ); } print $q->header(); require DADA::Template::Widgets; e_print( DADA::Template::Widgets::screen( { -screen => 'amazon_ses_verify_email_widget.tmpl', -expr => 1, -vars => { amazon_ses_verify_email => $amazon_ses_verify_email, valid_email => $valid_email, status => $status, result => $result, } } ) ); } sub amazon_ses_get_stats { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'mass_mailing_preferences' ); $list = $admin_list; my $ls = DADA::MailingList::Settings->new( { -list => $list } ); my $has_ses_options = 1; if ( !defined( $DADA::Config::AMAZON_SES_OPTIONS->{AWSAccessKeyId} ) || !defined( $DADA::Config::AMAZON_SES_OPTIONS->{AWSSecretKey} ) ) { $has_ses_options = 0; } if ( $ls->param('sending_method') eq 'amazon_ses' || ( $ls->param('sending_method') eq 'smtp' && $ls->param('smtp_server') =~ m/amazonaws\.com/ ) || ( $ls->param('sending_method') eq 'smtp' && $ls->param('smtp_server') =~ m/smtp\.mandrillapp\.com/ ) ) { my $status = undef; my $SentLast24Hours = undef; my $Max24HourSend = undef; my $MaxSendRate = undef; my $allowed_sending_quota_percentage = undef; my $using_ses = 0; my $using_man = 0; if ( $ls->param('sending_method') eq 'amazon_ses' || ( $ls->param('sending_method') eq 'smtp' && $ls->param('smtp_server') =~ m/amazonaws\.com/ ) && $has_ses_options == 1 ) { require DADA::App::AmazonSES; my $ses = DADA::App::AmazonSES->new; ( $status, $SentLast24Hours, $Max24HourSend, $MaxSendRate ) = $ses->get_stats; $allowed_sending_quota_percentage = $ses->allowed_sending_quota_percentage; $using_ses = 1; } elsif( $ls->param('sending_method') eq 'smtp' && $ls->param('smtp_server') =~ m/smtp\.mandrillapp\.com/ ){ require DADA::App::Mandrill; my $man = DADA::App::Mandrill->new; ( $status, $SentLast24Hours, $Max24HourSend, $MaxSendRate ) = $man->get_stats; $allowed_sending_quota_percentage = 100; $using_man = 1; } print $q->header(); require DADA::Template::Widgets; e_print( DADA::Template::Widgets::screen( { -screen => 'amazon_ses_get_stats_widget.tmpl', -expr => 1, -vars => { status => $status, has_ses_options => $has_ses_options, MaxSendRate => commify($MaxSendRate), Max24HourSend => commify($Max24HourSend), SentLast24Hours => commify($SentLast24Hours), allowed_sending_quota_percentage => $allowed_sending_quota_percentage, using_ses => $using_ses, using_man => $using_man, } } ) ); } else { print $q->header(); } } sub previewBatchSendingSpeed { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'mass_mailing_preferences' ); $list = $admin_list; my $lh = DADA::MailingList::Subscribers->new( { -list => $list } ); print $q->header(); my $enable_bulk_batching = xss_filter( $q->param('enable_bulk_batching') ); my $mass_send_amount = xss_filter( $q->param('mass_send_amount') ); my $bulk_sleep_amount = xss_filter( $q->param('bulk_sleep_amount') ); my $amazon_ses_auto_batch_settings = xss_filter( $q->param('amazon_ses_auto_batch_settings') ); my $per_hour = 0; my $num_subs = 0; my $time_to_send = 0; my $somethings_wrong = 0; if ( $enable_bulk_batching == 1 ) { if ( $amazon_ses_auto_batch_settings == 1 ) { require DADA::Mail::MailOut; my $mo = DADA::Mail::MailOut->new( { -list => $list } ); my $enabled; ( $enabled, $mass_send_amount, $bulk_sleep_amount ) = $mo->batch_params( { -amazon_ses_auto_batch_settings => 1 } ); use Data::Dumper; warn Dumper([$enabled, $mass_send_amount, $bulk_sleep_amount]); } if ( $bulk_sleep_amount > 0 && $mass_send_amount > 0 ) { my $per_sec = $mass_send_amount / $bulk_sleep_amount; $per_hour = int( $per_sec * 60 * 60 + .5 ); # DEV .5 is some sort of rounding thing (with int). That's wrong. $num_subs = $lh->num_subscribers; my $total_hours = 0; if ( $num_subs > 0 && $per_hour > 0 ) { $total_hours = $lh->num_subscribers / $per_hour; } $per_hour = commify($per_hour); $num_subs = commify($num_subs); $time_to_send = _formatted_runtime( $total_hours * 60 * 60 ); } else { $somethings_wrong = 1; } } require DADA::Template::Widgets; e_print( DADA::Template::Widgets::screen( { -screen => 'previewBatchSendingSpeed_widget.tmpl', -vars => { enable_bulk_batching => $enable_bulk_batching, per_hour => $per_hour, num_subscribers => $num_subs, time_to_send => $time_to_send, somethings_wrong => $somethings_wrong, } } ) ); return; } sub commify { my $input = shift; $input = reverse($input); $input =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g; $input = reverse($input); return $input; } sub adv_sending_preferences { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'adv_sending_preferences' ); $list = $admin_list; require DADA::Security::Password; require DADA::MailingList::Settings; my $ls = DADA::MailingList::Settings->new( { -list => $list } ); if ( !$process ) { unshift( @DADA::Config::CHARSETS, $ls->param('charset') ); my $precedence_popup_menu = $q->popup_menu( -name => "precedence", -value => [@DADA::Config::PRECEDENCES], -default => $ls->param('precedence'), ); my $priority_popup_menu = $q->popup_menu( -name => "priority", -value => [ keys %DADA::Config::PRIORITIES ], -labels => \%DADA::Config::PRIORITIES, -default => $ls->param('priority'), ); my $charset_popup_menu = $q->popup_menu( -name => 'charset', -value => [@DADA::Config::CHARSETS], ); my $plaintext_encoding_popup_menu = $q->popup_menu( -name => 'plaintext_encoding', -value => [@DADA::Config::CONTENT_TRANSFER_ENCODINGS], -default => $ls->param('plaintext_encoding'), ); my $html_encoding_popup_menu = $q->popup_menu( -name => 'html_encoding', -value => [@DADA::Config::CONTENT_TRANSFER_ENCODINGS], -default => $ls->param('html_encoding'), ); my $can_mime_encode = 1; eval { require MIME::EncWords; }; if ($@) { $can_mime_encode = 0; } require DADA::Template::Widgets; my $scrn = DADA::Template::Widgets::wrap_screen( { -screen => 'adv_sending_preferences_screen.tmpl', -with => 'admin', -wrapper_params => { -Root_Login => $root_login, -List => $list, }, -list => $list, -vars => { screen => 'adv_sending_preferences', title => 'Advanced Options', done => $done, precedence_popup_menu => $precedence_popup_menu, priority_popup_menu => $priority_popup_menu, charset_popup_menu => $charset_popup_menu, plaintext_encoding_popup_menu => $plaintext_encoding_popup_menu, html_encoding_popup_menu => $html_encoding_popup_menu, can_mime_encode => $can_mime_encode, }, -list_settings_vars_param => { -list => $list, -dot_it => 1, }, } ); e_print($scrn); } else { $ls->save_w_params( { -associate => $q, -settings => { precedence => undef, priority => undef, charset => undef, plaintext_encoding => undef, html_encoding => undef, strip_message_headers => 0, print_return_path_header => 0, print_errors_to_header => 0, verp_return_path => 0, use_domain_sending_tunings => 0, mime_encode_words_in_headers => 0, } } ); print $q->redirect( -uri => $DADA::Config::S_PROGRAM_URL . '?flavor=adv_sending_preferences&done=1' ); } } sub sending_tuning_options { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'sending_tuning_options' ); my @allowed_tunings = qw( domain sending_method add_sendmail_f_flag print_return_path_header verp_return_path ); $list = $admin_list; require DADA::MailingList::Settings; my $ls = DADA::MailingList::Settings->new( { -list => $list } ); if ( $process eq 'remove_all' ) { $ls->save( { domain_sending_tunings => '' } ); print $q->redirect( -uri => $DADA::Config::S_PROGRAM_URL . '?flavor=sending_tuning_options&done=1&remove=1' ); } elsif ( $process == 1 ) { my $tunings = eval( $ls->param('domain_sending_tunings') ); #my $errors = {}; if ( $q->param('new_tuning') == 1 ) { my $new_tuning = {}; my $p_list = $q->Vars; for ( keys %$p_list ) { if ( $_ =~ m/^new_tuning_/ ) { my $name = $_; $name =~ s/^new_tuning_//; $new_tuning->{$name} = $q->param($_); # if($p_list->{new_tuning_domain}){ # # TO DO domain regex needs some work... # if(DADA::App::Guts($p_list->{new_tuning_domain}) == 0 && $p_list->{new_tuning_domain} !~ m/^([a-z]+[-]*(?=[a-z]|\d)\d*[a-z]*)\.(.*?)/){ # $errors{not_a_domain} = 1; # } # } } } if ( $new_tuning->{domain} ) { # really, the only required field. #if(! keys %$errors){ push( @$tunings, $new_tuning ); # } } } # if(! keys %$errors){ require Data::Dumper; my $tunes = Data::Dumper->new( [$tunings] ); $tunes->Purity(1)->Terse(1)->Deepcopy(1); $ls->save( { domain_sending_tunings => $tunes->Dump } ); #} print $q->redirect( -uri => $DADA::Config::S_PROGRAM_URL . '?flavor=sending_tuning_options&done=1' ); } elsif ( $q->param('process_edit') =~ m/Edit/i ) { if ( $q->param('domain') ) { my $saved_tunings = eval( $ls->param('domain_sending_tunings') ); my $new_tunings = []; for my $st (@$saved_tunings) { if ( $st->{domain} eq $q->param('domain') ) { for my $a_tuning (@allowed_tunings) { my $new_tune = $q->param($a_tuning) || 0; # if($q->param($a_tuning)){ $st->{$a_tuning} = $new_tune; # } } } } require Data::Dumper; my $tunes = Data::Dumper->new( [$saved_tunings] ); $tunes->Purity(1)->Terse(1)->Deepcopy(1); $ls->save( { domain_sending_tunings => $tunes->Dump } ); } print $q->redirect( -uri => $DADA::Config::S_PROGRAM_URL . '?flavor=sending_tuning_options&done=1&edit=1' ); } elsif ( $q->param('process_edit') =~ m/Remove/i ) { if ( $q->param('domain') ) { my $saved_tunings = eval( $ls->param('domain_sending_tunings') ); my $new_tunings = []; for (@$saved_tunings) { if ( $_->{domain} ne $q->param('domain') ) { push( @$new_tunings, $_ ); } } require Data::Dumper; my $tunes = Data::Dumper->new( [$new_tunings] ); $tunes->Purity(1)->Terse(1)->Deepcopy(1); $ls->save( { domain_sending_tunings => $tunes->Dump } ); } print $q->redirect( -uri => $DADA::Config::S_PROGRAM_URL . '?flavor=sending_tuning_options&done=1&remove=1' ); } else { my $saved_tunings = eval( $ls->param('domain_sending_tunings') ); # This is done because variables inside loops are local, not global, and global vars don't work in loops. my $c = 0; for (@$saved_tunings) { $saved_tunings->[$c]->{S_PROGRAM_URL} = $DADA::Config::S_PROGRAM_URL; $c++; } require DADA::Template::Widgets; my $scrn = DADA::Template::Widgets::wrap_screen( { -screen => 'sending_tuning_options.tmpl', -with => 'admin', -wrapper_params => { -Root_Login => $root_login, -List => $list, }, -expr => 1, -vars => { tunings => $saved_tunings, done => ( $q->param('done') ? 1 : 0 ), edit => ( $q->param('edit') ? 1 : 0 ), remove => ( $q->param('remove') ? 1 : 0 ), use_domain_sending_tunings => ( $ls->param('use_domain_sending_tunings') ? 1 : 0 ), # For pre-filling in the "new" forms list_add_sendmail_f_flag => $ls->param('add_sendmail_f_flag'), list_print_return_path_header => $ls->param('print_return_path_header'), list_verp_return_path => $ls->param('verp_return_path'), }, } ); e_print($scrn); } } sub sending_preferences_test { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'sending_preferences' ); my $list = $admin_list; $q->param( 'no_redirect', 1 ); # Saves the params passed sending_preferences(); require DADA::Mail::Send; require DADA::MailingList::Settings; my $ls = DADA::MailingList::Settings->new( { -list => $admin_list } ); my $mh = DADA::Mail::Send->new( { -list => $list, -ls_obj => $ls, } ); my ( $results, $lines, $report ); eval { ( $results, $lines, $report ) = $mh->sending_preferences_test; }; if ($@) { $results .= $@; } $results =~ s/\</g; $results =~ s/\>/>/g; my $ht_report = []; for my $f (@$report) { my $s_f = $f->{line}; $s_f =~ s{Net\:\:SMTP(.*?)\)}{}; push( @$ht_report, { SMTP_command => $s_f, message => $f->{message} } ); } print $q->header(); require DADA::Template::Widgets; e_print( DADA::Template::Widgets::screen( { -screen => 'sending_preferences_test_widget.tmpl', -expr => 1, -vars => { report => $ht_report, raw_log => $results, }, -list_settings_vars_param => { -list => $list, -dot_it => 1, }, } ) ); } sub view_list { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'view_list' ); $list = $admin_list; my $ls = DADA::MailingList::Settings->new( { -list => $list } ); my $add_email_count = xss_filter( $q->param('add_email_count') ) || 0; my $update_email_count = xss_filter( $q->param('update_email_count') ) || 0; my $skipped_email_count = xss_filter( $q->param('skipped_email_count') ) || 0; my $delete_email_count = xss_filter( $q->param('delete_email_count') ) || 0; my $black_list_add = xss_filter( $q->param('black_list_add') ) || 0; my $approved_count = xss_filter( $q->param('approved_count') ) || 0; my $denied_count = xss_filter( $q->param('denied_count') ) || 0; my $bounced_list_moved_to_list_count = xss_filter( $q->param('bounced_list_moved_to_list_count') ) || 0; my $bounced_list_removed_from_list = xss_filter( $q->param('bounced_list_removed_from_list') ) || 0; my $updated_addresses = xss_filter( $q->param('updated_addresses') ) || 0; my $type = xss_filter( $q->param('type') ) || 'list'; my $query = xss_filter( $q->param('query') ) || undef; my $order_by = $q->param('order_by') || $ls->param('view_list_order_by'); my $order_dir = $q->param('order_dir') || lc($ls->param('view_list_order_by_direction')); my $mode = xss_filter( $q->param('mode') ) || 'view'; my $page = xss_filter( $q->param('page') ) || 1; my $advanced_search = $q->param('advanced_search') || 0; my $advanced_query = $q->param('advanced_query') || undef; require DADA::Template::Widgets; if ( $mode ne 'viewport' ) { my $scrn = DADA::Template::Widgets::wrap_screen( { -list => $list, -screen => 'view_list_screen.tmpl', -with => 'admin', -wrapper_params => { -Root_Login => $root_login, -List => $list, }, -expr => 1, -vars => { screen => 'view_list', flavor => 'view_list', root_login => $root_login, type => $type, page => $page, query => $query, order_by => $order_by, order_dir => $order_dir, advanced_search => $advanced_search, advanced_query => $advanced_query, add_email_count => $add_email_count, update_email_count => $update_email_count, skipped_email_count => $skipped_email_count, delete_email_count => $delete_email_count, black_list_add => $black_list_add, approved_count => $approved_count, denied_count => $denied_count, bounced_list_moved_to_list_count => $bounced_list_moved_to_list_count, bounced_list_removed_from_list => $bounced_list_removed_from_list, updated_addresses => $updated_addresses, type_title => $type_title, }, } ); e_print($scrn); return; } else { # DEV: Yup. Forgot what this was for. if ( defined( $q->param('list') ) ) { if ( $list ne $q->param('list') ) { # I should look instead to see if we're logged in view ROOT and then just # *Switch* the login. Brilliant! --- maybe I don't want to switch lists automatically - without # someone perhaps knowing that THAT's what I did... logout( -redirect_url => $DADA::Config::S_PROGRAM_URL . '?' . $q->query_string(), ); return; } } require DADA::MailingList::Settings; my $ls = DADA::MailingList::Settings->new( { -list => $list } ); my $lh = DADA::MailingList::Subscribers->new( { -list => $list } ); my $num_subscribers = $lh->num_subscribers( { -type => $type } ); my $show_bounced_list = 0; if ( $lh->num_subscribers( { -type => 'bounced_list' } ) > 0 || $ls->param('bounce_handler_when_threshold_reached') eq 'move_to_bounced_sublist' ) { $show_bounced_list = 1; } my $subscribers = []; require Data::Pageset; my $page_info = undef; my $pages_in_set = []; my $total_num = 0; # warn '$query ' . $query; # warn '$advanced_query ' . $advanced_query; # warn ' $advanced_search' . $advanced_search; if ($query || $advanced_query) { if($advanced_search == 1){ open my $fh, '<', \$advanced_query || die $!; my $new_q = CGI->new($fh); my $partial_sending = partial_sending_query_to_params($new_q); ( $total_num, $subscribers ) = $lh->search_list( { -partial_listing => $partial_sending, -type => $type, -start => ( $page - 1 ), '-length' => $ls->param('view_list_subscriber_number'), -order_by => $order_by, -order_dir => $order_dir, } ); } else { ( $total_num, $subscribers ) = $lh->search_list( { -query => $query, -type => $type, -start => ( $page - 1 ), '-length' => $ls->param('view_list_subscriber_number'), -order_by => $order_by, -order_dir => $order_dir, } ); } $page_info = Data::Pageset->new( { total_entries => $total_num, entries_per_page => $ls->param('view_list_subscriber_number'), current_page => $page, mode => 'slide', # default fixed pages_per_set => 10, } ); } else { $subscribers = $lh->subscription_list( { -type => $type, -start => ( $page - 1 ), # this really should be just, $page, but subscription_list() would have to be updated, which will break a lot of things... '-length' => $ls->param('view_list_subscriber_number'), -order_by => $order_by, -order_dir => $order_dir, #-show_list_column => 0, #-show_timestamp_column => 0, } ); $total_num = $num_subscribers; $page_info = Data::Pageset->new( { total_entries => $num_subscribers, entries_per_page => $ls->param('view_list_subscriber_number'), current_page => $page, mode => 'slide', # default fixed pages_per_set => 10, } ); } 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::ProfileFieldsManager; my $pfm = DADA::ProfileFieldsManager->new; my $fields_attr = $pfm->get_all_field_attributes; my $field_names = []; my $undotted_fields = [ { name => 'email', label => 'Email Address' } ]; for ( @{ $lh->subscriber_fields } ) { push( @$field_names, { name => $_, label => $fields_attr->{$_}->{label}, S_PROGRAM_URL => $DADA::Config::S_PROGRAM_URL }, ); push( @$undotted_fields, { name => $_, label => $fields_attr->{$_}->{label}, S_PROGRAM_URL => $DADA::Config::S_PROGRAM_URL }, ); } require DADA::Template::Widgets; my $scrn = DADA::Template::Widgets::screen( { -list => $list, -screen => 'view_list_viewport_widget.tmpl', -expr => 1, -vars => { can_have_subscriber_fields => 1, screen => 'view_list', flavor => 'view_list', root_login => $root_login, type => $type, type_title => $type_title, first => $page_info->first, last => $page_info->last, first_page => $page_info->first_page, last_page => $page_info->last_page, next_page => $page_info->next_page, previous_page => $page_info->previous_page, page => $page_info->current_page, show_list_column => 0, show_timestamp_column=> $ls->param('view_list_show_timestamp_col'), field_names => $field_names, undotted_fields => $undotted_fields, pages_in_set => $pages_in_set, num_subscribers => commify($num_subscribers), total_num => $total_num, total_num_commified => commify($total_num), subscribers => $subscribers, query => $query, advanced_search => $advanced_search, advanced_query => $advanced_query, order_by => $order_by, order_dir => $order_dir, show_bounced_list => $show_bounced_list, GLOBAL_BLACK_LIST => $DADA::Config::GLOBAL_BLACK_LIST, GLOBAL_UNSUBSCRIBE => $DADA::Config::GLOBAL_UNSUBSCRIBE, can_use_global_black_list => $lh->can_use_global_black_list, can_use_global_unsubscribe => $lh->can_use_global_unsubscribe, can_filter_subscribers_through_blacklist => $lh->can_filter_subscribers_through_blacklist, flavor_is_view_list => 1, list_subscribers_num => commify( $lh->num_subscribers( { -type => 'list' } ) ), black_list_subscribers_num => commify( $lh->num_subscribers( { -type => 'black_list' } ) ), white_list_subscribers_num => commify( $lh->num_subscribers( { -type => 'white_list' } ) ), authorized_senders_num => commify( $lh->num_subscribers( { -type => 'authorized_senders' } ) ), moderators_num => commify( $lh->num_subscribers( { -type => 'moderators' } ) ), sub_request_list_subscribers_num => commify( $lh->num_subscribers( { -type => 'sub_request_list' } ) ), unsub_request_list_subscribers_num => commify( $lh->num_subscribers( { -type => 'unsub_request_list' } ) ), bounced_list_num => commify( $lh->num_subscribers( { -type => 'bounced_list' } ) ), }, -list_settings_vars_param => { -list => $list, -dot_it => 1, }, } ); print $q->header(); e_print($scrn); } } sub mass_update_profiles { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'view_list' ); $list = $admin_list; my $ls = DADA::MailingList::Settings->new( { -list => $list } ); my $lh = DADA::MailingList::Subscribers->new( { -list => $list } ); my $update_fields = {}; for my $field ( @{ $lh->subscriber_fields() } ) { if($q->param('update.' . $field) == 1){ $update_fields->{$field} = $q->param($field); } } my $advanced_query = xss_filter( $q->param('advanced_query') ) || undef; open my $fh, '<', \$advanced_query || die $!; my $new_q = CGI->new($fh); my $partial_listing = partial_sending_query_to_params($new_q); my $updated = $lh->update_profiles( { -update_fields => $update_fields, -partial_listing => $partial_listing, } ); # # print $q->header('text/plain'); # print 'advanced query: ' . "\n" . $advanced_query . "\n\n"; # use Data::Dumper; # print Dumper($partial_listing); # print $lh->SQL_subscriber_update_profiles_statement( # { # # -update_fields => $update_fields, # -partial_listing => $partial_listing, # } # ); # And then, we're return with a search query, to show the results: $q->param('updated_addresses', $updated); $q->param('advanced_search', 1); $q->param('done', 1); undef($new_q); $new_q = CGI->new; $new_q->charset($DADA::Config::HTML_CHARSET); $new_q->delete_all; # $new_q->param('favorite_color.operator', '='); # $new_q->param('favorite_color.value', 'mauve'); for my $field(%$update_fields) { $new_q->param($field . '.operator', '='); $new_q->param($field . '.value', $update_fields->{$field}); } my $new_advanced_search_query = $new_q->query_string(); $new_advanced_search_query =~ s/\;/\&/g; $q->param('advanced_query', $new_advanced_search_query); &view_list; } sub domain_breakdown_json { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'view_list' ); $list = $admin_list; my $type = $q->param('type') || 'list'; require DADA::MailingList::Subscribers; my $lh = DADA::MailingList::Subscribers->new( { -list => $list } ); $lh->domain_stats_json( { -type => $type, -count => 15, -printout => 1, } ); } sub search_list_auto_complete { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'view_list' ); $list = $admin_list; my $query = xss_filter( $q->param('query') ) || undef; my $type = xss_filter( $q->param('type') ) || 'list'; my $lh = DADA::MailingList::Subscribers->new( { -list => $list } ); my ( $total_num, $subscribers ) = $lh->search_list( { -query => $query, -type => $type, '-length' => 10, } ); my $r = []; for my $result (@$subscribers) { push( @$r, { 'email' => $result->{email} } ); } require JSON; my $json = JSON->new->allow_nonref; print $q->header('application/json'); print $json->encode($r); } sub list_activity { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'list_activity' ); $list = $admin_list; require DADA::App::LogSearch; my $dals = DADA::App::LogSearch->new; my $r = $dals->list_activity( { -list => $list, } ); my $i; for ( $i = 0 ; $i <= ( scalar(@$r) - 1 ) ; $i++ ) { $r->[$i]->{show_email} = 1; } require DADA::Template::Widgets; e_print( DADA::Template::Widgets::wrap_screen( { -list => $list, -screen => 'list_activity_screen.tmpl', -with => 'admin', -wrapper_params => { -Root_Login => $root_login, -List => $list, }, -vars => { history => $r, }, -expr => 1, } ) ); } sub sub_unsub_trends_json { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'list_activity' ); $list = $admin_list; my $days = xss_filter( strip( $q->param('days') ) ); require DADA::App::LogSearch; my $dals = DADA::App::LogSearch->new; my $r = $dals->sub_unsub_trends_json( { -list => $list, -printout => 1, -days => $days, } ); } sub view_bounce_history { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'view_list' ); $list = $admin_list; my $return_to = $q->param('return_to') || 'view_list'; my $return_address = $q->param('return_address') || undef; require DADA::App::BounceHandler::Logs; my $bhl = DADA::App::BounceHandler::Logs->new; my $results = $bhl->search( { -query => $email, -list => $list, -file => $DADA::Config::LOGS . '/bounces.txt', } ); require DADA::Template::Widgets; e_print( $q->header ); e_print( DADA::Template::Widgets::screen( { -screen => 'bounce_search_results_modal_menu.tmpl', -vars => { search_results => $results, total_bounces => scalar(@$results), email => $email, type => 'bounced_list', return_to => $return_to, return_address => $return_address, } } ) ); } sub subscription_requests { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'view_list' ); $list = $admin_list; if ( defined( $q->param('list') ) ) { if ( $list ne $q->param('list') ) { logout( -redirect_url => $DADA::Config::S_PROGRAM_URL . '?' . $q->query_string(), ); return; } } my @address = $q->param('address'); my $return_to = $q->param('return_to') || ''; my $return_address = $q->param('return_address') || ''; my $count = 0; require DADA::MailingList::Settings; my $ls = DADA::MailingList::Settings->new( { -list => $list } ); my $lh = DADA::MailingList::Subscribers->new( { -list => $list } ); if ( $q->param('process') =~ m/approve/i ) { for my $email (@address) { $lh->move_subscriber( { -email => $email, -from => 'sub_request_list', -to => 'list', -mode => 'writeover', -confirmed => 1, } ); $lh->remove_subscriber( { -email => $email, -type => 'sub_confirm_list', } ); my $new_pass = ''; my $new_profile = 0; if ( $DADA::Config::PROFILE_OPTIONS->{enabled} == 1 && $DADA::Config::SUBSCRIBER_DB_TYPE =~ m/SQL/ ) { # Make a profile, if needed, require DADA::Profile; my $prof = DADA::Profile->new( { -email => $email } ); if ( !$prof->exists ) { $new_profile = 1; $new_pass = $prof->_rand_str(8); $prof->insert( { -password => $new_pass, -activated => 1, } ); } # / Make a profile, if needed, } require DADA::App::Messages; DADA::App::Messages::send_subscription_request_approved_message( { -list => $list, -email => $email, -ls_obj => $ls, #-test => $self->test, -vars => { new_profile => $new_profile, 'profile.email' => $email, 'profile.password' => $new_pass, } } ); $count++; } my $flavor_to_return_to = 'view_list'; if ( $return_to eq 'membership' ) { # or, others... $flavor_to_return_to = $return_to; } my $qs = 'f=' . $flavor_to_return_to . '&type=' . $q->param('type') . '&approved_count=' . $count; if ( $return_to eq 'membership' ) { $qs .= '&email=' . $return_address; } print $q->redirect( -uri => $DADA::Config::S_PROGRAM_URL . '?' . $qs ); } elsif ( $q->param('process') =~ m/deny/i ) { for my $email (@address) { $lh->remove_subscriber( { -email => $email, -type => 'sub_request_list', } ); $lh->remove_subscriber( { -email => $email, -type => 'sub_confirm_list', } ); require DADA::App::Messages; DADA::App::Messages::send_subscription_request_denied_message( { -list => $list, -email => $email, -ls_obj => $ls, #-test => $self->test, } ); $count++; } my $flavor_to_return_to = 'view_list'; if ( $return_to eq 'membership' ) { # or, others... $flavor_to_return_to = $return_to; } my $qs = 'f=' . $flavor_to_return_to . '&type=' . $q->param('type') . '&denied_count=' . $count; if ( $return_to eq 'membership' ) { $qs .= '&email=' . $return_address; } print $q->redirect( -uri => $DADA::Config::S_PROGRAM_URL . '?' . $qs ); } else { die "unknown process!"; } } sub remove_all_subscribers { # This needs that email notification as well... # I need to first, clone the list and then do my thing. # Cloning will be really be resource intensive, so we can't do # checks on each address, # maybe the only check we'll do is to see if anything currently exists. # If there is? Don't do the clone. # If there isn't Do the clone # maybe have a parameter saying what to do on an error. # or just return undef. my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'view_list', ); $list = $admin_list; my $black_list_add = 0; my $type = xss_filter( $q->param('type') ); my $lh = DADA::MailingList::Subscribers->new( { -list => $list } ); my $ls = DADA::MailingList::Settings->new( { -list => $list } ); require DADA::App::MassSend; if ( $type eq 'list' ) { if ( $ls->param('send_unsubscribed_by_list_owner_message') == 1 ) { require DADA::App::MassSend; eval { DADA::App::MassSend::just_unsubscribed_mass_mailing( { -list => $list, -send_to_everybody => 1, } ); }; if ($@) { carp $@; } } if ( $ls->param('black_list') == 1 && $ls->param('add_unsubs_to_black_list') == 1 ) { $black_list_add = $lh->copy_all_subscribers( { -from => 'list', -to => 'black_list', } ); } } my $count = $lh->remove_all_subscribers( { -type => $type, } ); print $q->redirect( -uri => $DADA::Config::S_PROGRAM_URL . '?f=view_list&delete_email_count=' . $count . '&type=' . $type . '&black_list_add=' . $black_list_add ); return; } sub filter_using_black_list { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'filter_using_black_list' ); $list = $admin_list; if ( !$process ) { my $lh = DADA::MailingList::Subscribers->new( { -list => $list } ); my $ls = DADA::MailingList::Settings->new( { -list => $list } ); my $filtered = $lh->filter_list_through_blacklist; require DADA::Template::Widgets; my $scrn = DADA::Template::Widgets::wrap_screen( { -list => $list, -screen => 'filter_using_black_list.tmpl', -with => 'admin', -wrapper_params => { -Root_Login => $root_login, -List => $list, }, -vars => { filtered => $filtered, }, } ); e_print($scrn); } } sub membership { if ( !$email ) { view_list(); return; } my $type = $q->param('type') || 'list'; my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'membership' ); $list = $admin_list; require DADA::MailingList::Settings; my $ls = DADA::MailingList::Settings->new( { -list => $list } ); my $lh = DADA::MailingList::Subscribers->new( { -list => $list } ); my $query = xss_filter( $q->param('query') ) || undef; my $page = xss_filter( $q->param('page') ) || 1; my $type = xss_filter( $q->param('type') ); my $order_by = $q->param('order_by') || $ls->param('view_list_order_by'); my $order_dir = $q->param('order_dir') || lc($ls->param('view_list_order_by_direction')); my $add_email_count = $q->param('add_email_count') || 0; my $delete_email_count = $q->param('delete_email_count'); my $black_list_add = $q->param('black_list_add') || 0; my $approved_count = $q->param('approved_count') || 0; my $denied_count = $q->param('denied_count') || 0; my $bounced_list_moved_to_list_count = $q->param('bounced_list_moved_to_list_count') || 0; my $bounced_list_removed_from_list = $q->param('bounced_list_removed_from_list') || 0; my $profile_exists = 0; require DADA::Profile; my $prof = DADA::Profile->new({ -email => $email } ); if($prof) { $profile_exists = $prof->exists; } if ($process) { if ($root_login != 1 && $ls->param('allow_profile_editing') != 1) { die "You must be logged in with the Dada Mail Root Password to be able to edit a Subscriber's Profile Fields."; } my $new_fields = {}; for my $nfield ( @{ $lh->subscriber_fields() } ) { if ( defined( $q->param($nfield) ) ) { $new_fields->{$nfield} = $q->param($nfield); } } my $fields = DADA::Profile::Fields->new; $fields->insert( { -email => $email, -fields => $new_fields, } ); print $q->redirect( -uri => $DADA::Config::S_PROGRAM_URL . '?f=membership&email=' . $email . '&type=' . $type . '&done=1' ); return; } else { my $fields = []; my $subscriber_info = {}; # this is a hack - if type has nothing, this fails, so we fill it in with, "list" if ( !defined($type) || $type eq '' ) { $type = 'list'; } $subscriber_info = $lh->get_subscriber( { -email => $email } ); # DEV: This is repeated quite a bit... require DADA::ProfileFieldsManager; my $pfm = DADA::ProfileFieldsManager->new; my $fields_attr = $pfm->get_all_field_attributes; for my $field ( @{ $lh->subscriber_fields() } ) { push( @$fields, { name => $field, value => $subscriber_info->{$field}, label => $fields_attr->{$field}->{label}, required => $fields_attr->{$field}->{required}, } ); } my $subscribed_to_lt = {}; for ( @{ $lh->member_of( { -email => $email } ) } ) { $subscribed_to_lt->{$_} = 1; } my %add_list_types = %list_types; my $add_to = { list => 1, black_list => 1, white_list => 1, authorized_senders => 1, moderators => 1, }; # Except when, it's already a part of that sublist: for ( keys %$subscribed_to_lt ) { delete( $add_to->{$_} ); # if $subscribed_to_lt->{$_} == 1; } # Or if it's blacklisted... can't add! if ( $ls->param('closed_list') == 1 ) { delete( $add_to->{list} ); } if ( $ls->param('black_list') == 1 && $ls->param('allow_admin_to_subscribe_blacklisted') != 1 && $subscribed_to_lt->{black_list} == 1 ) { delete( $add_to->{list} ); } if ( $ls->param('enable_subscription_approval_step') && $subscribed_to_lt->{sub_request_list} ) { delete( $add_to->{list} ); } # if Authorized Senders isn't active, well, let's not allow to be added: if ( $ls->param('enable_authorized_sending') == 1 ) { #... } else { delete( $add_to->{authorized_senders} ); } # if Moderators isn't active, well, let's not allow to be added: if ( $ls->param('enable_moderation') == 1 ) { #... } else { delete( $add_to->{moderators} ); } # Same with the white list if ( $ls->param('enable_white_list') == 1 ) { #... } else { delete( $add_to->{white_list} ); } my $is_bouncing_address = 0; my $bouncing_info = ''; if ( $subscribed_to_lt->{bounced_list} == 1 ) { $is_bouncing_address = 1; } my $add_to_popup_menu = $q->popup_menu( -name => 'type', -id => 'type_add', -default => 'list', '-values' => [ keys %$add_to ], -labels => \%add_list_types, ); # Only if black list is enabled and they're not currently subscribed. if ( $ls->param('black_list') == 1 && $subscribed_to_lt->{list} != 1 ) { # ... } else { delete( $add_to->{black_list} ); } my $member_of = []; my $remove_from = []; foreach (%$subscribed_to_lt) { if ( $_ =~ m/^(list|black_list|white_list|authorized_senders|moderators|bounced_list)$/ ) { push( @$member_of, { type => $_, type_title => $list_types{$_} } ); push( @$remove_from, $_ ); } } my $remove_from_popup_menu = $q->popup_menu( -name => 'type_remove', -id => 'type_remove', '-values' => $remove_from, -labels => \%list_types, ); my @update_option_values = ( ':all', ( keys %$subscribed_to_lt ) ); my %update_option_labels = ( ':all' => 'All Sublists', %list_types ); my $update_address_popup_menu = $q->popup_menu( -name => 'type_update', -id => 'type_update', '-values' => [@update_option_values], -labels => {%update_option_labels}, ); my $subscribed_to_list = 0; if ( $subscribed_to_lt->{list} == 1 ) { $subscribed_to_list = 1; } my $subscribed_to_sub_request_list = 0; if ( $subscribed_to_lt->{sub_request_list} == 1 ) { $subscribed_to_sub_request_list = 1; } require DADA::Template::Widgets; my $scrn = DADA::Template::Widgets::wrap_screen( { -screen => 'membership_screen.tmpl', -with => 'admin', -wrapper_params => { -Root_Login => $root_login, -List => $list, }, -expr => 1, -vars => { done => $done, email => $email, type => $type, page => $page, query => $query, order_by => $order_by, order_dir => $order_dir, type_title => $type_title, fields => $fields, root_login => $root_login, profile_exists => $profile_exists, add_to_popup_menu => $add_to_popup_menu, update_address_popup_menu => $update_address_popup_menu, remove_from_popup_menu => $remove_from_popup_menu, remove_from_num => scalar(@$remove_from), member_of => $member_of, is_bouncing_address => $is_bouncing_address, rand_string => generate_rand_string(), member_of_num => scalar(@$remove_from), add_to_num => scalar( keys %$add_to ), subscribed_to_list => $subscribed_to_list, subscribed_to_sub_request_list => $subscribed_to_sub_request_list, add_email_count => $add_email_count, delete_email_count => $delete_email_count, black_list_add => $black_list_add, approved_count => $approved_count, denied_count => $denied_count, bounced_list_moved_to_list_count => $bounced_list_moved_to_list_count, bounced_list_removed_from_list => $bounced_list_removed_from_list, can_have_subscriber_fields => $lh->can_have_subscriber_fields, }, -list_settings_vars_param => { -list => $list, -dot_it => 1, }, } ); e_print($scrn); } } sub validate_update_email { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'membership' ); $list = $admin_list; require DADA::MailingList::Subscribers; require DADA::MailingList::Subscriber::Validate; require DADA::MailingList::Settings; my %list_types = ( list => 'Subscribers', black_list => 'Black Listed', authorized_senders => 'Authorized Senders', moderators => 'Moderators', white_list => 'White Listed', sub_request_list => 'Subscription Requests', unsub_request_list => 'Unsubscription Requests', bounced_list => 'Bouncing Addresses', ); my %error_title = ( invalid_email => 'Invalid Email Address', subscribed => 'Already Subscribed', mx_lookup_failed => 'MX Lookup Failed', black_listed => 'Black Listed', not_white_listed => 'Not on the White List', ); my $for_all_lists = $q->param('for_all_lists') || 0; my $lists_to_validate = []; my $email = cased( xss_filter( $q->param('email') ) ); my $updated_email = cased( xss_filter( $q->param('updated_email') ) ); my $process = $q->param('process') || 0; my $list_lh = DADA::MailingList::Subscribers->new( { -list => $list } ); # not sure where I'm going with, with, "can_have_subscriber_fields" if ( $list_lh->can_have_subscriber_fields ) { if ( $for_all_lists == 1 && $root_login == 1 ) { require DADA::Profile; my $prof = DADA::Profile->new( { -email => $email } ); $lists_to_validate = $prof->subscribed_to; } else { push( @$lists_to_validate, $list ); } } else { push( @$lists_to_validate, $list ); } # old address if ( $process != 1 ) { my $list_validations = []; my $none_validated = 1; for my $to_validate_list (@$lists_to_validate) { my $type_reports = []; my $lh = DADA::MailingList::Subscribers->new( { -list => $to_validate_list } ); my $sv = DADA::MailingList::Subscriber::Validate->new( { -list => $to_validate_list } ); my $ls = DADA::MailingList::Settings->new( { -list => $to_validate_list } ); for my $type ( @{ $lh->member_of( { -email => $email, -types => [ qw(list black_list white_list authorized_senders moderators) ], } ) } ) { my $sublists = []; # new address my ( $sub_status, $sub_errors ) = $sv->subscription_check( { -email => $updated_email, -type => $type, -skip => [ 'closed_list', 'over_subscription_quota', 'already_sent_sub_confirmation', 'invite_only_list', 'profile_fields', ( $ls->param('allow_admin_to_subscribe_blacklisted') == 1 ) ? ( 'black_listed', ) : (), ], } ); if ( $sub_status == 1 && $none_validated == 1 ) { $none_validated = 0; } my $errors = []; for ( keys %$sub_errors ) { push( @$errors, { error => $_, error_title => $error_title{$_} } ); } $sublists = { type => $type, type_label => $list_types{$type}, status => $sub_status, errors => $errors, 'list_settings.list' => $ls->param('list'), }; push( @$type_reports, $sublists ); } push( @$list_validations, { 'list_settings.list' => $ls->param('list'), 'list_settings.list_name' => $ls->param('list_name'), sublists => $type_reports }, ); } require Data::Dumper; require DADA::Template::Widgets; my $scrn = DADA::Template::Widgets::screen( { -screen => 'validate_update_email_widget.tmpl', -expr => 1, -vars => { email => $email, updated_email => $updated_email, update_list_validation => $list_validations, none_validated => $none_validated, validate_dump => Data::Dumper::Dumper($list_validations), #all_list_status => $all_list_status, #all_list_reports => $all_list_reports, #for_all_lists => $for_all_lists, #root_login => $root_login, }, } ); print $q->header(); e_print($scrn); } else { my @update_list = $q->param('update_list'); my $total_u_count = 0; foreach my $update_list (@update_list) { my ( $u_list, $u_type ) = split( ':', $update_list, 2 ); my $lh = DADA::MailingList::Subscribers->new( { -list => $u_list } ); my ($u_count) = $lh->admin_update_address( { -email => $email, -updated_email => $updated_email, -type => $u_type, -validation_check => 0, } ); $total_u_count = $total_u_count + $u_count; } my $return_to = 'membership'; my $return_address = $updated_email; my $qs = 'flavor=' . $return_to . '&update_email_count=' . $total_u_count; if ( $return_to eq 'membership' ) { $qs .= '&email=' . $return_address; } print $q->redirect( -uri => $DADA::Config::S_PROGRAM_URL . '?' . $qs ); } } sub also_member_of { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'membership' ); my $list = $admin_list; my $email = xss_filter( $q->param('email') ); my $type = xss_filter( $q->param('type') ) || 'list'; my $lh = DADA::MailingList::Subscribers->new( { -list => $list } ); my $mto = 0; my @also_subscribed_to = $lh->also_subscribed_to( { -email => $email, -types => [qw(list black_list white_list authorized_senders moderators)], } ); if ( scalar @also_subscribed_to > 0 ) { $mto = 1; } require JSON; my $json = JSON->new->allow_nonref; print $q->header('application/json'); print $json->encode( { also_member_of => int($mto), } ); } sub validate_remove_email { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'membership' ); my $list = $admin_list; my $email = xss_filter( $q->param('email') ); my $process = xss_filter( $q->param('process') ) || 0; my @remove_from_list = $q->param('remove_from_list'); my $return_to = xss_filter( $q->param('return_to') ) || 0; my $for_multiple_lists = xss_filter( $q->param('for_multiple_lists') ) || 0; my $lh = DADA::MailingList::Subscribers->new( { -list => $list } ); my $ls = DADA::MailingList::Settings->new( { -list => $list } ); if ( !$process ) { my @lists = ($list); if ( $for_multiple_lists == 1 ) { my @also_subscribed_to = $lh->also_subscribed_to( { -email => $email, -types => [qw(list black_list white_list authorized_senders moderators)], } ); @lists = ( @lists, @also_subscribed_to ); } my $subscribed_lists = []; foreach my $tmp_list (@lists) { my $tmp_ls = DADA::MailingList::Settings->new( { -list => $tmp_list } ); my $tmp_lh = DADA::MailingList::Subscribers->new( { -list => $tmp_list } ); my $sublists = []; for my $sublist ( @{ $tmp_lh->member_of( { -email => $email, -types => [ qw(list black_list white_list authorized_senders moderators) ], } ) } ) { push( @$sublists, { type => $sublist, type_label => $list_types{$sublist}, 'list_settings.list' => $tmp_ls->param('list'), 'list_settings.list_name' => $tmp_ls->param('list_name'), } ); } push( @$subscribed_lists, { 'list_settings.list' => $tmp_ls->param('list'), 'list_settings.list_name' => $tmp_ls->param('list_name'), sublists => $sublists, } ); } require Data::Dumper; my $subscribed_lists_dump = Data::Dumper::Dumper($subscribed_lists); require DADA::Template::Widgets; print $q->header(); e_print( DADA::Template::Widgets::screen( { -screen => 'validate_remove_email_widget.tmpl', -vars => { email => $email, list_type => $type, list_type_label => $list_types{$type}, for_multiple_lists => $for_multiple_lists, subscribed_lists => $subscribed_lists, subscribed_lists_dump => $subscribed_lists_dump, } } ) ); } else { my $full_d_count = 0; my $full_bl_count = 0; foreach my $remove_list (@remove_from_list) { my ( $r_list, $r_type ) = split( ':', $remove_list, 2 ); my $lh = DADA::MailingList::Subscribers->new( { -list => $r_list } ); my ( $d_count, $bl_count ) = $lh->admin_remove_subscribers( { -addresses => [$email], -type => $r_type, -validation_check => 0, } ); $full_d_count = $full_d_count + $d_count; $full_bl_count = $full_bl_count + $bl_count; } my $return_address = $email; my $qs = 'flavor=' . $return_to . '&delete_email_count=' . $full_d_count . '&type=' . '' . '&black_list_add=' . $full_bl_count; if ( $return_to eq 'membership' ) { $qs .= '&email=' . $return_address; } print $q->redirect( -uri => $DADA::Config::S_PROGRAM_URL . '?' . $qs ); } } sub mailing_list_history { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'membership' ); $list = $admin_list; my $email = xss_filter( $q->param('email') ); my $membership_history = xss_filter( $q->param('membership_history') ) || 'this_list'; my $mode = xss_filter( $q->param('mode') ) || 'html'; require DADA::App::LogSearch; my $searcher = DADA::App::LogSearch->new; my $r; if ( $membership_history eq 'this_list' ) { $r = $searcher->subscription_search( { -email => $email, -list => $list, } ); } else { $r = $searcher->subscription_search( { -email => $email, } ); } @$r = reverse(@$r); if ( $mode eq 'html' ) { my $i; for ( $i = 0 ; $i <= ( scalar(@$r) - 1 ) ; $i++ ) { $r->[$i]->{show_email} = 0; unless ( $membership_history eq 'this_list' ) { $r->[$i]->{show_list_name} = 1; } } require DADA::Template::Widgets; my $scrn = DADA::Template::Widgets::screen( { -screen => 'filtered_list_activity_widget.tmpl', -expr => 1, -vars => { history => $r, #raw_history => Dumper($r), }, } ); print $q->header(); e_print($scrn); } elsif ( $mode eq 'export_csv' ) { require Text::CSV; my $csv = Text::CSV->new($DADA::Config::TEXT_CSV_PARAMS); my $fh = \*STDOUT; my $header = $q->header( -attachment => 'membership_history-' . $list . '-' . time . '.csv', -type => 'text/csv', ); print $fh $header; my @cols = qw( date list list_name ip email type type_title action updated_email ); my $status = $csv->print( $fh, [@cols] ); print $fh "\n"; for my $line (@$r) { my @lines = (); foreach (@cols) { push( @lines, $line->{$_} ); } $status = $csv->print( $fh, [@lines] ); print $fh "\n"; } } } sub membership_activity { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'membership' ); $list = $admin_list; my $email = xss_filter( $q->param('email') ); my $mode = xss_filter( $q->param('mode') ) || 'html'; if ( $mode eq 'html' ) { require DADA::Logging::Clickthrough; my $rd = DADA::Logging::Clickthrough->new( { -list => $list } ); require DADA::MailingList::Archives; my $ma = DADA::MailingList::Archives->new( { -list => $list } ); print $q->header(); my $activity_tables = []; my ( $total, $mids ) = $rd->get_all_mids; foreach my $mid (@$mids) { my $plugin_url = $DADA::Config::S_PROGRAM_URL; $plugin_url =~ s/mail\.cgi$/plugins\/tracker.cgi/; my $activity_table = $rd->message_individual_email_activity_report_table( { -mid => $mid, -email => $email, -plugin_url => $plugin_url, } ); my $archive_exists = 0; my $archive_subject = ''; if ( $ma->check_if_entry_exists($mid) ) { $archive_exists = 1; $archive_subject = $ma->get_archive_subject($mid); } push( @$activity_tables, { activity_table => $activity_table, archive_exists => $archive_exists, archive_subject => $archive_subject, mid => $mid, } ); } require DADA::Template::Widgets; my $scrn = DADA::Template::Widgets::screen( { -screen => 'membership_activity_screen.tmpl', -vars => { activity_tables => $activity_tables, }, -list_settings_vars_param => { -list => $list, -dot_it => 1, }, } ); print $scrn; } else { my $at_email = $email; $at_email =~ s/\@/_at_/; require DADA::Logging::Clickthrough; my $rd = DADA::Logging::Clickthrough->new( { -list => $list } ); require Text::CSV; my $csv = Text::CSV->new($DADA::Config::TEXT_CSV_PARAMS); my $fh = \*STDOUT; my $header = $q->header( -attachment => 'membership_activity-' . $at_email . '-' . $list . '-' . time . '.csv', -type => 'text/csv', ); print $fh $header; # timestamp # time # event_label my @cols = qw( ctime mid email ip event url ); my $status = $csv->print( $fh, [@cols] ); print $fh "\n"; my ( $total, $mids ) = $rd->get_all_mids; foreach my $mid (@$mids) { my $report = $rd->message_individual_email_activity_report( { -mid => $mid, -email => $email, } ); for my $line (@$report) { my @lines = (); foreach (@cols) { if ( $_ eq 'email' ) { push( @lines, $email ); } elsif ( $_ eq 'mid' ) { push( @lines, $mid ); } else { push( @lines, $line->{$_} ); } } $status = $csv->print( $fh, [@lines] ); print $fh "\n"; } } } } sub admin_change_profile_password { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'membership' ); my $list = $admin_list; my $profile_password = xss_filter( $q->param('profile_password') ); my $email = xss_filter( $q->param('email') ); my $type = xss_filter( $q->param('type') ); require DADA::Profile; my $prof = DADA::Profile->new( { -email => $email } ); if ( $prof->exists ) { $prof->update( { -password => $profile_password, } ); # Reactivate the Account. ? $prof->activate(); } else { $prof->insert( { -password => $profile_password, -activated => 1, } ); } # DEV: This is going to get repeated quite a bit.. require DADA::Profile::Htpasswd; foreach my $p_list ( @{ $prof->subscribed_to } ) { my $htp = DADA::Profile::Htpasswd->new( { -list => $p_list } ); for my $id ( @{ $htp->get_all_ids } ) { $htp->setup_directory( { -id => $id } ); } } # print $q->redirect( -uri => $DADA::Config::S_PROGRAM_URL . '?f=membership&email=' . $email . '&type=' . $type . '&done=1' ); return; } sub add { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'add' ); $list = $admin_list; my $chrome = $q->param('chrome'); if ( $chrome ne '0' ) { $chrome = 1; } my $type = $q->param('type') || 'list'; my $return_to = $q->param('return_to') || ''; my $return_address = $q->param('return_address') || ''; my $lh = DADA::MailingList::Subscribers->new( { -list => $list } ); if ( $q->param('process') ) { if ( $q->param('method') eq 'via_add_one' ) { # We're going to fake the, "via_textarea", buy just make a CSV file, and plunking it # in the, "new_emails" CGI param. (Hehehe); my @columns = (); push( @columns, xss_filter( $q->param('email') ) ); for ( @{ $lh->subscriber_fields() } ) { push( @columns, xss_filter( $q->param($_) ) ); } if($type eq 'list' && $lh->can_have_subscriber_fields){ push( @columns, xss_filter( $q->param('profile_password') ) ); } require Text::CSV; my $csv = Text::CSV->new($DADA::Config::TEXT_CSV_PARAMS); my $status = $csv->combine(@columns); # combine columns into a string my $line = $csv->string(); # get the combined string $q->param( 'new_emails', $line ); $q->param( 'method', 'via_textarea' ); # End shienanengans. } if ( $q->param('method') eq 'via_file_upload' ) { if ( strip( $q->param('new_email_file') ) eq '' ) { print $q->redirect( -uri => $DADA::Config::S_PROGRAM_URL . '?f=add' ); return; } } elsif ( $q->param('method') eq 'via_textarea' ) { if ( strip( $q->param('new_emails') ) eq '' ) { print $q->redirect( -uri => $DADA::Config::S_PROGRAM_URL . '?f=add' ); return; } } # DEV: This whole building of query string is much too messy. my $qs = '&type=' . $q->param('type') . '&new_email_file=' . $q->param('new_email_file'); if ( DADA::App::Guts::strip( $q->param('new_emails') ) ne "" ) { # DEV: why is it, "new_emails.txt"? Is that supposed to be a variable? my $outfile = make_safer( $DADA::Config::TMP . '/' . $q->param('rand_string') . '-' . 'new_emails.txt' ); open( OUTFILE, '>:encoding(UTF-8)', $outfile ) or die "can't write to " . $outfile . ": $!"; # DEV: TODO encoding? print OUTFILE $q->param('new_emails'); close(OUTFILE); chmod( $DADA::Config::FILE_CHMOD, $outfile ); # DEV: why is it, "new_emails.txt"? Is that supposed to be a variable? print $q->redirect( -uri => $DADA::Config::S_PROGRAM_URL . '?f=add_email&fn=' . $q->param('rand_string') . '-' . 'new_emails.txt' . $qs . '&return_to=' . $return_to . '&return_address=' . $return_address . '&chrome=' . $chrome ); } else { if ( $q->param('method') eq 'via_file_upload' ) { upload_that_file($q); } my $filename = $q->param('new_email_file'); $filename =~ s!^.*(\\|\/)!!; $filename = uriescape($filename); print $q->redirect( -uri => $DADA::Config::S_PROGRAM_URL . '?f=add_email&fn=' . $q->param('rand_string') . '-' . $filename . $qs ); } } else { require DADA::MailingList::Settings; my $ls = DADA::MailingList::Settings->new( { -list => $list } ); my $num_subscribers = $lh->num_subscribers; my $subscription_quota_reached = 0; if ( $type eq 'list' ) { if ( $ls->param('use_subscription_quota') == 1 && ( $num_subscribers >= $ls->param('subscription_quota') ) && ( $num_subscribers + $ls->param('subscription_quota') > 1 ) ) { $subscription_quota_reached = 1; } elsif (defined($DADA::Config::SUBSCRIPTION_QUOTA) && $DADA::Config::SUBSCRIPTION_QUOTA > 0 && $num_subscribers >= $DADA::Config::SUBSCRIPTION_QUOTA ) { $subscription_quota_reached = 1; } } my $list_type_switch_widget = $q->popup_menu( -name => 'type', '-values' => [ keys %list_types ], -labels => \%list_types, -default => $type, ); my $rand_string = generate_rand_string(); my $fields = []; # DEV: This is repeated quite a bit... require DADA::ProfileFieldsManager; my $pfm = DADA::ProfileFieldsManager->new; my $fields_attr = $pfm->get_all_field_attributes; for my $field ( @{ $lh->subscriber_fields() } ) { push( @$fields, { name => $field, label => $fields_attr->{$field}->{label}, required => $fields_attr->{$field}->{required}, } ); } my $list_is_closed = 0; if ( $type eq 'list' && $ls->param('closed_list') == 1 ) { $list_is_closed = 1; } require DADA::Template::Widgets; my $scrn = DADA::Template::Widgets::wrap_screen( { -screen => 'add_screen.tmpl', -with => 'admin', -wrapper_params => { -Root_Login => $root_login, -List => $list, }, -expr => 1, -vars => { screen => 'add', root_login => $root_login, subscription_quota_reached => $subscription_quota_reached, num_subscribers => $num_subscribers, SUBSCRIPTION_QUOTA => $DADA::Config::SUBSCRIPTION_QUOTA, type => $type, type_title => $type_title, flavor => 'add', rand_string => $rand_string, list_subscribers_num => $lh->num_subscribers( { -type => 'list' } ), black_list_subscribers_num => $lh->num_subscribers( { -type => 'black_list' } ), white_list_subscribers_num => $lh->num_subscribers( { -type => 'white_list' } ), authorized_senders_num => $lh->num_subscribers( { -type => 'authorized_senders' } ), moderators_num => $lh->num_subscribers( { -type => 'moderators' } ), bounced_list_num => $lh->num_subscribers( { -type => 'bounced_list' } ), fields => $fields, can_have_subscriber_fields => $lh->can_have_subscriber_fields, list_is_closed => $list_is_closed, }, -list_settings_vars_param => { -list => $list, -dot_it => 1, }, } ); e_print($scrn); } } sub check_status { require JSON; my $json = JSON->new->allow_nonref; my $filename = $q->param('new_email_file'); $filename =~ s{^(.*)\/}{}; $filename = uriescape($filename); if ( !-e $DADA::Config::TMP . '/' . $filename . '-meta.txt' ) { warn "no meta file at: " . $DADA::Config::TMP . '/' . $filename . '-meta.txt'; my $json = JSON->new->allow_nonref; print $q->header('application/json'); print $json->encode( { percent => 0, content_length => 0, bytes_read => 0 } ); } else { chmod( $DADA::Config::FILE_CHMOD, make_safer( $DADA::Config::TMP . '/' . $filename . '-meta.txt' ) ); open my $META, '<', make_safer( $DADA::Config::TMP . '/' . $filename . '-meta.txt' ) or die $!; my $s = do { local $/; <$META> }; my ( $bytes_read, $content_length, $per ) = split( '-', $s, 3 ); if ( $per == 99 ) { $per = 100 } close($META); my $json = JSON->new->allow_nonref; print $q->header('application/json'); print $json->encode( { bytes_read => $bytes_read, content_length => $content_length, percent => int($per), } ); } return; } sub dump_meta_file { my $filename = $q->param('new_email_file'); $filename =~ s{^(.*)\/}{}; $filename = uriescape($filename); my $full_path_to_filename = make_safer( $DADA::Config::TMP . '/' . $filename . '-meta.txt' ); if ( !-e $full_path_to_filename ) { } else { my $chmod_check = chmod( $DADA::Config::FILE_CHMOD, $full_path_to_filename ); if ( $chmod_check != 1 ) { warn "could not chmod '$full_path_to_filename' correctly."; } my $unlink_check = unlink($full_path_to_filename); if ( $unlink_check != 1 ) { warn "deleting meta file didn't work for: " . $full_path_to_filename; } } } sub generate_rand_string { #warn "generate_rand_string"; my $chars = shift || 'aAeEiIoOuUyYabcdefghijkmnopqrstuvwxyzABCDEFGHJKMNPQRSTUVWXYZ23456789'; my $num = shift || 1024; require Digest::MD5; my @chars = split '', $chars; my $ran; for ( 1 .. $num ) { $ran .= $chars[ rand @chars ]; } return Digest::MD5::md5_hex($ran); } sub upload_that_file { my $fh = $q->upload('new_email_file'); my $filename = $q->param('new_email_file'); $filename =~ s!^.*(\\|\/)!!; $filename = uriescape($filename); # warn '$filename ' . $filename; # warn '$q->param(\'rand_string\') ' . $q->param('rand_string'); # warn '$q->param(\'new_email_file\') ' . $q->param('new_email_file'); return '' if !$filename; my $outfile = make_safer( $DADA::Config::TMP . '/' . $q->param('rand_string') . '-' . $filename ); # warn ' $outfile ' . $outfile; open( OUTFILE, '>', $outfile ) or die( "can't write to " . $outfile . ": $!" ); while ( my $bytesread = read( $fh, my $buffer, 1024 ) ) { # warn $buffer; print OUTFILE $buffer; } close(OUTFILE); chmod( $DADA::Config::FILE_CHMOD, $outfile ); } sub add_email { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'add_email' ); $list = $admin_list; my $return_to = $q->param('return_to') || ''; my $return_address = $q->param('return_address') || ''; my $chrome = $q->param('chrome'); if ( $chrome ne '0' ) { $chrome = 1; } require DADA::MailingList::Settings; my $ls = DADA::MailingList::Settings->new( { -list => $list } ); require DADA::ProfileFieldsManager; my $pfm = DADA::ProfileFieldsManager->new; my $field_atts = $pfm->get_all_field_attributes; my $lh = DADA::MailingList::Subscribers->new( { -list => $list, -dpfm_obj => $pfm, } ); my $subscriber_fields = $lh->subscriber_fields; if ( !$process ) { my $new_emails_fn = $q->param('fn'); my $new_emails = []; my $new_info = []; if($ls->param('use_add_list_import_limit') == 1) { my $num_file_lines = DADA::App::Guts::num_file_lines($new_emails_fn); if($num_file_lines > $ls->param('add_list_import_limit')){ my $error = 'over_add_list_import_limit'; require DADA::Template::Widgets; my $scrn = DADA::Template::Widgets::wrap_screen( { -screen => 'add_email_error_screen.tmpl', -with => 'admin', -wrapper_params => { -Root_Login => $root_login, -List => $list, }, -expr => 1, -vars => { error => $error }, -list_settings_vars_param => { -list => $list, -dot_it => 1, }, } ); e_print($scrn); return; } } else { # ... } try { ( $new_emails ) = DADA::App::Guts::csv_subscriber_parse( $admin_list, $new_emails_fn ); } catch { my $error = $_; require DADA::Template::Widgets; my $scrn = DADA::Template::Widgets::wrap_screen( { -screen => 'add_email_error_screen.tmpl', -with => 'admin', -wrapper_params => { -Root_Login => $root_login, -List => $list, }, -expr => 1, -vars => { error => $error }, -list_settings_vars_param => { -list => $list, -dot_it => 1, }, } ); e_print($scrn); return; }; my ($not_members, $invalid_email, $subscribed, $black_listed, $not_white_listed, $invalid_profile_fields, ) = $lh->filter_subscribers_massaged_for_ht( { -emails => $new_emails, -type => $type } ); my $num_subscribers = $lh->num_subscribers; # and for some reason, this is its own subroutine... # This is down here, so the status bar won't disapear before this page is loaded (or the below redirect) dump_meta_file(); # This is to see if we're already over quota: my $subscription_quota_reached = 0; if ( $type eq 'list' ) { if ( $ls->param('use_subscription_quota') == 1 && ( $num_subscribers >= $ls->param('subscription_quota') ) && ( $num_subscribers + $ls->param('subscription_quota') > 1 ) ) { $subscription_quota_reached = 1; } elsif (defined($DADA::Config::SUBSCRIPTION_QUOTA) && $DADA::Config::SUBSCRIPTION_QUOTA > 0 && $num_subscribers >= $DADA::Config::SUBSCRIPTION_QUOTA ) { $subscription_quota_reached = 1; } } if ($subscription_quota_reached) { print $q->redirect( -uri => $DADA::Config::S_PROGRAM_URL . '?f=add&type=list' ); return; } my $going_over_quota = 0; if ( $type eq 'list' ) { if ( $ls->param('use_subscription_quota') == 1 && ( $num_subscribers + scalar(@$not_members) ) > $ls->param('subscription_quota') ) { $going_over_quota = 1; } elsif (defined($DADA::Config::SUBSCRIPTION_QUOTA) && $DADA::Config::SUBSCRIPTION_QUOTA > 0 && ( $num_subscribers + scalar(@$not_members) ) > $DADA::Config::SUBSCRIPTION_QUOTA ) { $going_over_quota = 1; } } my $addresses_to_add = 0; if ( defined( @$not_members[0] ) ) { $addresses_to_add = 1; } my $field_names = []; # if($type eq 'list') { for (@$subscriber_fields) { push( @$field_names, { name => $_, label => $field_atts->{$_}->{label}, } ); } # } if ( $type eq 'list' && $ls->param('closed_list') == 1 ) { die "Your list is currently CLOSED to subscribers."; } # If we're using the black list, but # the list owner is allowed to subscribed blacklisted addresses, # we have to communicate that to the template: if ( $ls->param('black_list') == 1 && $ls->param('allow_admin_to_subscribe_blacklisted') == 1 ) { for (@$black_listed) { $_->{'list_settings.allow_admin_to_subscribe_blacklisted'} = 1; } } my $show_invitation_button = 0; my $show_update_button = 0; my $show_add_button = 0; if ($type eq 'list') { if(scalar(@$not_members) > 0) { $show_invitation_button = 1; } elsif( scalar(@$black_listed) > 0 && $ls->param('allow_admin_to_subscribe_blacklisted') == 1 ) { $show_invitation_button = 1; } elsif( scalar($invalid_profile_fields) > 0 && ($root_login == 1 || $ls->param('allow_profile_editing') == 1) ){ $show_invitation_button = 1; } if( scalar(@$not_members < 1) && (scalar(@$black_listed) < 1 && $ls->param('allow_admin_to_subscribe_blacklisted') == 1) && scalar(@$subscribed) > 1 && ($root_login == 1 || $ls->param('allow_profile_editing') == 1) ) { $show_update_button = 1; } else { $show_add_button = 1; } } my %vars = ( show_invitation_button => $show_invitation_button, show_update_button => $show_update_button, show_add_button => $show_add_button, can_have_subscriber_fields => $lh->can_have_subscriber_fields, going_over_quota => $going_over_quota, field_names => $field_names, subscribed => $subscribed, not_members => $not_members, black_listed => $black_listed, not_white_listed => $not_white_listed, invalid_email => $invalid_email, invalid_profile_fields => $invalid_profile_fields, type => $type, type_title => $type_title, root_login => $root_login, return_to => $return_to, return_address => $return_address, chrome => $chrome, ); require DADA::Template::Widgets; my $scrn; if ( $chrome == 1 ) { $scrn = DADA::Template::Widgets::wrap_screen( { -screen => 'add_email_screen.tmpl', -with => 'admin', -wrapper_params => { -Root_Login => $root_login, -List => $list, }, -expr => 1, -vars => { %vars, }, -list_settings_vars_param => { -list => $list, -dot_it => 1, }, } ); } else { $scrn = DADA::Template::Widgets::screen( { -screen => 'add_email_screen.tmpl', -expr => 1, -vars => { %vars, }, -list_settings_vars_param => { -list => $list, -dot_it => 1, }, } ); print $q->header(); } e_print($scrn); } else { my $update_email_count = 0; if ( $type eq 'list' ) { if($process =~ m/subscribe|invit|update/i){ # This is what updates already existing profile fields and profile passwords; # my @update_fields_address = $q->param("update_fields_address"); my $subscribed_fields_options_mode = $q->param('subscribed_fields_options_mode') || 'writeover_inc_password'; my $spass_om = 'writeover'; if($subscribed_fields_options_mode eq 'writeover_ex_password'){ $spass_om = 'preserve_if_defined'; } my $update_email_count = 0; require DADA::Profile::Fields; require DADA::Profile; for my $ua (@update_fields_address) { my $ua_info = $lh->csv_to_cds($ua); my $dpf = DADA::Profile::Fields->new( { -email => $ua_info->{email} } ); $dpf->insert( { -fields => $ua_info->{fields}, -mode => 'writeover', } ); if ( defined( $ua_info->{profile}->{password} ) && $ua_info->{profile}->{password} ne '' ) { my $prof = DADA::Profile->new( { -email => $ua_info->{email} } ); if ($prof) { if ( $prof->exists ) { if($spass_om eq 'writeover') { $prof->update( { -password => $ua_info->{profile}->{password} } ); } elsif($spass_om eq 'preserve_if_defined'){ #.... } } else { $prof->insert( { -password => $ua_info->{profile}->{password}, -activated => 1, } ); } } } $update_email_count++; } ################################################################## } } if ( $process =~ /invit/i ) { &list_invite; return; } else { my $quota_limit = undef; if ( $type eq 'list' ) { if ( $ls->param('use_subscription_quota') == 1 ) { $quota_limit = $ls->param('subscription_quota'); } elsif ( defined($DADA::Config::SUBSCRIPTION_QUOTA) && $DADA::Config::SUBSCRIPTION_QUOTA > 0 ) { $quota_limit = $DADA::Config::SUBSCRIPTION_QUOTA; } } if($type eq 'list') { unless( $ls->param('enable_mass_subscribe') == 1 && ($root_login == 1 || $ls->param('enable_mass_subscribe_only_w_root_login') != 1)) { die "Mass Subscribing via the List Control Panel has been disabled."; } } my @address = $q->param("address"); my $not_members_fields_options_mode = $q->param('not_members_fields_options_mode') || 'preserve_if_defined'; my $new_email_count = 0; my $skipped_email_count = 0; my $num_subscribers = $lh->num_subscribers; my $new_total = $num_subscribers; # Each Address is a CSV line... for my $a (@address) { my $info = undef; my $dmls = undef; if ( $type eq 'list' && defined($quota_limit) && $new_total >= $quota_limit ) { $skipped_email_count++; } else { # profile/fields set should really only be for # when you import subscribers... # $info = $lh->csv_to_cds($a); # This will combine creation of the subscription, profile # and fields in one method. # my $pf_om = 'preserve_if_defined'; my $pass_om = 'preserve_if_defined'; if($not_members_fields_options_mode eq 'writeover_ex_password'){ $pf_om = 'writeover'; $pass_om = 'preserve_if_defined'; } elsif($not_members_fields_options_mode eq 'writeover_inc_password'){ $pf_om = 'writeover'; $pass_om = 'writeover'; } $dmls = $lh->add_subscriber( { -email => $info->{email}, -fields => $info->{fields}, -profile => { -password => $info->{profile}->{password}, -mode => $not_members_fields_options_mode, }, -type => $type, -fields_options => { -mode => $not_members_fields_options_mode, }, -dupe_check => { -enable => 1, -on_dupe => 'ignore_add', }, } ); $new_total++; if ( defined($dmls) ) { # undef means it wasn't added. $new_email_count++; } else { $skipped_email_count++; } } } if ( $type eq 'list' ) { if ( $ls->param('send_subscribed_by_list_owner_message') == 1 ) { require DADA::App::MassSend; eval { # DEV: # This needs to send the Profile Password, if it's known. # DADA::App::MassSend::just_subscribed_mass_mailing( { -list => $list, -addresses => [@address], } ); }; if ($@) { carp $@; } } if ( $ls->param('send_last_archived_msg_mass_mailing') == 1 ) { eval { DADA::App::MassSend::send_last_archived_msg_mass_mailing( { -list => $list, -addresses => [@address], } ); }; if ($@) { carp $@; } } } if ( $DADA::Config::PROFILE_OPTIONS->{enabled} == 1 && $DADA::Config::SUBSCRIBER_DB_TYPE =~ m/SQL/ ) { eval { require DADA::Profile::Htpasswd; my $htp = DADA::Profile::Htpasswd->new( { -list => $list } ); for my $id ( @{ $htp->get_all_ids } ) { $htp->setup_directory( { -id => $id } ); } }; if ($@) { warn "Problem updated Password Protected Directories: $@"; } } my $flavor_to_return_to = 'view_list'; if ( $return_to eq 'membership' ) { # or, others... $flavor_to_return_to = $return_to; } my $qs = 'flavor=' . $flavor_to_return_to . '&add_email_count=' . $new_email_count . '&skipped_email_count=' . $skipped_email_count . '&update_email_count=' . $update_email_count . '&type=' . $type; if ( $return_to eq 'membership' ) { $qs .= '&email=' . $return_address; } print $q->redirect( -uri => $DADA::Config::S_PROGRAM_URL . '?' . $qs ); } } } sub delete_email { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'delete_email', ); $list = $admin_list; my $type = $q->param('type') || 'list'; require DADA::MailingList::Settings; my $ls = DADA::MailingList::Settings->new( { -list => $list } ); my $lh = DADA::MailingList::Subscribers->new( { -list => $list } ); if ( !$process ) { require DADA::Template::Widgets; my $scrn = DADA::Template::Widgets::wrap_screen( { -screen => 'delete_email_screen.tmpl', -with => 'admin', -wrapper_params => { -Root_Login => $root_login, -List => $list, }, -expr => 1, -vars => { screen => 'delete_email', title => 'Remove', can_use_global_black_list => $lh->can_use_global_black_list, can_use_global_unsubscribe => $lh->can_use_global_unsubscribe, list_type_isa_list => ( $type eq 'list' ) ? 1 : 0, list_type_isa_black_list => ( $type eq 'black_list' ) ? 1 : 0, list_type_isa_authorized_senders => ( $type eq 'authorized_senders' ) ? 1 : 0, list_type_isa_moderators => ( $type eq 'moderators' ) ? 1 : 0, list_type_isa_white_list => ( $type eq 'white_list' ) ? 1 : 0, type => $type, type_title => $type_title, flavor => 'delete_email', list_subscribers_num => $lh->num_subscribers( { -type => 'list' } ), black_list_subscribers_num => $lh->num_subscribers( { -type => 'black_list' } ), white_list_subscribers_num => $lh->num_subscribers( { -type => 'white_list' } ), authorized_senders_num => $lh->num_subscribers( { -type => 'authorized_senders' } ), moderators_num => $lh->num_subscribers( { -type => 'moderators' } ), }, -list_settings_vars_param => { -list => $list, -dot_it => 1, }, } ); e_print($scrn); } else { my $delete_list = undef; my $delete_email_file = $q->param('delete_email_file'); if ($delete_email_file) { my $new_file = file_upload('delete_email_file'); open( UPLOADED, "$new_file" ) or die $!; $delete_list = do { local $/;
|
}; if ( $DADA::Config::ARCHIVE_DB_TYPE eq 'Db' && $h eq 'Content-type' ) { push( @{$D_Content_Types}, $headers{$h} ); $form_blob .= $q->p( $q->popup_menu( '-values' => $D_Content_Types, -id => $h, -name => $h, -default => $headers{$h} ) ); } else { my $value = $headers{$h}; if ( $ls->param('mime_encode_words_in_headers') == 1 ) { if ( $h =~ m/To|From|Cc|Reply\-To|Subject/ ) { $value = $ah->_decode_header($value); } } $form_blob .= $q->p( $q->textfield( -value => $value, -id => $h, -name => $h, -class => 'full' ) ); } $form_blob .= ' |
'; if ( $type =~ /^image/ && $subtype =~ m/gif|jpg|jpeg|png/ ) { $form_blob .= $q->p( $q->a( { -href => $attachment_url, -target => '_blank' }, $q->img( { -src => $attachment_url, -width => '100' } ) ) ); } else { #$form_blob .= $q->p($q->a({-href => $attachment_url, -target => '_blank'}, $q->strong('Attachment: ' ), $q->a({-href => $attachment_url, -target => '_blank'}, $name))); } $form_blob .= ' | '; $form_blob .= $q->p( $q->checkbox( -name => 'delete_' . $tb->{address}, -id => 'delete_' . $tb->{address}, -value => 1, -label => '' ), $q->label( { '-for' => 'delete_' . $tb->{address} }, 'Remove From Message' ) ); $form_blob .= $q->p( $q->strong('Update:'), $q->filefield( -name => 'upload_' . $tb->{address} ) ); $form_blob .= ' |
API Documentation: ' . $api_doc_url . '
'; return; } else { die '425'; } my $new_q = undef; if($using_jsonp == 0) { my $post_data = $q->param('POSTDATA'); my $data = undef; try { $data = $json->decode($post_data); } catch { die '400'; }; $new_q = CGI->new; $new_q->charset($DADA::Config::HTML_CHARSET); $new_q->delete_all; $new_q->param( 'list', $data->{list} ); $new_q->param( 'email', $data->{email} ); $new_q->param( 'f', 'subscribe' ); $new_q->param( 'flavor', 'subscribe' ); require DADA::ProfileFieldsManager; my $pfm = DADA::ProfileFieldsManager->new; # Profile Fields for ( @{ $pfm->fields } ) { if ( exists( $data->{fields}->{$_} ) ) { $new_q->param( $_, $data->{fields}->{$_} ); } } } else { $new_q = $q; } require DADA::App::Subscriptions; my $das = DADA::App::Subscriptions->new; my $callback = undef; if($using_jsonp) { $callback = xss_filter( strip( $q->url_param('callback') ) ); } my $header = undef; if ($using_jsonp) { $header = $new_q->header( -type => 'application/javascript', 'Access-Control-Allow-Origin' => '*', 'Access-Control-Allow-Methods' => 'POST', '-Cache-Control' => 'no-cache, must-revalidate', -expires => 'Mon, 26 Jul 1997 05:00:00 GMT', ); } else { $header = $new_q->header( -type => 'application/json', '-Cache-Control' => 'no-cache, must-revalidate', -expires => 'Mon, 26 Jul 1997 05:00:00 GMT', ); } my $json = $das->subscribe( { -cgi_obj => $new_q, -return_json => 1, } ); # warn "\$callback\n" . $callback; # warn "\$header\n" . $header; print $header; if ($using_jsonp) { e_print( $callback . '(' . $json . ');' ); } else { e_print( $json, "\n" ); } } sub unsubscribe { my %args = ( -html_output => 1, @_ ); require DADA::App::Subscriptions; my $das = DADA::App::Subscriptions->new; $das->unsubscribe( { -cgi_obj => $q, -html_output => $args{-html_output}, } ); } sub unsubscription_request { my %args = ( -html_output => 1, @_ ); require DADA::App::Subscriptions; my $das = DADA::App::Subscriptions->new; $das->unsubscription_request( { -cgi_obj => $q, -html_output => $args{-html_output}, } ); } sub outdated_subscription_urls { if ( check_if_list_exists( -List => $list ) == 0 ) { undef($list); &default; return; } my $orig_flavor = $q->param('orig_flavor') || undef; require DADA::Template::Widgets; my $scrn = DADA::Template::Widgets::wrap_screen( { -screen => 'outdated_subscription_urls_screen.tmpl', -with => 'list', -list => $list, -expr => 1, # -list_settings_vars_param => {-list => $list,}, # -subscriber_vars_param => {-list => $list, -email => $email, -type => 'list'}, -vars => { show_profile_widget => 0, orig_flavor => $orig_flavor, subscription_form => DADA::Template::Widgets::subscription_form( { -list => $list, -email => $email, -give_props => 0, -magic_form => 0, }, ), unsubscription_form => DADA::Template::Widgets::unsubscription_form( { -list => $list, -email => $email, }, ), } } ); e_print($scrn); } sub token { my %args = ( -html_output => 1, @_ ); require DADA::App::Subscriptions; my $das = DADA::App::Subscriptions->new; $das->token( { -cgi_obj => $q, -html_output => $args{-html_output}, } ); } sub report_abuse { my $report_abuse_token = $q->param('report_abuse_token'); my $process = $q->param('process') || 0; require DADA::App::Subscriptions::ConfirmationTokens; my $ct = DADA::App::Subscriptions::ConfirmationTokens->new(); if ( $ct->exists($report_abuse_token) ) { my $data = $ct->fetch($report_abuse_token); if ( $data->{data}->{flavor} eq 'report_abuse' ) { my $list = $data->{data}->{list}; require DADA::Template::Widgets; if($process != 1) { my $scrn = DADA::Template::Widgets::wrap_screen( { -screen => 'report_abuse.tmpl', -with => 'list', -vars => { report_abuse_token => $report_abuse_token, }, -list_settings_vars_param => { -list => $list, -dot_it => 1 }, } ); e_print($scrn); } else { my $abuse_report_details = $q->param('abuse_report_details'); $abuse_report_details =~ s/\r\n/\n/g; my $email = $data->{email}; #use Data::Dumper; #warn Dumper($data); # Email the Abuse Report require DADA::App::Messages; DADA::App::Messages::send_abuse_report( { -list => $list, -email => $email, -abuse_report_details => $abuse_report_details, } ); # (log the actual report?) # ... # # # Log it for the Tracker require DADA::Logging::Clickthrough; my $r = DADA::Logging::Clickthrough->new( { -list => $list } ); if ( $r->enabled ) { $r->abuse_log( { -email => $email, -mid => $data->{data}->{mid}, # -details => unique_id to some sort of report table... } ); } $ct->remove_by_token($report_abuse_token); # Tell 'em it worked! my $scrn = DADA::Template::Widgets::wrap_screen( { -screen => 'report_abuse_complete.tmpl', -with => 'list', -vars => { }, -list_settings_vars_param => { -list => $list, -dot_it => 1 }, } ); e_print($scrn); } } else { return user_error({-error => 'token_problem'}); } } else { return user_error({-error => 'token_problem'}); } } sub resend_conf { require DADA::MailingList::Settings; my $ls = DADA::MailingList::Settings->new( { -list => $list } ); my $lh = DADA::MailingList::Subscribers->new( { -list => $list } ); my $can_use_captcha = 0; if ( $ls->param('limit_sub_confirm_use_captcha') == 1 ) { try { require DADA::Security::AuthenCAPTCHA; $can_use_captcha = 1; } catch { carp "CAPTCHA Not working correctly?: $_"; $can_use_captcha = 0; }; } if ( $can_use_captcha == 1 ) { &resend_conf_captcha; } else { &resend_conf_no_captcha; } } sub resend_conf_captcha { require DADA::MailingList::Settings; my $ls = DADA::MailingList::Settings->new( { -list => $list } ); my $lh = DADA::MailingList::Subscribers->new( { -list => $list } ); my $captcha_worked = 0; my $captcha_auth = 1; if ( !xss_filter( $q->param('recaptcha_response_field') ) ) { $captcha_worked = 0; } else { require DADA::Security::AuthenCAPTCHA; my $cap = DADA::Security::AuthenCAPTCHA->new; my $result = $cap->check_answer( $DADA::Config::RECAPTCHA_PARAMS->{private_key}, $DADA::Config::RECAPTCHA_PARAMS->{'remote_address'}, $q->param('recaptcha_challenge_field'), $q->param('recaptcha_response_field') ); if ( $result->{is_valid} == 1 ) { $captcha_auth = 1; $captcha_worked = 1; } else { $captcha_worked = 0; $captcha_auth = 0; } } if ( $captcha_worked == 1 ) { if ( $q->param('rm') eq 's' ) { # so, what's $sub_info for?! my $sub_info = $lh->get_subscriber( { -email => $email, -type => 'sub_confirm_list', } ); for(keys %{$sub_info}) { next if $_ eq 'email'; next if $_ eq 'email_name'; next if $_ eq 'email_domain'; $q->param($_, $sub_info->{$_}); } my $rm_status = $lh->remove_subscriber( { -email => $email, -type => 'sub_confirm_list' } ); $q->param( 'list', $list ); $q->param( 'email', $email ); $q->delete( 'f', 'flavor', 'rm', 'recaptcha_challenge_field', 'recaptcha_response_field', 'token' ); $q->param( 'f', 's' ); &subscribe; return; } elsif ( $q->param('rm') eq 'unsubscription_request' ) { # I like the idea better that we call the function directly... my $rm_status = $lh->remove_subscriber( { -email => $email, -type => 'unsub_confirm_list' } ); $q->param( 'list', $list ); $q->param( 'email', $email ); $q->param( 'f', 'unsubscription_request' ); &unsubscription_request; return; } } else { my $error = ''; if ( $q->param('rm') eq 's' ) { $error = 'already_sent_sub_confirmation'; } elsif ( $q->param('rm') eq 'unsubscription_request' ) { $error = 'already_sent_unsub_confirmation'; } else { die 'unknown $rm!'; } user_error( { -error => $error, -list => $list, -email => $email, -vars => { captcha_auth => $captcha_auth, }, } ); } } sub resend_conf_no_captcha { my $list_exists = check_if_list_exists( -List => $list, ); if ( $list_exists == 0 ) { &default; return; } if ( !$email ) { $q->param( 'error_no_email', 1 ); list_page(); return; } if ( $q->param('rm') ne 's' && $q->param('rm') ne 'u' ) { &default; return; } if ( $q->request_method() !~ m/POST/i ) { &default; return; } require DADA::MailingList::Settings; my $ls = DADA::MailingList::Settings->new( { -list => $list } ); my $lh = DADA::MailingList::Subscribers->new( { -list => $list } ); my ( $sec, $min, $hour, $day, $month, $year ) = (localtime)[ 0, 1, 2, 3, 4, 5 ]; # This is just really broken... should be a CAPTCHA... # I'm assuming this happens if we FAILED this test below (1 = failure for check_email_pin) # if ( DADA::App::Guts::check_email_pin( -Email => $month . '.' . $day . '.' . $email, -Pin => xss_filter( $q->param('auth_code') ), -List => $list, ) == 0 ) { my ( $e_day, $e_month, $e_stuff ) = split( '.', $email ); # Ah, I see, it only is blocked for a... day? if ( $e_day != $day || $e_month != $month ) { # a stale blocking thingy. if ( $q->param('rm') eq 's' ) { my $rm_status = $lh->remove_subscriber( { -email => $email, -type => 'sub_confirm_list' } ); } elsif ( $q->param('rm') eq 'u' ) { my $rm_status = $lh->remove_subscriber( { -email => $email, -type => 'unsub_confirm_list' } ); } } list_page(); return; } else { if ( $q->param('rm') eq 's' ) { my $sub_info = $lh->get_subscriber( { -email => $email, -type => 'sub_confirm_list', } ); my $rm_status = $lh->remove_subscriber( { -email => $email, -type => 'sub_confirm_list' } ); $q->param( 'list', $list ); $q->param( 'email', $email ); $q->param( 'f', 's' ); &subscribe; return; } elsif ( $q->param('rm') eq 'u' ) { # I like the idea better that we call the function directly... my $rm_status = $lh->remove_subscriber( { -email => $email, -type => 'unsub_confirm_list' } ); $q->param( 'list', $list ); $q->param( 'email', $email ); $q->param( 'f', 'unsubscription_request' ); &unsubscription_request; return; } } } sub show_error { my $email = xss_filter( $q->param('email') ) || undef; my $error = xss_filter( $q->param('error') ) || undef; my $list = xss_filter( $q->param('list') ) || undef; require DADA::MailingList::Settings; my $ls = DADA::MailingList::Settings->new( { -list => $list } ); my $list_exists = check_if_list_exists( -List => $list, ); if ( $list_exists == 0 ) { &default; return; } if ( !$email ) { $q->param( 'error_no_email', 1 ); list_page(); return; } if ( $error ne 'already_sent_sub_confirmation' ) { &default; return; } require DADA::App::Error; my $error_msg = DADA::App::Error::cgi_user_error( { -list => $list, -error => $error, -email => $email, } ); e_print($error_msg); } sub text_list { my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'text_list' ); $list = $admin_list; my $ls = DADA::MailingList::Settings->new( { -list => $list } ); my $lh = DADA::MailingList::Subscribers->new( { -list => $list } ); my $type = $q->param('type') || 'list'; my $query = xss_filter( $q->param('query') ) || undef; my $advanced_search = xss_filter( $q->param('advanced_search') ) || 0; my $advanced_query = xss_filter( $q->param('advanced_query') ) || undef; my $order_by = $q->param('order_by') || $ls->param('view_list_order_by'); my $order_dir = $q->param('order_dir') || lc( $ls->param('view_list_order_by_direction') ); my $partial_listing = {}; if ($advanced_query) { if($advanced_search == 1){ open my $fh, '<', \$advanced_query || die $!; my $new_q = CGI->new($fh); $partial_listing = partial_sending_query_to_params($new_q); } } my $email; my $header = $q->header( -attachment => $list . '-' . $type . '.csv', -type => 'text/csv', ); print $header; if($advanced_query) { $lh->print_out_list( { -type => $type, -order_by => $order_by, -order_dir => $order_dir, -partial_listing => $partial_listing, -show_timestamp_column => 1, } ); } else { $lh->print_out_list( { -type => $type, -query => $query, -order_by => $order_by, -order_dir => $order_dir, -show_timestamp_column => 1, } ); } } sub preview_form { my $code = $q->param("code"); my ( $admin_list, $root_login ) = check_list_security( -cgi_obj => $q, -Function => 'preview_form' ); print $q->header(); # Why isn't this templated out? my $form = <
$code |