#!/usr/bin/perl # $Id: mail.cgi,v 1.315.2.5 2006/12/15 05:58:57 skazat Exp $ $Revision: 1.315.2.5 $ $Date: 2006/12/15 05:58:57 $ $Source: /cvsroot/mojomail/dada_mail_stable/dada/mail.cgi,v $ $HeadURL$ use strict; use 5.006; #-----------# # Dada Mail # #-----------# # # Homepage: http://mojo.skazat.com # # Support: http://mojo.skazat.com/support # # How To Ask For Free Help: # http://mojo.skazat.com/support/documentation/getting_help.pod.html # # Please Do Not Contact the Author directly about Dada Mail support, # unless for paid support! Please, and thank you. # # How to ask for paid consultation: # http://mojo.skazat.com/support/regular.html #---------------------------------------------------------------------# #---------------------------------------------------------------------# # The Path to your Perl *Libraries*: # This IS NOT the path to Perl. The path to Perl is the first line of # this script. # # use lib qw( ./ ./DADA ./DADA/perllib ); # This list may need to be added to. Find the absolute to path to this # very file. This: # # /home/youraccount/www/cgi-bin/dada/mail.cgi # # Is an example of what the absolute path to this file may be. # # Get rid of, "/mail.cgi" # # /home/youraccount/www/cgi-bin/dada # # Add that line after, "./DADA/perllib" above. # # Add "DADA", and, "DADA/perllib" from the absolute path you just made right # after your last entry into the Path to your Perl Libraries: # # /home/youraccount/www/cgi-bin/dada/DADA # /home/youraccount/www/cgi-bin/dada/DADA/perllib # # and you should be good to go. # # If this doesn't do the job - make sure ALL the directories, including the # DADA directory have permissions of: 755 and all files have permissions # of: 644 #---------------------------------------------------------------------# #---------------------------------------------------------------------# # # If you'd like error messages to be printed out in your browser, uncomment the # line that looks like this: # # #print "
$msg"; # # Why would you want this commented? Security. use CGI::Carp qw(fatalsToBrowser set_message); BEGIN { sub handle_errors { my $msg = shift; print q{
More information about this error may be available in the server error log and/or program error log.
$msg"; } set_message(\&handle_errors); } # You can also do this: # The line above, 'use CGI::Carp qw(fatalsToBrowser set_message);', # when changed to: # # use CGI::Carp "fatalsToBrowser"; # # captures critical server errors created by Dada Mail and shows them # in your Web browser. In other words, instead of seeing the, # # "Internal Server Error" # # message in your browser, you'll see something more interesting. # If this does not give you any clue on what's wrong, consider # setting the error log - See, "$PROGRAM_ERROR_LOG" in the Config.pm # documentation. #---------------------------------------------------------------------# #---------------------------------------------------------------------# # No more user-serviceable parts, please see the: # # dada/DADA/Config.pm # # file and: # # for instructions on how to install Dada Mail (easiest install) # # http://mojo.skazat.com/installation/ # # and: # # http://mojo.skazat.com/purchase/sample_chapter-dada_mail_setup.html # # for, "Advanced" setup # # and: # # http://mojo.skazat.com/support/documentation/Config.pm.html # # for more than you'd ever want to know. #---------------------------------------------------------------------# $|++; use DADA::Config qw(!:DEFAULT); $ENV{PATH} = "/bin:/usr/bin"; delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'}; my $dbi_handle; if($DADA::Config::SUBSCRIBER_DB_TYPE =~ m/SQL/ || $DADA::Config::ARCHIVE_DB_TYPE =~ m/SQL/ || $DADA::Config::SETTINGS_DB_TYPE =~ m/SQL/ ){ require DADA::App::DBIHandle; $dbi_handle = DADA::App::DBIHandle->new; } use DADA::App::ScreenCache; my $c = DADA::App::ScreenCache->new; use DADA::App::Guts; use DADA::Template::HTML; use DADA::MailingList::Subscribers; $DADA::MailingList::Subscribers::dbi_obj = $dbi_handle; use CGI; CGI->nph(1) if $DADA::Config::NPH == 1; my $q; if($ENV{QUERY_STRING} =~ m/^\?/){ # DEV Workaround for servers that give a bad PATH_INFO: # Set the $DADA::Config::PROGRAM_URL to have, "?" at the end of the URL # to change any PATH_INFO's into Query Strings. # The below lines will then take this extra question mark # out, so actual query strings will work as before. $ENV{QUERY_STRING} =~ s/^\?//; $q = new CGI($ENV{QUERY_STRING}); } else{ $q = new CGI(); } $q->charset($DADA::Config::HTML_CHARSET); #---------------------------------------------------------------------# # DEV: Should be removed, soon. # width of the textarea my $cols = 70; # height of the textarea my $rows = 15; # wrap my $wrap = 'NONE'; # style my $text_area_style = 'font-size:11px'; #---------------------------------------------------------------------# # Bad - global variable for the archive editor # - I'll have to figure this out later. my $skel = []; #---------------------------------------------------------------------# # DEV - This is NOT the best place to put this, # but I guess we'll leave it here for now... my %list_types = (list => 'Subscribers', black_list => 'Black Listed', moderators => 'Moderators', testers => 'Testers', white_list => 'White Listed', ); my $type = $q->param('type') || 'list'; $type = 'list' if ! $list_types{$type}; my $type_title = "Subscribers"; $type_title = "Moderators" if $type eq 'moderators'; $type_title = "Black Listed" if $type eq 'black_list'; $type_title = "Testers" if $type eq 'testers'; $type_title = "White Listed" if $type eq 'white_list'; #---------------------------------------------------------------------# if($ENV{PATH_INFO}){ my $dp = $q->url || $DADA::Config::PROGRAM_URL; $dp =~ s/^(http:\/\/|https:\/\/)(.*?)\//\//; my $info = $ENV{PATH_INFO}; $info =~ s/^$dp//; # script name should be something like: # /cgi-bin/dada/mail.cgi $info =~ s/^$ENV{SCRIPT_NAME}//i; $info =~ s/(^\/|\/$)//g; #get rid of fore and aft slashes # seriously, this shouldn't be needed: $info =~ s/^dada\/mail\.cgi//; if(!$info && $ENV{QUERY_STRING} && $ENV{QUERY_STRING} =~ m/^\//){ # DEV Workaround for servers that give a bad PATH_INFO: # Set the $DADA::Config::PROGRAM_URL to have, "?" at the end of the URL # to change any PATH_INFO's into Query Strings. # The below two lines change query strings that look like PATH_INFO's # into PATH_INFO's $info = $ENV{QUERY_STRING}; $info =~ s/(^\/|\/$)//g; #get rid of fore and aft slashes } if($info =~ m/css$/){ $q->param('f', 'css'); }elsif($info =~ m/$DADA::Config::SIGN_IN_FLAVOR_NAME$/){ $q->param('f', $DADA::Config::SIGN_IN_FLAVOR_NAME); }elsif($info =~ m/$DADA::Config::ADMIN_FLAVOR_NAME$/){ $q->param('f', $DADA::Config::ADMIN_FLAVOR_NAME); }elsif($info =~ m/^archive/){ # archive, archive_rss and archive_atom # form: #/archive/justin/20050422012839/ my ($pi_flavor, $pi_list, $pi_id, $extran) = split('/', $info); $q->param('flavor', $pi_flavor) if $pi_flavor; $q->param('list', $pi_list) if $pi_list; $q->param('id', $pi_id) if $pi_id; $q->param('extran', $extran); }elsif($info =~ /^smtm/){ $q->param('flavor', 'smtm'); }elsif($info =~ /^spacer_image/){ my ($throwaway, $pi_list, $pi_mid, $bollocks) = split('/', $info); $q->param('flavor', 'm_o_c'); $q->param('list', $pi_list) if $pi_list; $q->param('mid', $pi_mid) if $pi_mid; }elsif($info =~ /^img/){ my ($pi_flavor, $img_name, $extran) = split('/', $info); $q->param('flavor', 'img'); $q->param('img_name', $img_name) if $img_name; }elsif($info =~ /^captcha_img/){ my ($pi_flavor, $pi_img_string, $extran) = split('/', $info); $q->param('flavor', 'captcha_img'); $q->param('img_string', $pi_img_string) if $pi_img_string; }elsif($info =~ /^(s|n|u)/){ my ($pi_flavor, $pi_list, $pi_email, $pi_domain, $pi_pin) = split('/', $info); # HACK: If there is no name and a domain, the entire email address is in "email" # and there is no domain. # move all the other variables to the right # This being only the pin, at the moment # 2.10 should have relieved this issue... if($pi_email !~ m/\@/){ $pi_email = $pi_email . '@' . $pi_domain if $pi_domain; }else{ $pi_pin = $pi_domain if !$pi_pin; } $q->param('flavor', $pi_flavor) if $pi_flavor; $q->param('list', $pi_list) if $pi_list; $q->param('email', $pi_email) if $pi_email; $q->param('pin', $pi_pin) if $pi_pin; }elsif($info =~ /^subscriber_help|^list/){ my ($pi_flavor, $pi_list) = split('/', $info); $q->param('flavor', $pi_flavor) if $pi_flavor; $q->param('list', $pi_list) if $pi_list; }elsif($info =~ /^r/){ my ($pi_flavor, $pi_list, $pi_k, $pi_mid, @pi_url) = split('/', $info); my $pi_url; $q->param('flavor', $pi_flavor) if $pi_flavor; $q->param('list', $pi_list) if $pi_list; $q->param('k', $pi_k) if $pi_k; $pi_url = join('/', @pi_url) if $pi_url[0]; $pi_url =~ s/\%3F/?/g; $q->param('url', $pi_url) if $pi_url; $q->param('mid', $pi_mid) if $pi_mid; $q->param('url', 'http://' . $pi_url) if($pi_k eq 'h'); $q->param('url', 'https://' . $pi_url) if($pi_k eq 's'); }else{ if($info){ warn "Path Info present - but not valid? - '" . $ENV{PATH_INFO} . '" - filtered: "' . $info . '"' unless $info =~ m/^\x61\x72\x74/; } } } #---------------------------------------------------------------------# my $flavor = $q->param('flavor'); $flavor = $q->param('f') unless($flavor); my $process = $q->param('process'); my $email = $q->param('email') || ""; $email = $q->param('e') || "" unless($email); my $list = $q->param('list'); $list = $q->param('l') unless($list); my $list_name = $q->param('list_name'); my $pin = $q->param('pin'); $pin = $q->param('p') unless($pin); my $admin_email = $q->param('admin_email'); my $list_owner_email = $q->param('list_owner_email'); my $info = $q->param('info'); my $privacy_policy = $q->param('privacy_policy'); my $physical_address = $q->param('physical_address'); my $password = $q->param('password'); my $retype_password = $q->param('retype_password'); my $keyword = $q->param('keyword'); my @address = $q->param('address'); my $done = $q->param('done'); my $id = $q->param('id'); my $quick = $q->param('quick') || 'no'; my $advanced = $q->param('advanced') || 'no'; my $help = $q->param('help'); my $set_flavor = $q->param('set_flavor'); #---------------------------------------------------------------------# if($email){ $email =~ s/_p40p_/\@/; $email =~ s/_p2Bp_/\+/g; } $list = xss_filter($list); $flavor = xss_filter($flavor); $email = xss_filter($email); $pin = xss_filter($pin); $keyword = xss_filter($keyword); $set_flavor = xss_filter($set_flavor); $id = xss_filter($id); if($q->param('auth_state')){ $q->param('auth_state', xss_filter($q->param('auth_state'))); } #external (mostly..) functions called from the web browser) # a few things this program can do.... :) my %Mode = ( 'default' => \&default, 'subscribe' => \&subscribe, 'subscribe_flash_xml' => \&subscribe_flash_xml, 'unsubscribe_flash_xml' => \&unsubscribe_flash_xml, 'new' => \&confirm, 'unsubscribe' => \&unsubscribe, #'admin' => \&admin, 'login' => \&login, 'logout' => \&logout, 'log_into_another_list' => \&log_into_another_list, 'change_login' => \&change_login, 'new_list' => \&new_list, 'change_info' => \&change_info, 'html_code' => \&html_code, 'admin_help' => \&admin_help, 'delete_list' => \&delete_list, 'list_stats' => \&list_stats, 'view_list' => \&view_list, 'view_list_options' => \&view_list_options, 'edit_subscriber' => \&edit_subscriber, 'add' => \&add, 'email_password' => \&email_password, 'add_email' => \&add_email, 'delete_email' => \&delete_email, 'subscription_options' => \&subscription_options, 'send_email' => \&send_email, 'sending_monitor' => \&sending_monitor, 'preview_form' => \&preview_form, 'checker' => \&checker, 'edit_template' => \&edit_template, 'view_archive' => \&view_archive, 'display_message_source' => \&display_message_source, 'purge_all_archives' => \&purge_all_archives, 'delete_archive' => \&delete_archive, 'edit_archived_msg' => \&edit_archived_msg, 'archive' => \&archive, 'archive_bare' => \&archive_bare, 'archive_rss' => \&archive_rss, 'archive_atom' => \&archive_atom, 'manage_script' => \&manage_script, 'change_password' => \&change_password, 'text_list' => \&text_list, 'send_list_to_admin' => \&send_list_to_admin, 'search_email' => \&search_email, 'archive_options' => \&archive_options, 'adv_archive_options' => \&adv_archive_options, 'back_link' => \&back_link, 'edit_type' => \&edit_type, 'edit_html_type' => \&edit_html_type, 'list_options' => \&list_options, 'sending_options' => \&sending_options, 'adv_sending_options' => \&adv_sending_options, 'sending_tuning_options' => \&sending_tuning_options, #'sign_in' => \&sign_in, 'filter_using_black_list' => \&filter_using_black_list, 'search_archive' => \&search_archive, 'send_archive' => \&send_archive, 'list_invite' => \&list_invite, 'pass_gen' => \&pass_gen, 'send_url_email' => \&send_url_email, 'feature_set' => \&feature_set, 'smtp_options' => \&smtp_options, 'checkpop' => \&checkpop, 'author' => \&author, 'list' => \&list_page, 'setup_info' => \&setup_info, 'reset_cipher_keys' => \&reset_cipher_keys, 'restore_lists' => \&restore_lists, 'r' => \&redirection, 'subscriber_help' => \&subscriber_help, 'show_img' => \&show_img, 'file_attachment' => \&file_attachment, 'm_o_c' => \&m_o_c, 'img' => \&img, 'captcha_img' => \&captcha_img, 'ver' => \&ver, 'css' => \&css, 'resend_conf' => \&resend_conf, 'clear_screen_cache' => \&clear_screen_cache, # these params are the same as above, but are smaller in actual size # this comes into play when you have to create a url using these as parts of it. 's' => \&subscribe, 'n' => \&confirm, 'u' => \&unsubscribe, 'smtm' => \&smtm, 'test_layout' => \&test_layout, 'send_email_testsuite' => \&send_email_testsuite, $DADA::Config::ADMIN_FLAVOR_NAME => \&admin, $DADA::Config::SIGN_IN_FLAVOR_NAME => \&sign_in, ); &_chk_env_sys_blk(); # the BIG switcheroo. Mark doesn't like this :) if($flavor){ if(exists($Mode{$flavor})) { $Mode{$flavor}->(); #call the correct subroutine }else{ &default; } }else{ &default; } sub default { user_error(-Error => 'bad_setup') if(DADA::App::Guts::check_setup() == 0); require DADA::MailingList::Settings; $DADA::MailingList::Settings::dbi_obj = $dbi_handle; my @available_lists = available_lists(-In_Order => 1, -dbi_handle => $dbi_handle); if( ($DADA::Config::DEFAULT_SCREEN ne '') && ($flavor ne 'default') && ($#available_lists >= 0) ){ print $q->redirect(-uri => $DADA::Config::DEFAULT_SCREEN); return; # could we just say, return; ? } if ($available_lists[0]) { if($q->param('error_invalid_list') != 1){ if($c->cached('default')){ $c->show('default'); return;} } my $scrn = (the_html(-Part => "header", -Title => "Sign Up for a List", -Start_Form => 0, )); require DADA::Template::Widgets; $scrn .= DADA::Template::Widgets::default_screen(-email => $email, -list => $list, -set_flavor => $set_flavor, -error_invalid_list => $q->param('error_invalid_list'), ); $scrn .= ' ' x 200 . $q->a({-href=>"$DADA::Config::PROGRAM_URL". '/' . "\x61\x72\x74", -style=>'font-size:1px;color:#FFFFFF'},'i <3 u '); $scrn .= (the_html(-Part => "footer", -End_Form => 0)); print $scrn; if ($available_lists[0] && $q->param('error_invalid_list') != 1) { $c->cache('default', \$scrn); } return; }else{ print(the_html(-Part => "header", -Title => "Welcome to $DADA::Config::PROGRAM_NAME", -Start_Form => 0, )); my $auth_state; if($DADA::Config::DISABLE_OUTSIDE_LOGINS == 1){ require DADA::Security::SimpleAuthStringState; my $sast = DADA::Security::SimpleAuthStringState->new; $auth_state = $sast->make_state; } require DADA::Template::Widgets; print DADA::Template::Widgets::screen(-screen => 'congrats_screen.tmpl', -expr => 1, -vars => { agree => $q->param('agree'), auth_state => $auth_state, }, ); print(the_html(-Part => "footer", -End_Form => 0)); } } sub list_page { if(DADA::App::Guts::check_setup() == 0){ user_error(-Error => 'bad_setup'); } if(check_if_list_exists(-List => $list, -dbi_handle => $dbi_handle) == 0){ undef($list); &default; return; } require DADA::MailingList::Settings; $DADA::MailingList::Settings::dbi_obj = $dbi_handle; if(! $email && ! $set_flavor && ($q->param('error_no_email') != 1)){ if($c->cached('list/' . $list)){ $c->show('list/' . $list); return;} } my $ls = DADA::MailingList::Settings->new(-List => $list); my $list_info = $ls->get; require DADA::Template::Widgets; my $scrn = (the_html(-Part => "header", -Title => $list_info->{list_name}, -List => $list, -Start_Form => 0, )); $scrn .= DADA::Template::Widgets::list_page(-list => $list, -email => $email, -set_flavor => $set_flavor, -error_no_email => $q->param('error_no_email', ), ); $scrn .= (the_html(-Part => "footer", -List => $list, -End_Form => 0)); print $scrn; if(! $email && ! $set_flavor && ($q->param('error_no_email') != 1)){ $c->cache('list/' . $list, \$scrn); } return; } sub admin { my @available_lists = available_lists(-dbi_handle => $dbi_handle); if(($#available_lists < 0)){ &default; return; } if(! $q->param('login_widget') && $DADA::Config::DISABLE_OUTSIDE_LOGINS != 1){ if($c->cached('admin')){ $c->show('admin'); return;} } my $scrn = (the_html(-Part => "header", -Title => "Administration", -Start_Form => 0, )); my $login_widget = $q->param('login_widget') || $DADA::Config::LOGIN_WIDGET; require DADA::Template::Widgets; $scrn .= DADA::Template::Widgets::admin(-login_widget => $login_widget, -cgi_obj => $q); $scrn .= (the_html(-Part => "footer", -End_Form => 0)); print $scrn; if(! $q->param('login_widget') && $DADA::Config::DISABLE_OUTSIDE_LOGINS != 1){ $c->cache('admin', \$scrn); } return; } sub sign_in { my $list_exists = check_if_list_exists(-List => $list, -dbi_handle => $dbi_handle); if($list_exists >= 1){ my $pretty = pretty($list); print(the_html(-Part => "header", -Title => "Sign In to $pretty", -List => $list, -Start_Form => 0, )); }else{ print(the_html(-Part => "header", -Title => "Sign In", -Start_Form => 0, )); } if($list_exists >= 1){ require DADA::Template::Widgets; my $auth_state; if($DADA::Config::DISABLE_OUTSIDE_LOGINS == 1){ require DADA::Security::SimpleAuthStringState; my $sast = DADA::Security::SimpleAuthStringState->new; $auth_state = $sast->make_state; } require DADA::MailingList::Settings; $DADA::MailingList::Settings::dbi_obj = $dbi_handle; my $ls = DADA::MailingList::Settings->new(-List => $list); my $li = $ls->get; print DADA::Template::Widgets::screen(-screen => 'list_login_form.tmpl', -vars => { list => $list, list_name => $li->{list_name}, flavor_sign_in => 1, auth_state => $auth_state, }, ); }else{ my $login_widget = $q->param('login_widget') || $DADA::Config::LOGIN_WIDGET; print DADA::Template::Widgets::admin(-login_widget => $login_widget, -no_show_create_new_list => 1); } if($list_exists >= 1){ print(the_html(-Part => "footer", -List => $list, -End_Form => 0, )); }else{ print(the_html(-Part => "footer", -End_Form => 0,)); } } sub send_email { my ($admin_list, $root_login) = check_list_security(-cgi_obj => $q, -Function => 'send_email'); require DADA::MailingList::Settings; $DADA::MailingList::Settings::dbi_obj = $dbi_handle; $list = $admin_list; my $ls = DADA::MailingList::Settings->new(-List => $list); my $li = $ls->get; my $lh = DADA::MailingList::Subscribers->new(-List => $list); my $text_message_body = ""; my $html_message_body = ""; my $at_num = $q->param('at_num') || 1; if(! $process){ my $default_from_header = '"'. escape_for_sending($li->{list_name}) . '" <'.$li->{list_owner_email}.'>'; my $file_upload_widget = ''; my $i = 1; for($i = 1; $i <= $at_num; $i++){ $file_upload_widget .= $q->Tr($q->td([ ($q->p({-align=>'right'},$q->b('Attachment ' . $i . ':'))), ($q->p($q->filefield(-name=>"attachment_$i",-size => 36))) ])); } my $next_num = $at_num+1; my $text_blurb = ""; $text_blurb = "
$@"; # We're going to refresh, see if it gets better. $restart_time = 5; } # Provide a link in case browser redirect is working print 'restarting mailing...'; print " "; return; } # No id? No problem, show them the index page. if(!$q->param('id')){ my $mailout_status = []; my @mailouts = DADA::Mail::MailOut::current_mailouts($list); foreach (@mailouts){ my $mailout = DADA::Mail::MailOut->new({ -List => $list }); $mailout->associate_with_id($_->{id}); my $status = $mailout->status($_->{type}); push(@$mailout_status, {%$status, S_PROGRAM_URL => $DADA::Config::S_PROGRAM_URL, Subject => $status->{email_fields}->{Subject}}); } print(admin_html_header( -Title => "Monitor Your Mailing", -List => $list, -Root_Login => $root_login, -Form => 0, )); require DADA::Template::Widgets; print DADA::Template::Widgets::screen(-screen => 'sending_monitor_index_screen.tmpl', -vars => { mailout_status => $mailout_status, auto_pickup_dropped_mailings => $li->{auto_pickup_dropped_mailings}, }, ); print(admin_html_footer(-List => $list, -Form => 0, )); }else{ my $mailout; 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_with_id($id); $status = $mailout->status($type); }else { # Nothing - I believe this is handled in the template. } my $its_killed = 0; if($status->{should_be_restarted}){ $its_killed = 1; } if($its_killed == 1 && $li->{auto_pickup_dropped_mailings} == 1 && $status->{total_sending_out_num} - $status->{total_sent_out} > 0 && $restart_count <= 0 ){ print $q->redirect(-url => $DADA::Config::S_PROGRAM_URL . '?f=sending_monitor&id=' . $id . '&process=restart&type=' . $type . '&restart_count=1'); return; } else { $restart_count = 0; } my $sending_status = []; foreach(keys %$status){ next if $_ eq 'email_fields'; push(@$sending_status, {key => $_, value => $status->{$_}}); } # 8 is the factory default setting to wait per batch. # Let's not refresh an faster, or we'll never have time # to read the actual screen. my $refresh_after = 8; $refresh_after = $li->{bulk_sleep_amount} if $refresh_after < $li->{bulk_sleep_amount}; print(admin_html_header( -Title => "Monitor Your Mailing", -List => $list, -Root_Login => $root_login, -Form => 0, )); require DADA::Template::Widgets; print DADA::Template::Widgets::screen(-screen => 'sending_monitor_screen.tmpl', -vars => { 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}, 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_access}))), its_killed => $its_killed, header_subject => $status->{email_fields}->{Subject}, header_subject_label => (length($status->{email_fields}->{Subject}) > 50) ? (substr($status->{email_fields}->{Subject}, 0, 49) . '...') : ($status->{email_fields}->{Subject}), auto_pickup_dropped_mailings => $li->{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, }, ); print(admin_html_footer(-List => $list, -Form => 0, )); } } sub _formatted_runtime { my $d = shift; 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 = join ", ", @r if @r; return $runtime; } sub clean_up_attachments { my $files = shift || []; foreach(@$files){ $_ = make_safer($_); warn "could not remove '$_'" unless unlink($_) > 0; # i love the above! } } sub backdated_msg_id { my $backdate_hour = $q->param('backdate_hour'); $backdate_hour = int($backdate_hour) + 12 if $q->param('backdate_hour_label') =~ /p/; # as in, p.m. my $message_id = sprintf("%02d%02d%02d%02d%02d%02d", $q->param('backdate_year'), $q->param('backdate_month'), $q->param('backdate_day'), $backdate_hour, $q->param('backdate_minute'), $q->param('backdate_second') ); return $message_id; } sub has_attachments { my $i = 0; my $at_num = $q->param('at_num') || 1; my $attachment = $q->param('attachment'); my @ive_got = (); return undef if ! $attachment; for($i = 1; $i <= $at_num; $i++){ my $that_attachment = 'filepath_attachment_' . $i; push(@ive_got, $that_attachment) if $q->param($that_attachment); my $this_attachment = 'attachment_' . $i; push(@ive_got, $this_attachment) if $q->param($this_attachment); } return @ive_got; } sub make_attachment { require MIME::Lite; my $name = shift; my $attachment = $q->param($name); my $uploaded_file = ''; return (undef, undef) if !$attachment; my $a_type = find_attachment_type($attachment); my $attach_name = $attachment; $attach_name =~ s!^.*(\\|\/)!!; $attach_name =~ s/\s/%20/g; my %mime_args = ( Type => $a_type, # Id => '<'.$attach_name.'>', Filename => $attach_name, Disposition => make_a_disposition($a_type), ); my $attachment_file; # kinda used only for testing at the moment; if($name =~ m/^filepath_attachment/){ $mime_args{Path} = $attachment; $uploaded_file = $attach_name; }else{ if($DADA::Config::ATTACHMENT_TEMPFILE == 1){ # $name is the CGI paramater name - we need to pass that # to keep the CGI object, "magic" my $attachment_file = file_upload($name); $mime_args{Path} = $attachment_file; $uploaded_file = $attachment_file; }else{ $mime_args{FH} = $attachment; $uploaded_file = $attach_name; } } my $msg_att = MIME::Lite->new(%mime_args); $msg_att->attr('Content-Location' => $attach_name); return($msg_att, $uploaded_file); } sub make_a_disposition { my $n = shift; my $disposition = 'inline'; if($n !~ m/image/){ #if($n !~ /text/){ # if they're inline, they get parsed as if # they were a part of Dada Mail... hmm... $disposition = 'attachment'; #} } return $disposition; } sub find_attachment_type { my $filename = shift; my $a_type; my $attach_name = $filename; $attach_name =~ s!^.*(\\|\/)!!; $attach_name =~ s/\s/%20/g; my $file_ending = $attach_name; $file_ending =~ s/.*\.//; require MIME::Types; require MIME::Type; if(($MIME::Types::VERSION >= 1.005) && ($MIME::Type::VERSION >= 1.005)){ my ($mimetype, $encoding) = MIME::Types::by_suffix($filename); $a_type = $mimetype if ($mimetype && $mimetype =~ /^\S+\/\S+$/); ### sanity check }else{ if(exists($DADA::Config::MIME_TYPES{'.'.lc($file_ending)})) { $a_type = $DADA::Config::MIME_TYPES{'.'.lc($file_ending)}; }else{ $a_type = $DADA::Config::DEFAULT_MIME_TYPE; } } if(!$a_type){ warn "attachment MIME Type never figured out, letting MIME::Lite handle this..."; $a_type = 'AUTO'; } return $a_type; } sub list_invite { my ($admin_list, $root_login) = check_list_security(-cgi_obj => $q, -Function => 'list_invite'); $list = $admin_list; require DADA::MailingList::Settings; my $ls = DADA::MailingList::Settings->new(-List => $list); my $li = $ls->get; my $lh = DADA::MailingList::Subscribers->new(-List => $list); if(!$process){ print(admin_html_header(-Title => "Invitations", -List => $list, -Root_Login => $root_login)); require DADA::Template::Widgets; print DADA::Template::Widgets::screen(-screen => 'list_invite_screen.tmpl', -vars => { invite_message_subject => $li->{invite_message_subject}, invite_message_text => $li->{invite_message_text}, invite_message_html => $li->{invite_message_html}, invite_message_html_js_escaped => js_enc($li->{invite_message_html}), list_owner_email => $li->{list_owner_email}, }, ); print(admin_html_footer(-List => $list)); }else{ # get the emails my $new_emails = $q -> param("new_emails"); # split them into individual entities my @new_addresses = split(/\s+|,|;|\n+/, $new_emails); my ($subscribed, $not_subscribed, $black_listed, $not_white_listed, $invalid) = $lh->filter_subscribers(-Email_Ref => [@new_addresses]); # add these to a special 'invitation' list. we'll clear this list later. my $new_email_count=$lh->add_to_email_list(-Email_Ref => $not_subscribed, -Type => 'invitelist', -Mode => 'writeover'); my $message_subject = $q->param('message_subject'); my $text_message_body = DADA::App::Guts::strip($q->param('text_message_body')) || undef; $text_message_body =~ s(/^\n+|\n+$)()g; if($text_message_body){ $text_message_body =~ s/\r\n/\n/g; } my $html_message_body = DADA::App::Guts::strip($q->param('html_message_body')) || undef; $html_message_body =~ s(/^\n+|\n+$)()g; if($html_message_body){ $html_message_body =~ s/\r\n/\n/g; } require MIME::Lite; $MIME::Lite::PARANOID = $DADA::Config::MIME_PARANOID; my $msg; if($text_message_body and $html_message_body){ $msg = MIME::Lite->new(Type => 'multipart/alternative'); $msg->attach(Type => 'TEXT', Data => $text_message_body); $msg->attach(Type => 'text/html', Data => $html_message_body); }elsif($html_message_body){ # make only a text body $msg = MIME::Lite->new(Type => 'text/html', Data => $html_message_body); }elsif($text_message_body){ $msg = MIME::Lite->new(Type => 'TEXT', Data => $text_message_body); } else{ warn "$DADA::Config::PROGRAM_NAME $DADA::Config::VER warning: both text and html versions of invitation message blank?!"; $msg = MIME::Lite->new(Type => 'TEXT', Data => $li->{invite_message_text}); } $msg->replace('X-Mailer' =>""); my $msg_as_string = (defined($msg)) ? $msg->as_string : undef; require DADA::App::FormatMessages; my $fm = DADA::App::FormatMessages->new(-List => $list); $fm->Subject($message_subject); $fm->use_email_templates(0); my ($header_glob, $message_string) = $fm->format_headers_and_body(-msg => $msg_as_string ); require DADA::Mail::Send; $DADA::Mail::Send::dbi_obj = $dbi_handle; my $mh = DADA::Mail::Send->new($li); # translate the glob into a hash my %headers = $mh->return_headers($header_glob); $mh->list_type('invitelist'); $mh->bulk_test(1) if($process =~ m/test/i); my $test_recipient = ''; if($process =~ m/test/i){ $mh->bulk_test_recipient($q->param('test_recipient')); $test_recipient = $mh->bulk_test_recipient; } #$mh->list_type('testers') # if($process =~ m/test/i); my $message_id = $mh->bulk_send( %headers, To => '"'. escape_for_sending($li->{list_name}) .'" <'. $li->{list_owner_email} .'>', From => '"'. escape_for_sending($li->{list_name}) .'" <'. $li->{list_owner_email} .'>', Subject => $message_subject, Body => $message_string ); my $screen_text_message; if($text_message_body){ $screen_text_message = $text_message_body; $screen_text_message = webify_plain_text($screen_text_message); $screen_text_message =~ s/\[email\]/$li->{list_owner_email}/gi; my $lm_pin = make_pin(-Email => $li->{list_owner_email}); $screen_text_message =~ s/\[pin\]/$lm_pin/gi; } my $screen_html_message; if($html_message_body){ $screen_html_message = $html_message_body; $screen_html_message =~ s/\[email\]/$li->{list_owner_email}/gi; my $html_lm_pin = make_pin(-Email => $li->{list_owner_email}); $screen_html_message =~ s/\[pin\]/$html_lm_pin/gi; } $new_email_count = int($new_email_count); if(!$q->param('new_win')){ print(admin_html_header(-Title => "Invitations Sent", -List => $li->{list}, -Root_Login => $root_login)); }else{ print $q->header(); print $q->start_html(-title => 'Invitations Sent', -style => { -src => $DADA::Config::PROGRAM_URL . '/css', -code => 'body{text-align:left;margin:5px;padding:5px}' }, ); } require DADA::Template::Widgets; print DADA::Template::Widgets::screen(-screen => 'list_invite_process_screen.tmpl', -vars => { process_test => ($process =~ m/test/i) ? 1 : 0, list_owner_email => $li->{list_owner_email}, new_email_count => $new_email_count, message_subject => $message_subject, text_message_body => $text_message_body, screen_text_message => $screen_text_message, html_message_body => $html_message_body, screen_html_message => $screen_html_message, test_recipient => $test_recipient, message_id => $message_id, type => 'invitelist', }, ); if(!$q->param('new_win')){ print(admin_html_footer(-List => $list)); }else{ print ''; print $q->end_html; } if(defined($q->param('save_invite_messages')) && $q->param('save_invite_messages') == 1){ my $p_text_message_body = $q->param('text_message_body'); $p_text_message_body =~ s/\r\n/\n/g; my $p_html_message_body = $q->param('html_message_body'); $p_html_message_body =~ s/\r\n/\n/g; $ls->save({ invite_message_text => $p_text_message_body, invite_message_html => $p_html_message_body, invite_message_subject => $q->param('message_subject'), }); } } } sub send_url_email { my ($admin_list, $root_login) = check_list_security(-cgi_obj => $q, -Function => 'send_url_email'); my $list = $admin_list; require DADA::MailingList::Settings; $DADA::MailingList::Settings::dbi_obj = $dbi_handle; my $ls = DADA::MailingList::Settings->new(-List => $list); my $li = $ls->get; require DADA::MailingList::Archives; $DADA::MailingList::Archives::dbi_obj = $dbi_handle; my $la = DADA::MailingList::Archives->new(-List => $li); my $lh = DADA::MailingList::Subscribers->new(-List => $list); my $can_use_mime_lite_html = 0; my $mime_lite_html_error = undef; eval { require MIME::Lite::HTML }; if(!$@){ $can_use_mime_lite_html = 1; }else{ $mime_lite_html_error = $@; } my $can_use_lwp_simple = 0; my $lwp_simple_error = undef; eval { require LWP::Simple }; if(!$@){ $can_use_lwp_simple = 1; }else{ $lwp_simple_error = $@; } if(!$process){ print(admin_html_header( -Title => "Send a Webpage", -List => $list, -Root_Login => $root_login, -Form => 0, )); require DADA::Template::Widgets; print DADA::Template::Widgets::screen(-screen => 'send_url_email_screen.tmpl', -list => $list, -vars => { list_owner_email => $li->{list_owner_email}, group_list => $li->{group_list}, can_use_mime_lite_html => $can_use_mime_lite_html, mime_lite_html_error => $mime_lite_html_error, can_use_lwp_simple => $can_use_lwp_simple, lwp_simple_error => $lwp_simple_error, SERVER_ADMIN => $ENV{SERVER_ADMIN}, list_name => $li->{list_name}, cols => $cols, rows => $rows, wrap => $wrap, text_area_style => $text_area_style, global_list_sending_widget => DADA::Template::Widgets::global_list_sending_checkbox_widget($list), can_use_global_list_sending => $lh->can_use_global_list_sending, archive_messages => $li->{archive_messages}, cols => $cols, rows => $rows, wrap => $wrap, text_area_style => $text_area_style, can_display_attachments => $la->can_display_attachments, }, ); print(admin_html_footer(-List => $list, -Form => 0, )); }else{ if($can_use_mime_lite_html){ my $url_options = $q->param('url_options') || undef; my $login_details; if(defined($q->param('url_username')) && defined($q->param('url_password'))){ $login_details = $q->param('url_username') . ':' . $q->param('url_password') } my $proxy = defined($q->param('proxy')) ? $q->param('proxy') : undef; my $mailHTML = new MIME::Lite::HTML('IncludeType' => $url_options, 'TextCharset' => $li->{charset_value}, 'HTMLCharset' => $li->{charset_value}, (($login_details) ? (LoginDetails => $login_details,) : ()), HTMLEncoding => $li->{plaintext_encoding}, TextEncoding => $li->{html_encoding}, (($proxy) ? (Proxy => $proxy,) : ()), ( ($DADA::Config::CPAN_DEBUG_SETTINGS{MIME_LITE_HTML} == 1) ? (Debug => 1, ) : () ), ); my $t = $q->param('text_message_body') || 'This email message requires that your mail reader support HTML'; if($q->param('auto_create_plaintext') == 1){ if($q->param('content_from') eq 'url'){ require LWP::Simple; my $good_try = LWP::Simple::get($q->param('url')); $t = convert_to_ascii($good_try); }else{ $t = convert_to_ascii($q->param('html_message_body')); } } my $MIMELiteObj; if($q->param('content_from') eq 'url'){ $MIMELiteObj = $mailHTML->parse($q->param('url'), $t); }else{ $MIMELiteObj = $mailHTML->parse($q->param('html_message_body'), $t); } require DADA::App::FormatMessages; my $fm = DADA::App::FormatMessages->new(-List => $list); $fm->Subject($q->param('message_subject')); $fm->treat_as_discussion_msg(1) if $li->{group_list} == 1; my $problems = 0; my $rm = ''; eval { $rm = $MIMELiteObj->as_string; }; if($@){ warn "$DADA::Config::PROGRAM_NAME $DADA::Config::VER - Send a Webpage isn't functioning correctly? - $!"; $problems++; } my $message_id; my $mh; if($q->param('local_archive_options_present') == 1){ if($q->param('archive_message') != 1){ $q->param(-name => 'archive_message', -value => 0); } } my $archive_m = $li->{archive_messages} || 0; if($q->param('archive_message') == 1 || $q->param('archive_message') == 0){ $archive_m = $q->param('archive_message'); } my $test_recipient = ''; if(!$problems){ my ($header_glob, $template) = $fm->format_headers_and_body(-msg => $rm); require DADA::Mail::Send; $DADA::Mail::Send::dbi_obj = $dbi_handle; $mh = DADA::Mail::Send->new($li); my %headers = $mh->return_headers($header_glob); my %mailing = (%headers, Subject => $q->param('message_subject'), Body => $template, ); $mh->bulk_test(1) if($q->param('process') =~ m/test/i); if($process =~ m/test/i){ $mh->bulk_test_recipient($q->param('test_recipient')); $test_recipient = $mh->bulk_test_recipient; } #$mh->list_type('testers') # if($q->param('process') =~ m/test/i); my @alt_lists = $q->param('alternative_list'); if($alt_lists[0]){ $mh->also_send_to([@alt_lists]); } if($q->param('archive_no_send') != 1){ # Woo Ha! Send away! $message_id = $mh->bulk_send(%mailing); }else{ # This is currently similar code as what's in the DADA::Mail::Send::_mail_general_headers method... my $msg_id = DADA::App::Guts::message_id(); if($q->param('back_date') == 1){ $msg_id = backdated_msg_id(); } # time + random number + sender, woot! require DADA::Security::Password; my $ran_number = DADA::Security::Password::generate_rand_string('1234567890'); %mailing = $mh->clean_headers(%mailing); %mailing = ( %mailing, $mh->_make_general_headers, $mh->_make_list_headers ); $mailing{'Message-ID'} = '<' . $msg_id . '.'. $ran_number . '.' . $li->{list_owner_email} . '>'; $message_id = $msg_id; $mh->saved_message($mh->_massaged_for_archive(\%mailing)); } if($archive_m == 1 && ($q->param('process') !~ m/test/i)){ require DADA::MailingList::Archives; $DADA::MailingList::Archives::dbi_obj = $dbi_handle; my $archive = DADA::MailingList::Archives->new(-List => $li); $archive->set_archive_info($message_id, $q->param('message_subject'), undef, undef, $mh->saved_message); } } if(!$q->param('new_win')){ print(admin_html_header(-Title => "List Message Is Being Sent", -List => $list, -Root_Login => $root_login)); }else{ print $q->header(); print $q->start_html(-title => 'List Message Is Being Sent', -style => { -src => $DADA::Config::PROGRAM_URL . '/css', -code => 'body{text-align:left;margin:5px;padding:5px}' }, ); } require DADA::Template::Widgets; print DADA::Template::Widgets::screen(-screen => 'send_url_email_process_screen.tmpl', -vars => { test => $process =~ m/test/i ? 1 : 0, list_owner_email => $li->{list_owner_email}, message_id => $message_id, archived => (($archive_m ne "0") && ($q->param('process') !~ m/test/i)) ? 1 : 0, problems => $problems, archive_no_send => ($q->param('archive_no_send') == 1 ) ? 1 : 0, test_recipient => $test_recipient, type => 'list', }, ); if(!$q->param('new_win')){ print(admin_html_footer(-List => $list)); }else{ print ''; print $q->end_html; } }else{ die "$DADA::Config::PROGRAM_NAME $DADA::Config::VER Error: $!\n"; } } } sub change_info { my ($admin_list, $root_login) = check_list_security(-cgi_obj => $q, -Function => 'change_info'); $list = $admin_list; require DADA::MailingList::Settings; $DADA::MailingList::Settings::dbi_obj = $dbi_handle; my $ls = DADA::MailingList::Settings->new(-List => $list); my $li = $ls->get; 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; print(admin_html_header(-Title => "Change List Information", -List => $list, -Root_Login => $root_login)); require DADA::Template::Widgets; print DADA::Template::Widgets::screen(-screen => 'change_info_screen.tmpl', -vars => { done => $done, errors => $errors, errors_ending => $errors_ending, err_word => $err_word, list => $list, list_name => $list_name ? $list_name : $li->{list_name}, list_owner_email => $list_owner_email ? $list_owner_email : $li->{list_owner_email}, admin_email => $admin_email ? $admin_email : $li->{admin_email}, info => $info ? $info : $li->{info}, privacy_policy => $privacy_policy ? $privacy_policy : $li->{privacy_policy}, physical_address => $physical_address ? $physical_address : $li->{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, }, ); print(admin_html_footer(-List => $list)); }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; $DADA::MailingList::Settings::dbi_obj = $dbi_handle; my $ls = DADA::MailingList::Settings->new(-List => $list); my $li = $ls->get; if(!$process) { print(admin_html_header(-Title => "Change List Password", -List => $list, -Root_Login => $root_login)); require DADA::Template::Widgets; print DADA::Template::Widgets::screen(-screen => 'change_password_screen.tmpl', -list => $list, -vars => { root_login => $root_login, }, ); print admin_html_footer(-List => $list); }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($li->{password},$old_password); if ($password_check != 1) { user_error(-List => $list, -Error => "invalid_password"); } } $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 => "pass_no_match"); } $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); #print $q->redirect(-uri => $DADA::Config::S_PROGRAM_URL . '?flavor=' . $DADA::Config::ADMIN_FLAVOR_NAME); 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); my $li = $ls->get; if(!$process){ print(admin_html_header( -Title => "Confirm Delete List", -List => $list, -Root_Login => $root_login)); require DADA::Template::Widgets; print DADA::Template::Widgets::screen(-screen => 'delete_list_screen.tmpl', -list => $list,); print(admin_html_footer(-List => $list)); }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); print(the_html(-Part => 'header', -Title => "Deletion Successful", -header_params => {-COOKIE => $logout_cookie})); require DADA::Template::Widgets; print DADA::Template::Widgets::screen(-screen => 'delete_list_success_screen.tmpl', -list => $list, ); print(the_html(-Part => 'footer')); } } sub list_options { my ($admin_list, $root_login) = check_list_security(-cgi_obj => $q, -Function => 'list_options'); $list = $admin_list; #receive a few variables.. my $closed_list = $q->param("closed_list") || 0; my $hide_list = $q->param("hide_list") || 0; my $get_sub_notice = $q->param("get_sub_notice") || 0; my $get_unsub_notice = $q->param("get_unsub_notice") || 0; my $no_confirm_email = $q->param("no_confirm_email") || 0; my $unsub_confirm_email = $q->param("unsub_confirm_email") || 0; my $send_unsub_success_email = $q->param("send_unsub_success_email") || 0; my $send_sub_success_email = $q->param("send_sub_success_email") || 0; my $mx_check = $q->param("mx_check") || 0; my $limit_sub_confirm = $q->param('limit_sub_confirm') || 0; my $limit_unsub_confirm = $q->param('limit_unsub_confirm') || 0; my $email_your_subscribed_msg = $q->param('email_your_subscribed_msg') || 0; my $use_alt_url_sub_confirm_success = $q->param("use_alt_url_sub_confirm_success") || 0; my $alt_url_sub_confirm_success = $q->param( "alt_url_sub_confirm_success") || ''; my $alt_url_sub_confirm_success_w_qs = $q->param('alt_url_sub_confirm_success_w_qs') || 0; my $use_alt_url_sub_confirm_failed = $q->param("use_alt_url_sub_confirm_failed") || 0; my $alt_url_sub_confirm_failed = $q->param( "alt_url_sub_confirm_failed") || ''; my $alt_url_sub_confirm_failed_w_qs = $q->param('alt_url_sub_confirm_failed_w_qs') || 0; my $captcha_sub = $q->param('captcha_sub') || 0; my $use_alt_url_sub_success = $q->param("use_alt_url_sub_success") || 0; my $alt_url_sub_success = $q->param( "alt_url_sub_success") || ''; my $alt_url_sub_success_w_qs = $q->param( 'alt_url_sub_success_w_qs') || 0; my $use_alt_url_sub_failed = $q->param("use_alt_url_sub_failed") || 0; my $alt_url_sub_failed = $q->param( "alt_url_sub_failed") || ''; my $alt_url_sub_failed_w_qs = $q->param('alt_url_sub_failed_w_qs') || 0; my $use_alt_url_unsub_confirm_success = $q->param("use_alt_url_unsub_confirm_success") || 0; my $alt_url_unsub_confirm_success = $q->param( "alt_url_unsub_confirm_success") || ''; my $alt_url_unsub_confirm_success_w_qs = $q->param('alt_url_unsub_confirm_success_w_qs') || 0; my $use_alt_url_unsub_confirm_failed = $q->param("use_alt_url_unsub_confirm_failed") || 0; my $alt_url_unsub_confirm_failed = $q->param( "alt_url_unsub_confirm_failed") || ''; my $alt_url_unsub_confirm_failed_w_qs = $q->param('alt_url_unsub_confirm_failed_w_qs') || 0; my $use_alt_url_unsub_success = $q->param("use_alt_url_unsub_success") || 0; my $alt_url_unsub_success = $q->param( "alt_url_unsub_success") || ''; my $alt_url_unsub_success_w_qs = $q->param('alt_url_unsub_success_w_qs') || 0; my $use_alt_url_unsub_failed = $q->param("use_alt_url_unsub_failed") || 0; my $alt_url_unsub_failed = $q->param( "alt_url_unsub_failed") || ''; my $alt_url_unsub_failed_w_qs = $q->param('alt_url_unsub_failed_w_qs') || 0; require DADA::MailingList::Settings; $DADA::MailingList::Settings::dbi_obj = $dbi_handle; my $ls = DADA::MailingList::Settings->new(-List => $list); my $li = $ls->get(); my $can_use_mx_lookup = 0; eval { require Net::DNS; }; if(!$@){ $can_use_mx_lookup = 1; } my $can_use_captcha = 0; eval { require GD::SecurityImage; }; if(!$@){ eval { require GD; }; if(!$@){ $can_use_captcha = 1; } } if(!$process){ $list = $admin_list; print(admin_html_header( -Title => "Mailing List Options", -List => $list, -Root_Login => $root_login )); require DADA::Template::Widgets; print DADA::Template::Widgets::screen(-screen => 'list_options_screen.tmpl', -list => $list, -vars => { done => $done, can_use_mx_lookup => $can_use_mx_lookup, can_use_captcha => $can_use_captcha, %{$li}, }); print(admin_html_footer(-List => $list)); }else{ $list = $admin_list; $ls->save({ hide_list => $hide_list, closed_list => $closed_list, get_sub_notice => $get_sub_notice, get_unsub_notice => $get_unsub_notice, no_confirm_email => $no_confirm_email, unsub_confirm_email => $unsub_confirm_email, send_unsub_success_email => $send_unsub_success_email, send_sub_success_email => $send_sub_success_email, mx_check => $mx_check, limit_sub_confirm => $limit_sub_confirm, limit_unsub_confirm => $limit_unsub_confirm, email_your_subscribed_msg => $email_your_subscribed_msg, use_alt_url_sub_confirm_success => $use_alt_url_sub_confirm_success, alt_url_sub_confirm_success => $alt_url_sub_confirm_success, alt_url_sub_confirm_success_w_qs => $alt_url_sub_confirm_success_w_qs, use_alt_url_sub_confirm_failed => $use_alt_url_sub_confirm_failed, alt_url_sub_confirm_failed => $alt_url_sub_confirm_failed, alt_url_sub_confirm_failed_w_qs => $alt_url_sub_confirm_failed_w_qs, use_alt_url_sub_success => $use_alt_url_sub_success, alt_url_sub_success => $alt_url_sub_success, alt_url_sub_success_w_qs => $alt_url_sub_success_w_qs, use_alt_url_sub_failed => $use_alt_url_sub_failed, alt_url_sub_failed => $alt_url_sub_failed, alt_url_sub_failed_w_qs => $alt_url_sub_failed_w_qs, use_alt_url_unsub_confirm_success => $use_alt_url_unsub_confirm_success, alt_url_unsub_confirm_success => $alt_url_unsub_confirm_success, alt_url_unsub_confirm_success_w_qs => $alt_url_unsub_confirm_success_w_qs, use_alt_url_unsub_confirm_failed => $use_alt_url_unsub_confirm_failed, alt_url_unsub_confirm_failed => $alt_url_unsub_confirm_failed, alt_url_unsub_confirm_failed_w_qs => $alt_url_unsub_confirm_failed_w_qs, use_alt_url_unsub_success => $use_alt_url_unsub_success, alt_url_unsub_success => $alt_url_unsub_success, alt_url_unsub_success_w_qs => $alt_url_unsub_success_w_qs, use_alt_url_unsub_failed => $use_alt_url_unsub_failed, alt_url_unsub_failed => $alt_url_unsub_failed, alt_url_unsub_failed_w_qs => $alt_url_unsub_failed_w_qs, captcha_sub => $captcha_sub, }); print $q->redirect(-uri=>$DADA::Config::S_PROGRAM_URL . '?flavor=list_options&done=1'); } } sub sending_options { my ($admin_list, $root_login) = check_list_security(-cgi_obj => $q, -Function => 'sending_options'); $list = $admin_list; require DADA::MailingList::Settings; $DADA::MailingList::Settings::dbi_obj = $dbi_handle; my $ls = DADA::MailingList::Settings->new(-List => $list); my $li = $ls->get; # TO DO: Make a guesstimate on how long a message will take to send. #my $lh = DADA::MailingList::Subscribers->new(-List => $list); # #my $num_subscribers = $lh->num_subscribers(-Type => 'list'); if(!$process){ my @message_amount = (1..60); # , 30, 40, 50, 60, 70, # 80, 90, 100, 150, 200, # 250, 300, 350, 400, 450, # 500, 1000, 1500, 2000, # 4000, 6000, 8000, 10000); unshift(@message_amount, $li->{bulk_send_amount}) if exists($li->{bulk_send_amount}); my @message_wait = (1..60); unshift(@message_wait, $li->{bulk_sleep_amount}) if exists($li->{bulk_sleep_amount}); # my @message_label = (1, 60, 3600); my @message_label = (1); my %label_label = (1 => 'second(s)', #60 => 'minute(s)', #3600 => 'hour(s)', #86400 => 'day(s)', ); my $bulk_send_amount_menu = $q->popup_menu(-name => "bulk_send_amount", -value => [@message_amount], ); my $bulk_sleep_amount_menu = $q->popup_menu(-name => "bulk_sleep_amount", -value => [@message_wait], ); my $no_smtp_server_set = 0; $no_smtp_server_set = 1 if(!$li->{smtp_server}) && $li->{send_via_smtp} && ($li->{send_via_smtp} == 1); my $perl_needs_updating = 0; $perl_needs_updating = 1 if $] < 5.006; print(admin_html_header( -Title => "Sending Options", -List => $list, -Root_Login => $root_login)); require DADA::Template::Widgets; print DADA::Template::Widgets::screen(-screen => 'sending_options_screen.tmpl', -vars => { done => $done, send_via_smtp => $li->{send_via_smtp}, enable_bulk_batching => $li->{enable_bulk_batching}, get_finished_notification => $li->{get_finished_notification}, no_smtp_server_set => $no_smtp_server_set, perl_version => $], perl_needs_updating => $perl_needs_updating, bulk_send_amount_menu => $bulk_send_amount_menu, bulk_sleep_amount_menu => $bulk_sleep_amount_menu, auto_pickup_dropped_mailings => $li->{auto_pickup_dropped_mailings}, restart_mailings_after_each_batch => $li->{restart_mailings_after_each_batch}, }, ); print(admin_html_footer(-List => $list)); }else{ my $bulk_send_amount = $q->param("bulk_send_amount"); my $bulk_sleep_amount = $q->param("bulk_sleep_amount"); my $precedence = $q->param('precedence'); my $charset = $q->param('charset'); my $content_type = $q->param('content_type'); my $enable_bulk_batching = $q->param("enable_bulk_batching") || 0; my $get_finished_notification = $q->param("get_finished_notification") || 0; my $send_via_smtp = $q->param("send_via_smtp") || 0; my $auto_pickup_dropped_mailings = $q->param('auto_pickup_dropped_mailings') || 0; my $restart_mailings_after_each_batch = $q->param('restart_mailings_after_each_batch') || 0; $ls->save({ bulk_send_amount => $bulk_send_amount, bulk_sleep_amount => $bulk_sleep_amount, enable_bulk_batching => $enable_bulk_batching, bulk_sleep_amount => $bulk_sleep_amount, get_finished_notification => $get_finished_notification, send_via_smtp => $send_via_smtp, auto_pickup_dropped_mailings => $auto_pickup_dropped_mailings, restart_mailings_after_each_batch => $restart_mailings_after_each_batch, }); print $q->redirect(-uri => $DADA::Config::S_PROGRAM_URL . '?flavor=sending_options&done=1'); } } sub adv_sending_options { my ($admin_list, $root_login) = check_list_security(-cgi_obj => $q, -Function => 'sending_options'); $list = $admin_list; require DADA::MailingList::Settings; $DADA::MailingList::Settings::dbi_obj = $dbi_handle; my $ls = DADA::MailingList::Settings->new(-List => $list) ; my $li = $ls->get; if(!$process){ unshift(@DADA::Config::CHARSETS, $li->{charset}); my $precedence_popup_menu = $q->popup_menu(-name => "precedence", -value => [@DADA::Config::PRECEDENCES], -default => $li->{precedence}, ); my $priority_popup_menu = $q->popup_menu(-name => "priority", -value => [keys %DADA::Config::PRIORITIES], -labels => \%DADA::Config::PRIORITIES, -default => $li->{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 => $li->{plaintext_encoding}, ); my $html_encoding_popup_menu = $q->popup_menu(-name => 'html_encoding', -value => [@DADA::Config::CONTENT_TRANSFER_ENCODINGS], -default => $li->{html_encoding}, ); # my $content_type_popup_menu = $q->popup_menu(-name => 'content_type', # -value => [@CONTENT_TYPES], # -default => $li->{content_type}, # ); my $wrong_uid = 0; $wrong_uid = 1 if $< != $>; print(admin_html_header(-Title => "Advanced Sending Options", -List => $list, -Root_Login => $root_login)); require DADA::Template::Widgets; print DADA::Template::Widgets::screen(-screen => 'adv_sending_options_screen.tmpl', -list => $list, -vars => { 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, #content_type_popup_menu => $content_type_popup_menu, strip_message_headers => $li->{strip_message_headers}, print_list_headers => $li->{print_list_headers}, add_sendmail_f_flag => $li->{add_sendmail_f_flag}, f_flag_settings => $DADA::Config::MAIL_SETTINGS . ' -f' . $li->{admin_email}, wrong_uid => $wrong_uid, print_errors_to_header => $li->{print_errors_to_header}, print_return_path_header => $li->{print_return_path_header}, use_habeas_headers => $li->{use_habeas_headers}, verp_return_path => $li->{verp_return_path}, use_domain_sending_tunings => ($li->{use_domain_sending_tunings} ? 1 : 0), }); print(admin_html_footer(-List => $list)); }else{ my $precedence = $q->param('precedence'); my $priority = $q->param('priority'); my $charset = $q->param('charset'); my $plaintext_encoding = $q->param('plaintext_encoding'); my $html_encoding = $q->param('html_encoding'); #my $content_type = $q->param('content_type'); my $strip_message_headers = $q->param('strip_message_headers') || 0; my $add_sendmail_f_flag = $q->param('add_sendmail_f_flag') || 0; my $print_return_path_header = $q->param('print_return_path_header') || 0; my $print_errors_to_header = $q->param('print_errors_to_header') || 0; my $print_list_headers = $q->param('print_list_headers') || 0; my $verp_return_path = $q->param('verp_return_path') || 0; my $use_habeas_headers = $q->param('use_habeas_headers') || 0; my $use_domain_sending_tunings = $q->param('use_domain_sending_tunings') || 0; $ls->save({ precedence => $precedence, priority => $priority, charset => $charset, #content_type => $content_type, strip_message_headers => $strip_message_headers, add_sendmail_f_flag => $add_sendmail_f_flag, print_list_headers => $print_list_headers, print_return_path_header => $print_return_path_header, print_errors_to_header => $print_errors_to_header, plaintext_encoding => $plaintext_encoding, html_encoding => $html_encoding, verp_return_path => $verp_return_path, use_habeas_headers => $use_habeas_headers, use_domain_sending_tunings => $use_domain_sending_tunings, }); print $q->redirect(-uri=>$DADA::Config::S_PROGRAM_URL . '?flavor=adv_sending_options&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 send_via_smtp add_sendmail_f_flag print_return_path_header verp_return_path ); $list = $admin_list; require DADA::MailingList::Settings; $DADA::MailingList::Settings::dbi_obj = $dbi_handle; my $ls = DADA::MailingList::Settings->new(-List => $list); my $li = $ls->get; 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($li->{domain_sending_tunings}); #my $errors = {}; if($q->param('new_tuning') == 1){ my $new_tuning = {}; my $p_list = $q->Vars; foreach(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($li->{domain_sending_tunings}); my $new_tunings = []; foreach my $st(@$saved_tunings){ if($st->{domain} eq $q->param('domain')) { foreach 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($li->{domain_sending_tunings}); my $new_tunings = []; foreach(@$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 $li = $ls->get; my $saved_tunings = eval($li->{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; foreach(@$saved_tunings){ $saved_tunings->[$c]->{S_PROGRAM_URL} = $DADA::Config::S_PROGRAM_URL; $c++; } print(admin_html_header( -Title => "Domain-Specific Sending Tuning", -List => $list, -Root_Login => $root_login, -Form => 0, )); require DADA::Template::Widgets; print DADA::Template::Widgets::screen(-screen => 'sending_tuning_options.tmpl', -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 => ($li->{use_domain_sending_tunings} ? 1 : 0), # For pre-filling in the "new" forms list_send_via_smtp => $li->{send_via_smtp}, list_add_sendmail_f_flag => $li->{add_sendmail_f_flag}, list_print_return_path_header => $li->{print_return_path_header}, list_verp_return_path => $li->{verp_return_path}, }, ); print(admin_html_footer(-List => $list, -Form => 0, )); } } sub smtp_options { my ($admin_list, $root_login) = check_list_security(-cgi_obj => $q, -Function => 'smtp_options'); $list = $admin_list; require DADA::MailingList::Settings; $DADA::MailingList::Settings::dbi_obj = $dbi_handle; my $ls = DADA::MailingList::Settings->new(-List => $list); my $li = $ls->get; require DADA::Security::Password; require CGI::Ajax; my $pjx = new CGI::Ajax( 'smtp_test_results' => \&smtp_test_results, 'ajax_save_smtp_options' => \&ajax_save_smtp_options, ); my $decrypted_sasl_pass = q{}; if($li->{sasl_smtp_password}){ $decrypted_sasl_pass = DADA::Security::Password::cipher_decrypt($li->{cipher_key}, $li->{sasl_smtp_password}); } my $decrypted_pop3_pass = q{}; if($li->{pop3_password}){ $decrypted_pop3_pass = DADA::Security::Password::cipher_decrypt($li->{cipher_key}, $li->{pop3_password}); } my $can_use_net_smtp = 0; eval { require Net::SMTP }; if(!$@){ $can_use_net_smtp = 1; } my $can_use_smtp_ssl = 0; eval { require Net::SMTP::SSL }; if(!$@){ $can_use_smtp_ssl = 1; } if(!$process){ my $scr; $scr .= admin_html_header( -HTML_Header => 0, -Title => "SMTP Sending Options", -List => $li->{list}, -Root_Login => $root_login); require DADA::Template::Widgets; $scr .= DADA::Template::Widgets::screen(-list => $list, -screen => 'smtp_options_screen.tmpl', -expr => 1, # because I'm LAZY. -vars => { done => $done, smtp_server => $li->{smtp_server}, smtp_port => $li->{smtp_port}, use_smtp_ssl => $li->{use_smtp_ssl}, can_use_smtp_ssl => $can_use_smtp_ssl, use_pop_before_smtp => $li->{use_pop_before_smtp}, pop3_server => $li->{pop3_server}, pop3_username => $li->{pop3_username}, decrypted_pop3_pass => $decrypted_pop3_pass, set_smtp_sender => $li->{set_smtp_sender}, admin_email => $li->{admin_email}, use_sasl_smtp_auth => $q->param('use_sasl_smtp_auth') ? $q->param('use_sasl_smtp_auth') : $li->{use_sasl_smtp_auth}, sasl_smtp_username => $q->param('sasl_smtp_username') ? $q->param('sasl_smtp_username') : $li->{sasl_smtp_username}, decrypted_sasl_pass => $q->param('pop3_password') ? $q->param('pop3_password') : $decrypted_sasl_pass, }, ); # is that last line right?! $scr .= admin_html_footer(-List => $list); # This is really strange - if it's the ajax test, this'll return the test, not the screen up there. REALLY WEIRD. $scr = $pjx->build_html( $q, $scr, {admin_header_params()}); print $scr; }else{ my $use_pop_before_smtp = $q->param('use_pop_before_smtp') || 0; my $set_smtp_sender = $q->param('set_smtp_sender') || 0; my $smtp_server = strip($q->param('smtp_server')); my $pop3_server = strip($q->param('pop3_server')) || ''; my $pop3_username = strip($q->param('pop3_username')) || ''; my $pop3_password = strip($q->param('pop3_password')) || ''; my $use_smtp_ssl = $q->param('use_smtp_ssl') || 0; my $use_sasl_smtp_auth = $q->param('use_sasl_smtp_auth') || 0; my $sasl_smtp_username = strip($q->param('sasl_smtp_username')) || ''; my $sasl_smtp_password = strip($q->param('sasl_smtp_password')) || ''; $ls->save({ smtp_port => $q->param('smtp_port'), #smtp_connect_tries => $smtp_connect_tries, use_pop_before_smtp => $use_pop_before_smtp, use_smtp_ssl => $use_smtp_ssl, smtp_server => $smtp_server, pop3_server => $pop3_server, pop3_username => $pop3_username, pop3_password => DADA::Security::Password::cipher_encrypt($li->{cipher_key}, $pop3_password), use_sasl_smtp_auth => $use_sasl_smtp_auth, sasl_smtp_username => $sasl_smtp_username, sasl_smtp_password => DADA::Security::Password::cipher_encrypt($li->{cipher_key}, $sasl_smtp_password), set_smtp_sender => $set_smtp_sender, }); if($q->param('no_redirect') == 1){ print "Status: 204 No Response"; } else { print $q->redirect(-uri => $DADA::Config::S_PROGRAM_URL . '?flavor=smtp_options&done=1'); } } } sub smtp_test_results { my ($admin_list, $root_login) = check_list_security(-cgi_obj => $q, -Function => 'smtp_options'); require DADA::Mail::Send; require DADA::MailingList::Settings; my $ls = DADA::MailingList::Settings->new(-List => $admin_list); my $li = $ls->get; my $mh = DADA::Mail::Send->new($li); my ($results, $lines, $report) = $mh->smtp_test; $results =~ s/\</g; $results =~ s/\>/>/g; my $scr; $scr .= '
' . $s_f . ' - ' . $f->{message} . '
'; } $scr .= <$resultsEOF ; $scr .= '
\n"; my $email_count = $q -> param("email_count"); if(defined($email_count)){ my $add_message = "$email_count people have been added successfully"; print $q->p("$add_message"); } my $delete_email_count = $q -> param("delete_email_count"); if(defined($delete_email_count)){ print "
",$delete_email_count; print " emails have been deleted
"; } #my $any_subscribers = -s "$DADA::Config::FILES/$list.list"; # debug my $any_subscribers = 1; if($any_subscribers != 0){ print""; $DADA::Config::SHOW_EMAIL_LIST = 0; my ($everyone, $domains_ref, $count_services_ref) = $lh->list_option_form(-List => $list, -In_Order => $DADA::Config::LIST_IN_ORDER); if($DADA::Config::SHOW_DOMAIN_TABLE == 1) { #initialize some variables my $key; my $value; my $everyone_else = $domains_ref -> {Other}; print <
EOF ; } if($DADA::Config::SHOW_SERVICES_TABLE==1){ my $skey; my $svalue; my $using; my @skeys = sort(values %DADA::Config::SERVICES); print $q->p("Email address sorted by popular Email or ISP Services: click on a service to see the list of emails from that particular service."); print <
|