use strict; use warnings; use Test::More; use Test::LongString; use File::Temp; use HTTP::Request; use LWP::UserAgent; plan(tests => 47); require_ok('CGI'); require_ok('CGI::Application::MailPage'); my $options = { page => 'http://unused/test.html', rm => 'send_mail', name => 'Sammy Sender', from_email => 'sam@tregar.com', subject => 'Test Subject', to_emails => 'sam@tregar.com', note => '', format => 'both_attachment', }; $ENV{CGI_APP_RETURN_ONLY} = 1; $ENV{REMOTE_ADDR} = '123.45.67.89'; my $good_url = 'http://www.perl.com'; # 3-4 # test a the 'both_attachment' format { my $query = CGI->new($options); my $mail; my $mailpage = CGI::Application::MailPage->new( QUERY => $query, PARAMS => { document_root => './', smtp_server => 'unused', dump_mail => \$mail, use_page_param => 1, } ); my $output = $mailpage->run(); die if($output !~ /Mail Dumped/); contains_string($mail, 'This is the test HTML page', 'Test page as both'); contains_string($mail, 'X-Originating-Ip: 123.45.67.89'); } # 5 # test a the 'html' format { $options->{format} = 'html'; my $query = CGI->new($options); my $mail; my $mailpage = CGI::Application::MailPage->new( QUERY => $query, PARAMS => { document_root => './', smtp_server => 'unused', dump_mail => \$mail, use_page_param => 1, } ); my $output = $mailpage->run(); die if($output !~ /Mail Dumped/); ok($mail =~ /

This is the test HTML page<\/H1>/, 'Test page as HTML'); } # 6 # test a the 'html_attachment' format { $options->{format} = 'html_attachment'; my $query = CGI->new($options); my $mail; my $mailpage = CGI::Application::MailPage->new( QUERY => $query, PARAMS => { document_root => './', smtp_server => 'unused', dump_mail => \$mail, use_page_param => 1, } ); my $output = $mailpage->run(); die if($output !~ /Mail Dumped/); ok($mail =~ /

This is the test HTML page<\/H1>/, 'Test page as HTML attachment'); } # 7 # test a the 'text' format { $options->{format} = 'text'; my $query = CGI->new($options); my $mail; my $mailpage = CGI::Application::MailPage->new( QUERY => $query, PARAMS => { document_root => './', smtp_server => 'unused', dump_mail => \$mail, use_page_param => 1, } ); my $output = $mailpage->run(); die if($output !~ /Mail Dumped/); ok($mail =~ /This is the test HTML page/, 'Test page as text'); } # 8 # test a the 'text_attachment' format { $options->{format} = 'text_attachment'; my $query = CGI->new($options); my $mail; my $mailpage = CGI::Application::MailPage->new( QUERY => $query, PARAMS => { document_root => './', smtp_server => 'unused', dump_mail => \$mail, use_page_param => 1, } ); my $output = $mailpage->run(); die if($output !~ /Mail Dumped/); ok($mail =~ /This is the test HTML page/, 'Test page as text_attachment'); } # 9 # test the 'url' format { $options->{format} = 'url'; my $query = CGI->new($options); my $mail; my $mailpage = CGI::Application::MailPage->new( QUERY => $query, PARAMS => { document_root => './', smtp_server => 'unused', dump_mail => \$mail, use_page_param => 1, } ); my $output = $mailpage->run(); die if($output !~ /Mail Dumped/); ok($mail =~ m!http://unused/test.html!, 'Test page as url'); } # 10 # test an acceptable domain in 'acceptable_domains' option { $options->{format} = 'url'; my $query = CGI->new($options); my $mail; my $mailpage = CGI::Application::MailPage->new( QUERY => $query, PARAMS => { document_root => './', smtp_server => 'unused', dump_mail => \$mail, use_page_param => 1, acceptable_domains => [qw(unused)], } ); my $output = $mailpage->run(); die if($output !~ /Mail Dumped/); ok($mail =~ m!http://unused/test.html!, 'Acceptable Domain'); } # 11 # test an unacceptable domain in 'acceptable_domains' option { $options->{format} = 'url'; my $query = CGI->new($options); my $mail; my $mailpage = CGI::Application::MailPage->new( QUERY => $query, PARAMS => { document_root => './', smtp_server => 'unused', dump_mail => \$mail, use_page_param => 1, acceptable_domains => [qw(acceptable.com)], } ); my $output = $mailpage->run(); ok($output =~ m!not acceptable!, 'Domain Not Acceptable'); } # 12 # test the 'extra_tmpl_params' { $options->{format} = 'url'; $options->{rm} = 'show_form'; my $query = CGI->new($options); my $mail; my $mailpage = CGI::Application::MailPage->new( QUERY => $query, PARAMS => { document_root => './', smtp_server => 'unused', dump_mail => \$mail, use_page_param => 1, extra_tmpl_params => { note => 'This is my note.', }, } ); my $output = $mailpage->run(); ok($output =~ m!This is my note.!, 'extra_tmpl_params overrides'); } # 13 # test the 'remote_fetch' with a bad url { $options->{rm} = 'send_mail'; $options->{format} = 'both_attachment'; $options->{page} = 'http://unused/test.html'; my $query = CGI->new($options); my $mail; my $mailpage = CGI::Application::MailPage->new( QUERY => $query, PARAMS => { document_root => './', smtp_server => 'unused', dump_mail => \$mail, use_page_param => 1, remote_fetch => 1, } ); my $output = $mailpage->run(); ok($output =~ m!Unable to retrieve!i, 'remote_fetch invalid url'); } # 14 # test the 'remote_fetch' with a good url with 'both_attachment' # only if we can GET that url SKIP: { skip("Can't GET $good_url", 1) unless can_get($good_url); $options->{rm} = 'send_mail'; $options->{format} = 'both_attachment'; $options->{page} = 'http://google.com'; my $query = CGI->new($options); my $mail; my $mailpage = CGI::Application::MailPage->new( QUERY => $query, PARAMS => { document_root => './', smtp_server => 'unused', dump_mail => \$mail, use_page_param => 1, remote_fetch => 1, } ); my $output = $mailpage->run(); die $output if($output !~ /Mail Dumped/); ok($mail =~ m!http://google\.com!, 'remote_fetch valid url (both_attachment)'); } # 15 # test the 'remote_fetch' with a good url with 'html' SKIP: { skip("Can't GET $good_url", 1) unless can_get($good_url); $options->{rm} = 'send_mail'; $options->{format} = 'html'; $options->{page} = 'http://google.com'; my $query = CGI->new($options); my $mail; my $mailpage = CGI::Application::MailPage->new( QUERY => $query, PARAMS => { document_root => './', smtp_server => 'unused', dump_mail => \$mail, use_page_param => 1, remote_fetch => 1, } ); my $output = $mailpage->run(); die $output if($output !~ /Mail Dumped/); ok($mail =~ m!Google!, 'remote_fetch valid url (html)'); } # 16 # test the 'remote_fetch' with a good url with 'html_attachment' SKIP: { skip("Can't GET $good_url", 1) unless can_get($good_url); $options->{rm} = 'send_mail'; $options->{format} = 'html_attachment'; $options->{page} = 'http://google.com'; my $query = CGI->new($options); my $mail; my $mailpage = CGI::Application::MailPage->new( QUERY => $query, PARAMS => { document_root => './', smtp_server => 'unused', dump_mail => \$mail, use_page_param => 1, remote_fetch => 1, } ); my $output = $mailpage->run(); die $output if($output !~ /Mail Dumped/); ok($mail =~ m!Google!, 'remote_fetch valid url (html)'); } # 17 # test the 'remote_fetch' with a good url with 'text' SKIP: { skip("Can't GET $good_url", 1) unless can_get($good_url); $options->{rm} = 'send_mail'; $options->{format} = 'text'; $options->{page} = 'http://google.com'; my $query = CGI->new($options); my $mail; my $mailpage = CGI::Application::MailPage->new( QUERY => $query, PARAMS => { document_root => './', smtp_server => 'unused', dump_mail => \$mail, use_page_param => 1, remote_fetch => 1, } ); my $output = $mailpage->run(); die $output if($output !~ /Mail Dumped/); ok($mail =~ m!Google!, 'remote_fetch valid url (html)'); } # 18 # test the 'remote_fetch' with a good url with 'text_attachment' SKIP: { skip("Can't GET $good_url", 1) unless can_get($good_url); $options->{rm} = 'send_mail'; $options->{format} = 'text_attachment'; $options->{page} = 'http://google.com'; my $query = CGI->new($options); my $mail; my $mailpage = CGI::Application::MailPage->new( QUERY => $query, PARAMS => { document_root => './', smtp_server => 'unused', dump_mail => \$mail, use_page_param => 1, remote_fetch => 1, } ); my $output = $mailpage->run(); die $output if($output !~ /Mail Dumped/); ok($mail =~ m!Google!, 'remote_fetch valid url (html)'); } # 19 # test the 'remote_fetch' with a good url with 'url' SKIP: { skip("Can't GET $good_url", 1) unless can_get($good_url); $options->{rm} = 'send_mail'; $options->{format} = 'url'; $options->{page} = 'http://google.com'; my $query = CGI->new($options); my $mail; my $mailpage = CGI::Application::MailPage->new( QUERY => $query, PARAMS => { document_root => './', smtp_server => 'unused', dump_mail => \$mail, use_page_param => 1, remote_fetch => 1, } ); my $output = $mailpage->run(); die $output if($output !~ /Mail Dumped/); ok($mail =~ m!http://google.com!, 'remote_fetch valid url (url)'); } # 20..39 # test default and custom validation_profile { # some missing stuff my %local_options = ( note => "x a " x 100, rm => 'send_mail', page => 'http://unused/test.html', ); my $query = CGI->new(\%local_options); my $mail; my $mailpage = CGI::Application::MailPage->new( QUERY => $query, PARAMS => { document_root => './', smtp_server => 'unused', dump_mail => \$mail, use_page_param => 1, } ); my $output = $mailpage->run(); contains_string($output, "Your submission has errors"); contains_string($output, "Please fill in your name in the form below"); contains_string($output, "Please fill in your email address in the form below."); contains_string($output, "Please fill in your friends' email addresses in the form below."); contains_string($output, "Please enter a Subject for the email in the form below."); contains_string($output, "That is not an acceptable format!"); # some invalid stuff %local_options = ( name => "This is\na hack!", subject => "xx" x 50, from_email => 'stuyfffff', to_emails => "stuff me you and more stuff", note => "x a " x 100, format => "junk", page => 'http://unused/test.html', rm => 'send_mail', ); $query = CGI->new(\%local_options); $mailpage = CGI::Application::MailPage->new( QUERY => $query, PARAMS => { document_root => './', smtp_server => 'unused', dump_mail => \$mail, use_page_param => 1, } ); $output = $mailpage->run(); contains_string($output, "Your submission has errors"); contains_string($output, "That name is too long or contains unnacceptable characters."); contains_string($output, "That is not a valid email address."); contains_string($output, "One of your friend's email addresses is not valid"); contains_string($output, "That Subject is too long or contains unnacceptable characters."); contains_string($output, "That is not an acceptable format!"); contains_string($output, "Sorry, that note is too long!"); # override the subject to allow 100 characters and the format # to only allow the format 'url' %local_options = ( %local_options, format => 'html_attachment', ); $query = CGI->new(\%local_options); $mailpage = CGI::Application::MailPage->new( QUERY => $query, PARAMS => { document_root => './', smtp_server => 'unused', dump_mail => \$mail, use_page_param => 1, validation_profile => { constraints => { subject => qr/^[a-zA-Z0-9 ]{1,100}$/, format => sub { my $val = shift; return $val if( $val eq 'url' ); return; }, }, }, }, ); $output = $mailpage->run(); contains_string($output, "Your submission has errors"); contains_string($output, "That name is too long or contains unnacceptable characters."); contains_string($output, "That is not a valid email address."); contains_string($output, "One of your friend's email addresses is not valid"); lacks_string($output, "That Subject is too long or contains unnacceptable characters."); contains_string($output, "That is not an acceptable format!"); contains_string($output, "Sorry, that note is too long!"); # TODO - perhaps further stress the profile itself without having to worry about # the web interface } # 40..43 # test max_emails_per_request { # send 5 but have a limit of 3 my %local_options = ( %$options, to_emails => 'sam@tregar.com mpeters@plusthree.com, stupid@silly.com liar@untruth.com, gone@nothere.com', ); my $query = CGI->new(\%local_options); my $mail; my $mailpage = CGI::Application::MailPage->new( QUERY => $query, PARAMS => { document_root => './', smtp_server => 'unused', dump_mail => \$mail, use_page_param => 1, max_emails_per_request => 3, } ); my $output = $mailpage->run(); contains_string($output, "Your submission has errors"); contains_string($output, "exceeded the limit of emails to send."); # make the limit 5 $query = CGI->new(\%local_options); $mailpage = CGI::Application::MailPage->new( QUERY => $query, PARAMS => { document_root => './', smtp_server => 'unused', dump_mail => \$mail, use_page_param => 1, max_emails_per_request => 5, } ); $output = $mailpage->run(); lacks_string($output, "Your submission has errors"); lacks_string($output, "exceeded the limit of emails to send."); } # 44..47 # test max_emails_per_hour { # setup a temp file. my $tmp = File::Temp->new( UNLINK => 0, ) or die "Could not open temp file! $!"; my $file_name = $tmp->filename(); close($tmp) or die "Could not close temp file! $!"; # send 5 with an hourly limit of 9 my %local_options = ( %$options, to_emails => 'sam@tregar.com mpeters@plusthree.com, stupid@silly.com liar@untruth.com, gone@nothere.com', ); my $query = CGI->new(\%local_options); my $mail; my $mailpage = CGI::Application::MailPage->new( QUERY => $query, PARAMS => { document_root => './', smtp_server => 'unused', dump_mail => \$mail, use_page_param => 1, max_emails_per_hour => 9, max_emails_per_hour_file => $file_name, } ); my $output = $mailpage->run(); lacks_string($output, "Your submission has errors"); # send 5 again to exceed limit of 9 $query = CGI->new(\%local_options); $mailpage = CGI::Application::MailPage->new( QUERY => $query, PARAMS => { document_root => './', smtp_server => 'unused', dump_mail => \$mail, use_page_param => 1, max_emails_per_hour => 9, max_emails_per_hour_file => $file_name, } ); $output = $mailpage->run(); contains_string($output, "Hourly limit on emails exceeded!"); # open the file, reset the time and try again open(my $FH, '>', $file_name) or die "Could not open $file_name for reading! $!"; my $time = time() - (61 * 61); # a little more than an hour before my $new_count = 2; print $FH "$time:$new_count"; close($FH) or die "Could not close $file_name! $!"; # send 5 again to put new total at 7, still below 9 $query = CGI->new(\%local_options); $mailpage = CGI::Application::MailPage->new( QUERY => $query, PARAMS => { document_root => './', smtp_server => 'unused', dump_mail => \$mail, use_page_param => 1, max_emails_per_hour => 9, max_emails_per_hour_file => $file_name, } ); $output = $mailpage->run(); lacks_string($output, "Hourly limit on emails exceeded!"); # send 5 again to push us over again $query = CGI->new(\%local_options); $mailpage = CGI::Application::MailPage->new( QUERY => $query, PARAMS => { document_root => './', smtp_server => 'unused', dump_mail => \$mail, use_page_param => 1, max_emails_per_hour => 9, max_emails_per_hour_file => $file_name, } ); $output = $mailpage->run(); contains_string($output, "Hourly limit on emails exceeded!"); # now remove the temp file unlink($file_name) or die "Could not remove temp file $file_name! $!"; } sub can_get { my $url = shift; my $agent = LWP::UserAgent->new(); $agent->timeout(5); my $response = $agent->get($good_url); return $response->is_success; }