diff options
Diffstat (limited to 'rt/t/mail')
27 files changed, 1729 insertions, 452 deletions
diff --git a/rt/t/mail/bounce.t b/rt/t/mail/bounce.t new file mode 100644 index 000000000..703e86d67 --- /dev/null +++ b/rt/t/mail/bounce.t @@ -0,0 +1,42 @@ +use strict; +use warnings; + +use RT::Test tests => undef; + +RT->Config->Set( MailCommand => 'sendmailpipe' ); +RT->Config->Set( SetOutgoingMailFrom => 1 ); +RT->Config->Set( OverrideOutgoingMailFrom => { Default => 'queue@example.invalid' } ); + +# Ensure that the fake sendmail knows where to write to +$ENV{RT_MAILLOGFILE} = RT::Test->temp_directory . "/sendmailpipe.log"; +my $fake = File::Spec->rel2abs( File::Spec->catfile( + 't', 'mail', 'fake-sendmail' ) ); +RT->Config->Set( SendmailPath => $fake); + +my $message = <<EOM; +From: doesnotexist\@willbounce.invalid +Subject: This is a test of new ticket creation + +Bounce bounce bounce +EOM + +{ + # by default, MailError wants to crit or error the email message + # out to Screen, which scribbles all over the test output + no warnings 'redefine'; + my $orig_mail_error = RT::Interface::Email->can('MailError'); + local *RT::Interface::Email::MailError = sub { $orig_mail_error->( @_, LogLevel => undef ) }; + RT::Test->send_via_mailgate($message); +} + + +open(LOG, "<", $ENV{RT_MAILLOGFILE}) or die "Can't open log file: $!"; +my $fcount; +while (my $line = <LOG>) { + $fcount++ if $line =~ /^-f/; +} +close(LOG); +# RT_MAILLOGFILE will contain all the command line flags if you need them +is($fcount,1,"Only one -f specified to sendmail command"); + +done_testing; diff --git a/rt/t/mail/charsets-outgoing.t b/rt/t/mail/charsets-outgoing.t index e3f13fb6c..e17dd983d 100644 --- a/rt/t/mail/charsets-outgoing.t +++ b/rt/t/mail/charsets-outgoing.t @@ -18,8 +18,6 @@ my %string = ( }, ); -RT::Test->set_mail_catcher; - my $queue = RT::Test->load_or_create_queue( Name => 'Regression', CorrespondAddress => 'rt-recipient@example.com', @@ -27,15 +25,15 @@ my $queue = RT::Test->load_or_create_queue( ); ok $queue && $queue->id, 'loaded or created queue'; -diag "make sure queue has no subject tag" if $ENV{'TEST_VERBOSE'}; +diag "make sure queue has no subject tag"; { my ($status, $msg) = $queue->SetSubjectTag( undef ); ok $status, "set subject tag for the queue" or diag "error: $msg"; } -diag "set intial simple autoreply template" if $ENV{'TEST_VERBOSE'}; +diag "set intial simple autoreply template"; { - my $template = RT::Template->new( $RT::SystemUser ); + my $template = RT::Template->new( RT->SystemUser ); $template->Load('Autoreply'); ok $template->id, "loaded autoreply tempalte"; @@ -49,9 +47,9 @@ diag "set intial simple autoreply template" if $ENV{'TEST_VERBOSE'}; or diag "error: $msg"; } -diag "basic test of autoreply" if $ENV{'TEST_VERBOSE'}; +diag "basic test of autoreply"; { - my $ticket = RT::Ticket->new( $RT::SystemUser ); + my $ticket = RT::Ticket->new( RT->SystemUser ); $ticket->Create( Queue => $queue->id, Subject => 'test', @@ -61,10 +59,9 @@ diag "basic test of autoreply" if $ENV{'TEST_VERBOSE'}; ok @mails, "got some outgoing emails"; } -diag "non-ascii Subject with ascii prefix set in the template" - if $ENV{'TEST_VERBOSE'}; +diag "non-ascii Subject with ascii prefix set in the template"; foreach my $set ( 'ru', 'latin1' ) { - my $ticket = RT::Ticket->new( $RT::SystemUser ); + my $ticket = RT::Ticket->new( RT->SystemUser ); $ticket->Create( Queue => $queue->id, Subject => $string{$set}{test}, @@ -85,15 +82,15 @@ foreach my $set ( 'ru', 'latin1' ) { foreach my $tag_set ( 'ru', 'latin1' ) { -diag "set non-ascii subject tag for the queue" if $ENV{'TEST_VERBOSE'}; +diag "set non-ascii subject tag for the queue"; { my ($status, $msg) = $queue->SetSubjectTag( $string{$tag_set}{support} ); ok $status, "set subject tag for the queue" or diag "error: $msg"; } -diag "ascii subject with non-ascii subject tag" if $ENV{'TEST_VERBOSE'}; +diag "ascii subject with non-ascii subject tag"; { - my $ticket = RT::Ticket->new( $RT::SystemUser ); + my $ticket = RT::Ticket->new( RT->SystemUser ); $ticket->Create( Queue => $queue->id, Subject => 'test', @@ -112,9 +109,9 @@ diag "ascii subject with non-ascii subject tag" if $ENV{'TEST_VERBOSE'}; ok $status, "all mails have correct data"; } -diag "non-ascii subject with non-ascii subject tag" if $ENV{'TEST_VERBOSE'}; +diag "non-ascii subject with non-ascii subject tag"; foreach my $set ( 'ru', 'latin1' ) { - my $ticket = RT::Ticket->new( $RT::SystemUser ); + my $ticket = RT::Ticket->new( RT->SystemUser ); $ticket->Create( Queue => $queue->id, Subject => $string{$set}{test}, @@ -137,7 +134,7 @@ foreach my $set ( 'ru', 'latin1' ) { } # subject tag -diag "return back the empty subject tag" if $ENV{'TEST_VERBOSE'}; +diag "return back the empty subject tag"; { my ($status, $msg) = $queue->SetSubjectTag( undef ); ok $status, "set subject tag for the queue" or diag "error: $msg"; @@ -146,9 +143,9 @@ diag "return back the empty subject tag" if $ENV{'TEST_VERBOSE'}; foreach my $prefix_set ( 'ru', 'latin1' ) { -diag "add non-ascii subject prefix in the autoreply template" if $ENV{'TEST_VERBOSE'}; +diag "add non-ascii subject prefix in the autoreply template"; { - my $template = RT::Template->new( $RT::SystemUser ); + my $template = RT::Template->new( RT->SystemUser ); $template->Load('Autoreply'); ok $template->id, "loaded autoreply tempalte"; @@ -161,9 +158,9 @@ diag "add non-ascii subject prefix in the autoreply template" if $ENV{'TEST_VERB ok $status, "changed content of the template" or diag "error: $msg"; } -diag "ascii subject with non-ascii subject prefix in template" if $ENV{'TEST_VERBOSE'}; +diag "ascii subject with non-ascii subject prefix in template"; { - my $ticket = RT::Ticket->new( $RT::SystemUser ); + my $ticket = RT::Ticket->new( RT->SystemUser ); $ticket->Create( Queue => $queue->id, Subject => 'test', @@ -182,10 +179,9 @@ diag "ascii subject with non-ascii subject prefix in template" if $ENV{'TEST_VER ok $status, "all mails have correct data"; } -diag "non-ascii subject with non-ascii subject prefix in template" - if $ENV{'TEST_VERBOSE'}; +diag "non-ascii subject with non-ascii subject prefix in template"; foreach my $set ( 'ru', 'latin1' ) { - my $ticket = RT::Ticket->new( $RT::SystemUser ); + my $ticket = RT::Ticket->new( RT->SystemUser ); $ticket->Create( Queue => $queue->id, Subject => $string{$set}{test}, @@ -207,16 +203,15 @@ foreach my $set ( 'ru', 'latin1' ) { } foreach my $tag_set ( 'ru', 'latin1' ) { -diag "set non-ascii subject tag for the queue" if $ENV{'TEST_VERBOSE'}; +diag "set non-ascii subject tag for the queue"; { my ($status, $msg) = $queue->SetSubjectTag( $string{$tag_set}{support} ); ok $status, "set subject tag for the queue" or diag "error: $msg"; } -diag "non-ascii subject, non-ascii prefix in template and non-ascii tag" - if $ENV{'TEST_VERBOSE'}; +diag "non-ascii subject, non-ascii prefix in template and non-ascii tag"; foreach my $set ( 'ru', 'latin1' ) { - my $ticket = RT::Ticket->new( $RT::SystemUser ); + my $ticket = RT::Ticket->new( RT->SystemUser ); $ticket->Create( Queue => $queue->id, Subject => $string{$set}{test}, @@ -241,7 +236,7 @@ foreach my $set ( 'ru', 'latin1' ) { } # subject tag -diag "flush subject tag of the queue" if $ENV{'TEST_VERBOSE'}; +diag "flush subject tag of the queue"; { my ($status, $msg) = $queue->SetSubjectTag( undef ); ok $status, "set subject tag for the queue" or diag "error: $msg"; @@ -250,11 +245,11 @@ diag "flush subject tag of the queue" if $ENV{'TEST_VERBOSE'}; } # prefix set -diag "don't change subject via template" if $ENV{'TEST_VERBOSE'}; +diag "don't change subject via template"; # clean DB has autoreply that always changes subject in template, # we should test situation when subject is not changed from template { - my $template = RT::Template->new( $RT::SystemUser ); + my $template = RT::Template->new( RT->SystemUser ); $template->Load('Autoreply'); ok $template->id, "loaded autoreply tempalte"; @@ -267,9 +262,9 @@ diag "don't change subject via template" if $ENV{'TEST_VERBOSE'}; ok $status, "changed content of the template" or diag "error: $msg"; } -diag "non-ascii Subject without changes in template" if $ENV{'TEST_VERBOSE'}; +diag "non-ascii Subject without changes in template"; foreach my $set ( 'ru', 'latin1' ) { - my $ticket = RT::Ticket->new( $RT::SystemUser ); + my $ticket = RT::Ticket->new( RT->SystemUser ); $ticket->Create( Queue => $queue->id, Subject => $string{$set}{test}, @@ -289,16 +284,15 @@ foreach my $set ( 'ru', 'latin1' ) { } foreach my $tag_set ( 'ru', 'latin1' ) { -diag "set non-ascii subject tag for the queue" if $ENV{'TEST_VERBOSE'}; +diag "set non-ascii subject tag for the queue"; { my ($status, $msg) = $queue->SetSubjectTag( $string{$tag_set}{support} ); ok $status, "set subject tag for the queue" or diag "error: $msg"; } -diag "non-ascii Subject without changes in template and with non-ascii subject tag" - if $ENV{'TEST_VERBOSE'}; +diag "non-ascii Subject without changes in template and with non-ascii subject tag"; foreach my $set ( 'ru', 'latin1' ) { - my $ticket = RT::Ticket->new( $RT::SystemUser ); + my $ticket = RT::Ticket->new( RT->SystemUser ); $ticket->Create( Queue => $queue->id, Subject => $string{$set}{test}, @@ -320,3 +314,4 @@ foreach my $set ( 'ru', 'latin1' ) { } } # subject tag set + diff --git a/rt/t/mail/crypt-gnupg.t b/rt/t/mail/crypt-gnupg.t index cc52dd631..c0a875644 100644 --- a/rt/t/mail/crypt-gnupg.t +++ b/rt/t/mail/crypt-gnupg.t @@ -3,35 +3,20 @@ use strict; use warnings; -use RT::Test nodata => 1, tests => 92; -plan skip_all => 'GnuPG required.' - unless eval 'use GnuPG::Interface; 1'; -plan skip_all => 'gpg executable is required.' - unless RT::Test->find_executable('gpg'); - - -use File::Spec (); -use Cwd; - -my $homedir = RT::Test::get_abs_relocatable_dir(File::Spec->updir(), - qw(data gnupg keyrings) ); +my $homedir; +BEGIN { + require RT::Test; + $homedir = + RT::Test::get_abs_relocatable_dir( File::Spec->updir(), + qw/data gnupg keyrings/ ); +} -mkdir $homedir; +use RT::Test::GnuPG tests => 96, gnupg_options => { homedir => $homedir }; +use Test::Warn; -use_ok('RT::Crypt::GnuPG'); use_ok('MIME::Entity'); -RT->Config->Set( 'GnuPG', - Enable => 1, - OutgoingMessagesFormat => 'RFC' ); - -RT->Config->Set( 'GnuPGOptions', - homedir => $homedir, - 'no-permission-warning' => undef, -); - - -diag 'only signing. correct passphrase' if $ENV{'TEST_VERBOSE'}; +diag 'only signing. correct passphrase'; { my $entity = MIME::Entity->build( From => 'rt@example.com', @@ -67,14 +52,21 @@ diag 'only signing. correct passphrase' if $ENV{'TEST_VERBOSE'}; is( $status[0]->{'Trust'}, 'ULTIMATE', 'have trust value'); } -diag 'only signing. missing passphrase' if $ENV{'TEST_VERBOSE'}; +diag 'only signing. missing passphrase'; { my $entity = MIME::Entity->build( From => 'rt@example.com', Subject => 'test', Data => ['test'], ); - my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Encrypt => 0, Passphrase => '' ); + my %res; + warning_like { + %res = RT::Crypt::GnuPG::SignEncrypt( + Entity => $entity, + Encrypt => 0, + Passphrase => '' + ); + } qr/can't query passphrase in batch mode/; ok( $res{'exit_code'}, "couldn't sign without passphrase"); ok( $res{'error'} || $res{'logger'}, "error is here" ); @@ -84,14 +76,23 @@ diag 'only signing. missing passphrase' if $ENV{'TEST_VERBOSE'}; is( $status[0]->{'Status'}, 'MISSING', 'missing passphrase'); } -diag 'only signing. wrong passphrase' if $ENV{'TEST_VERBOSE'}; +diag 'only signing. wrong passphrase'; { my $entity = MIME::Entity->build( From => 'rt@example.com', Subject => 'test', Data => ['test'], ); - my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Encrypt => 0, Passphrase => 'wrong' ); + + my %res; + warning_like { + %res = RT::Crypt::GnuPG::SignEncrypt( + Entity => $entity, + Encrypt => 0, + Passphrase => 'wrong', + ); + } qr/bad passphrase/; + ok( $res{'exit_code'}, "couldn't sign with bad passphrase"); ok( $res{'error'} || $res{'logger'}, "error is here" ); @@ -101,7 +102,7 @@ diag 'only signing. wrong passphrase' if $ENV{'TEST_VERBOSE'}; is( $status[0]->{'Status'}, 'BAD', 'wrong passphrase'); } -diag 'encryption only' if $ENV{'TEST_VERBOSE'}; +diag 'encryption only'; { my $entity = MIME::Entity->build( From => 'rt@example.com', @@ -127,7 +128,7 @@ diag 'encryption only' if $ENV{'TEST_VERBOSE'}; is( $parts[0]->{'Top'}, $entity, "it's the same entity" ); } -diag 'encryption only, bad recipient' if $ENV{'TEST_VERBOSE'}; +diag 'encryption only, bad recipient'; { my $entity = MIME::Entity->build( From => 'rt@example.com', @@ -135,7 +136,15 @@ diag 'encryption only, bad recipient' if $ENV{'TEST_VERBOSE'}; Subject => 'test', Data => ['test'], ); - my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 ); + + my %res; + warning_like { + %res = RT::Crypt::GnuPG::SignEncrypt( + Entity => $entity, + Sign => 0, + ); + } qr/public key not found/; + ok( $res{'exit_code'}, 'no way to encrypt without keys of recipients'); ok( $res{'logger'}, "errors are in logger" ); @@ -144,7 +153,7 @@ diag 'encryption only, bad recipient' if $ENV{'TEST_VERBOSE'}; is( $status[0]->{'Keyword'}, 'INV_RECP', 'invalid recipient'); } -diag 'encryption and signing with combined method' if $ENV{'TEST_VERBOSE'}; +diag 'encryption and signing with combined method'; { my $entity = MIME::Entity->build( From => 'rt@example.com', @@ -174,7 +183,7 @@ diag 'encryption and signing with combined method' if $ENV{'TEST_VERBOSE'}; is( $parts[0]->{'Top'}, $entity, "it's the same entity" ); } -diag 'encryption and signing with cascading, sign on encrypted' if $ENV{'TEST_VERBOSE'}; +diag 'encryption and signing with cascading, sign on encrypted'; { my $entity = MIME::Entity->build( From => 'rt@example.com', @@ -196,7 +205,7 @@ diag 'encryption and signing with cascading, sign on encrypted' if $ENV{'TEST_VE is( $parts[0]->{'Top'}, $entity, "it's the same entity" ); } -diag 'find signed/encrypted part deep inside' if $ENV{'TEST_VERBOSE'}; +diag 'find signed/encrypted part deep inside'; { my $entity = MIME::Entity->build( From => 'rt@example.com', @@ -219,7 +228,7 @@ diag 'find signed/encrypted part deep inside' if $ENV{'TEST_VERBOSE'}; is( $parts[0]->{'Top'}, $entity->parts(0), "it's the same entity" ); } -diag 'wrong signed/encrypted parts: no protocol' if $ENV{'TEST_VERBOSE'}; +diag 'wrong signed/encrypted parts: no protocol'; { my $entity = MIME::Entity->build( From => 'rt@example.com', @@ -227,15 +236,24 @@ diag 'wrong signed/encrypted parts: no protocol' if $ENV{'TEST_VERBOSE'}; Subject => 'test', Data => ['test'], ); - my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 ); + + my %res = RT::Crypt::GnuPG::SignEncrypt( + Entity => $entity, + Sign => 0, + ); + ok( !$res{'exit_code'}, 'success' ); $entity->head->mime_attr( 'Content-Type.protocol' => undef ); - my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity ); + my @parts; + warning_like { + @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity ); + } qr{Entity is 'multipart/encrypted', but has no protocol defined. Skipped}; + is( scalar @parts, 0, 'no protected parts' ); } -diag 'wrong signed/encrypted parts: not enought parts' if $ENV{'TEST_VERBOSE'}; +diag 'wrong signed/encrypted parts: not enought parts'; { my $entity = MIME::Entity->build( From => 'rt@example.com', @@ -243,15 +261,23 @@ diag 'wrong signed/encrypted parts: not enought parts' if $ENV{'TEST_VERBOSE'}; Subject => 'test', Data => ['test'], ); - my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 ); + + my %res = RT::Crypt::GnuPG::SignEncrypt( + Entity => $entity, + Sign => 0, + ); + ok( !$res{'exit_code'}, 'success' ); $entity->parts([ $entity->parts(0) ]); - my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity ); + my @parts; + warning_like { + @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity ); + } qr/Encrypted or signed entity must has two subparts. Skipped/; is( scalar @parts, 0, 'no protected parts' ); } -diag 'wrong signed/encrypted parts: wrong proto' if $ENV{'TEST_VERBOSE'}; +diag 'wrong signed/encrypted parts: wrong proto'; { my $entity = MIME::Entity->build( From => 'rt@example.com', @@ -267,7 +293,7 @@ diag 'wrong signed/encrypted parts: wrong proto' if $ENV{'TEST_VERBOSE'}; is( scalar @parts, 0, 'no protected parts' ); } -diag 'wrong signed/encrypted parts: wrong proto' if $ENV{'TEST_VERBOSE'}; +diag 'wrong signed/encrypted parts: wrong proto'; { my $entity = MIME::Entity->build( From => 'rt@example.com', @@ -283,7 +309,7 @@ diag 'wrong signed/encrypted parts: wrong proto' if $ENV{'TEST_VERBOSE'}; is( scalar @parts, 0, 'no protected parts' ); } -diag 'verify inline and in attachment signatures' if $ENV{'TEST_VERBOSE'}; +diag 'verify inline and in attachment signatures'; { open( my $fh, '<', "$homedir/signed_old_style_with_attachment.eml" ) or die $!; my $parser = new MIME::Parser; diff --git a/rt/t/mail/dashboards.t b/rt/t/mail/dashboards.t new file mode 100644 index 000000000..7a7a54ce6 --- /dev/null +++ b/rt/t/mail/dashboards.t @@ -0,0 +1,397 @@ +#!/usr/bin/perl +use strict; +use warnings; + +use RT::Test tests => 187; +use Test::Warn; +use RT::Dashboard::Mailer; + +my ($baseurl, $m) = RT::Test->started_ok; +ok($m->login, 'logged in'); + +sub create_dashboard { + my ($baseurl, $m) = @_; + local $Test::Builder::Level = $Test::Builder::Level + 1; + $m->get_ok($baseurl . '/Dashboards/Modify.html?Create=1'); + $m->form_name('ModifyDashboard'); + $m->field('Name' => 'Testing!'); + $m->click_button(value => 'Create'); + $m->title_is('Modify the dashboard Testing!'); + + $m->follow_link_ok({text => 'Content'}); + $m->title_is('Modify the content of dashboard Testing!'); + + my $form = $m->form_name('Dashboard-Searches-body'); + my @input = $form->find_input('Searches-body-Available'); + my ($dashboards_component) = + map { ( $_->possible_values )[1] } + grep { ( $_->value_names )[1] =~ /Dashboards/ } @input; + $form->value('Searches-body-Available' => $dashboards_component ); + $m->click_button(name => 'add'); + $m->content_contains('Dashboard updated'); + + $m->follow_link_ok({text => 'Show'}); + $m->title_is('Testing! Dashboard'); + $m->content_contains('My dashboards'); + $m->content_like(qr{<a href="/Dashboards/\d+/Testing!">Testing!</a>}); + +} + +sub create_subscription { + my ($baseurl, $m, %fields) = @_; + local $Test::Builder::Level = $Test::Builder::Level + 1; + + # create a subscription + $m->follow_link_ok({text => 'Subscription'}); + $m->title_is('Subscribe to dashboard Testing!'); + $m->form_name('SubscribeDashboard'); + $m->set_fields(%fields); + $m->click_button(name => 'Save'); + $m->content_contains("Subscribed to dashboard Testing!"); +} + +sub get_dash_sub_ids { + my $user = RT::User->new(RT->SystemUser); + $user->Load('root'); + ok($user->Id, 'loaded user'); + my ($subscription) = $user->Attributes->Named('Subscription'); + my $subscription_id = $subscription->Id; + ok($subscription_id, 'loaded subscription'); + my $dashboard_id = $subscription->SubValue('DashboardId'); + ok($dashboard_id, 'got dashboard id'); + + + return ($dashboard_id, $subscription_id); +} + +# first, create and populate a dashboard +create_dashboard($baseurl, $m); + +# now test the mailer + +# without a subscription.. +RT::Dashboard::Mailer->MailDashboards(); + +my @mails = RT::Test->fetch_caught_mails; +is @mails, 0, 'no mail yet'; + +RT::Dashboard::Mailer->MailDashboards( + All => 1, +); + +@mails = RT::Test->fetch_caught_mails; +is @mails, 0, "no mail yet since there's no subscription"; + +create_subscription($baseurl, $m, + Frequency => 'daily', + Hour => '06:00', +); + +my ($dashboard_id, $subscription_id) = get_dash_sub_ids(); + +sub produces_dashboard_mail_ok { # {{{ + my %args = @_; + my $subject = delete $args{Subject}; + + local $Test::Builder::Level = $Test::Builder::Level + 1; + + RT::Dashboard::Mailer->MailDashboards(%args); + + my @mails = RT::Test->fetch_caught_mails; + is @mails, 1, "got a dashboard mail"; + + my $mail = parse_mail( $mails[0] ); + is($mail->head->get('Subject'), $subject); + is($mail->head->get('From'), "root\n"); + is($mail->head->get('X-RT-Dashboard-Id'), "$dashboard_id\n"); + is($mail->head->get('X-RT-Dashboard-Subscription-Id'), "$subscription_id\n"); + + SKIP: { + skip 'Weird MIME failure', 2; + my $body = $mail->stringify_body; + like($body, qr{My dashboards}); + like($body, qr{<a href="http://[^/]+/Dashboards/\d+/Testing!">Testing!</a>}); + }; +} # }}} + +sub produces_no_dashboard_mail_ok { # {{{ + my %args = @_; + my $name = delete $args{Name}; + + local $Test::Builder::Level = $Test::Builder::Level + 1; + + RT::Dashboard::Mailer->MailDashboards(%args); + + @mails = RT::Test->fetch_caught_mails; + is @mails, 0, $name; +} # }}} + +sub delete_dashboard { # {{{ + my $dashboard_id = shift; + # delete the dashboard and make sure we get exactly one subscription failure + # notice + my $dashboard = RT::Dashboard->new(RT::CurrentUser->new('root')); + my ($ok, $msg) = $dashboard->LoadById($dashboard_id); + ok($ok, $msg); + + ($ok, $msg) = $dashboard->Delete; + ok($ok, $msg); +} # }}} + +sub delete_subscriptions { # {{{ + my $subscription_id = shift; + # delete the dashboard and make sure we get exactly one subscription failure + # notice + my $user = RT::User->new(RT->SystemUser); + $user->Load('root'); + for my $subscription ($user->Attributes->Named('Subscription')) { + $subscription->Delete; + } +} # }}} + +my $good_time = 1290423660; # 6:01 EST on a monday +my $bad_time = 1290427260; # 7:01 EST on a monday + +my $expected_subject = "[example.com] Daily Dashboard: Testing!\n"; + +produces_dashboard_mail_ok( + Time => $good_time, + Subject => $expected_subject, +); + +produces_dashboard_mail_ok( + All => 1, + Subject => $expected_subject, +); + +produces_dashboard_mail_ok( + All => 1, + Time => $good_time, + Subject => $expected_subject, +); + +produces_dashboard_mail_ok( + All => 1, + Time => $bad_time, + Subject => $expected_subject, +); + + +produces_no_dashboard_mail_ok( + Name => "no dashboard mail it's a dry run", + All => 1, + DryRun => 1, +); + +produces_no_dashboard_mail_ok( + Name => "no dashboard mail it's a dry run", + Time => $good_time, + DryRun => 1, +); + +produces_no_dashboard_mail_ok( + Name => "no mail because it's the wrong time", + Time => $bad_time, +); + +@mails = RT::Test->fetch_caught_mails; +is(@mails, 0, "no mail leftover"); + + +$m->no_warnings_ok; +RT::Test->stop_server; +RT->Config->Set('DashboardSubject' => 'a %s b %s c'); +RT->Config->Set('DashboardAddress' => 'dashboard@example.com'); +RT->Config->Set('EmailDashboardRemove' => (qr/My dashboards/, "Testing!")); +($baseurl, $m) = RT::Test->started_ok; + +RT::Dashboard::Mailer->MailDashboards(All => 1); +@mails = RT::Test->fetch_caught_mails; +is(@mails, 1, "one mail"); +my $mail = parse_mail($mails[0]); +is($mail->head->get('Subject'), "[example.com] a Daily b Testing! c\n"); +is($mail->head->get('From'), "dashboard\@example.com\n"); +is($mail->head->get('X-RT-Dashboard-Id'), "$dashboard_id\n"); +is($mail->head->get('X-RT-Dashboard-Subscription-Id'), "$subscription_id\n"); + +SKIP: { + skip 'Weird MIME failure', 2; + my $body = $mail->stringify_body; + unlike($body, qr{My dashboards}); + unlike($body, qr{Testing!}); +}; + +delete_dashboard($dashboard_id); + +warning_like { + RT::Dashboard::Mailer->MailDashboards(All => 1); +} qr/Unable to load dashboard $dashboard_id of subscription $subscription_id for user root/; + +@mails = RT::Test->fetch_caught_mails; +is(@mails, 1, "one mail for subscription failure"); +$mail = parse_mail($mails[0]); +is($mail->head->get('Subject'), "[example.com] Missing dashboard!\n"); +is($mail->head->get('From'), "dashboard\@example.com\n"); +is($mail->head->get('X-RT-Dashboard-Id'), "$dashboard_id\n"); +is($mail->head->get('X-RT-Dashboard-Subscription-Id'), "$subscription_id\n"); + +RT::Dashboard::Mailer->MailDashboards(All => 1); +@mails = RT::Test->fetch_caught_mails; +is(@mails, 0, "no mail because the subscription notice happens only once"); + +RT::Test->stop_server; +RT::Test->clean_caught_mails; +RT->Config->Set('EmailDashboardRemove' => ()); +RT->Config->Set('DashboardAddress' => 'root'); +($baseurl, $m) = RT::Test->started_ok; +$m->login; +create_dashboard($baseurl, $m); +create_subscription($baseurl, $m, + Frequency => 'weekly', + Hour => '06:00', +); + +($dashboard_id, $subscription_id) = get_dash_sub_ids(); + +# bump $bad_time to Tuesday +$bad_time = $good_time + 86400; + +produces_dashboard_mail_ok( + Time => $good_time, + Subject => "[example.com] a Weekly b Testing! c\n", +); + +produces_no_dashboard_mail_ok( + Name => "no mail because it's the wrong time", + Time => $bad_time, +); + +@mails = RT::Test->fetch_caught_mails; +is(@mails, 0, "no mail leftover"); + +$m->no_warnings_ok; +RT::Test->stop_server; +RT->Config->Set('DashboardSubject' => 'a %s b %s c'); +RT->Config->Set('DashboardAddress' => 'dashboard@example.com'); +RT->Config->Set('EmailDashboardRemove' => (qr/My dashboards/, "Testing!")); +($baseurl, $m) = RT::Test->started_ok; + +delete_dashboard($dashboard_id); +delete_subscriptions(); + +RT::Test->clean_caught_mails; + +RT::Test->stop_server; + +RT->Config->Set('EmailDashboardRemove' => ()); +RT->Config->Set('DashboardAddress' => 'root'); +($baseurl, $m) = RT::Test->started_ok; +$m->login; +create_dashboard($baseurl, $m); +create_subscription($baseurl, $m, + Frequency => 'm-f', + Hour => '06:00', +); + +($dashboard_id, $subscription_id) = get_dash_sub_ids(); + +# bump $bad_time back to Sunday +$bad_time = $good_time - 86400; + +produces_dashboard_mail_ok( + Time => $good_time, + Subject => "[example.com] a Weekday b Testing! c\n", +); + +produces_no_dashboard_mail_ok( + Name => "no mail because it's the wrong time", + Time => $bad_time, +); + +produces_no_dashboard_mail_ok( + Name => "no mail because it's the wrong time", + Time => $bad_time - 86400, # saturday +); + +produces_dashboard_mail_ok( + Time => $bad_time - 86400 * 2, # friday + Subject => "[example.com] a Weekday b Testing! c\n", +); + + +@mails = RT::Test->fetch_caught_mails; +is(@mails, 0, "no mail leftover"); + +$m->no_warnings_ok; +RT::Test->stop_server; +RT->Config->Set('DashboardSubject' => 'a %s b %s c'); +RT->Config->Set('DashboardAddress' => 'dashboard@example.com'); +RT->Config->Set('EmailDashboardRemove' => (qr/My dashboards/, "Testing!")); +($baseurl, $m) = RT::Test->started_ok; + +delete_dashboard($dashboard_id); +delete_subscriptions(); + +RT::Test->clean_caught_mails; + +RT::Test->stop_server; + +RT->Config->Set('EmailDashboardRemove' => ()); +RT->Config->Set('DashboardAddress' => 'root'); +($baseurl, $m) = RT::Test->started_ok; +$m->login; +create_dashboard($baseurl, $m); +create_subscription($baseurl, $m, + Frequency => 'monthly', + Hour => '06:00', +); + +($dashboard_id, $subscription_id) = get_dash_sub_ids(); + +$good_time = 1291201200; # dec 1 +$bad_time = $good_time - 86400; # day before (i.e. different month) + +produces_dashboard_mail_ok( + Time => $good_time, + Subject => "[example.com] a Monthly b Testing! c\n", +); + +produces_no_dashboard_mail_ok( + Name => "no mail because it's the wrong time", + Time => $bad_time, +); + + +@mails = RT::Test->fetch_caught_mails; +is(@mails, 0, "no mail leftover"); + +$m->no_warnings_ok; +RT::Test->stop_server; +RT->Config->Set('DashboardSubject' => 'a %s b %s c'); +RT->Config->Set('DashboardAddress' => 'dashboard@example.com'); +RT->Config->Set('EmailDashboardRemove' => (qr/My dashboards/, "Testing!")); +($baseurl, $m) = RT::Test->started_ok; + +delete_dashboard($dashboard_id); +delete_subscriptions(); + +RT::Test->clean_caught_mails; + +RT::Test->stop_server; + +RT->Config->Set('EmailDashboardRemove' => ()); +RT->Config->Set('DashboardAddress' => 'root'); +($baseurl, $m) = RT::Test->started_ok; +$m->login; +create_dashboard($baseurl, $m); +create_subscription($baseurl, $m, + Frequency => 'never', +); + +($dashboard_id, $subscription_id) = get_dash_sub_ids(); + +produces_no_dashboard_mail_ok( + Name => "mail should never get sent", + Time => $bad_time, +); + diff --git a/rt/t/mail/digest-attributes.t b/rt/t/mail/digest-attributes.t new file mode 100644 index 000000000..5b4560621 --- /dev/null +++ b/rt/t/mail/digest-attributes.t @@ -0,0 +1,168 @@ +#!/usr/bin/perl -w + +use warnings; +use strict; +use RT; +use RT::Test tests => 31; +my @users = qw/ emailnormal@example.com emaildaily@example.com emailweekly@example.com emailsusp@example.com /; + +my( $ret, $msg ); +my $user_n = RT::User->new( RT->SystemUser ); +( $ret, $msg ) = $user_n->LoadOrCreateByEmail( $users[0] ); +ok( $ret, "user with default email prefs created: $msg" ); +$user_n->SetPrivileged( 1 ); + +my $user_d = RT::User->new( RT->SystemUser ); +( $ret, $msg ) = $user_d->LoadOrCreateByEmail( $users[1] ); +ok( $ret, "user with daily digest email prefs created: $msg" ); +# Set a username & password for testing the interface. +$user_d->SetPrivileged( 1 ); +$user_d->SetPreferences($RT::System => { %{ $user_d->Preferences( $RT::System ) || {}}, EmailFrequency => 'Daily digest'}); + + + +my $user_w = RT::User->new( RT->SystemUser ); +( $ret, $msg ) = $user_w->LoadOrCreateByEmail( $users[2] ); +ok( $ret, "user with weekly digest email prefs created: $msg" ); +$user_w->SetPrivileged( 1 ); +$user_w->SetPreferences($RT::System => { %{ $user_w->Preferences( $RT::System ) || {}}, EmailFrequency => 'Weekly digest'}); + +my $user_s = RT::User->new( RT->SystemUser ); +( $ret, $msg ) = $user_s->LoadOrCreateByEmail( $users[3] ); +ok( $ret, "user with suspended email prefs created: $msg" ); +$user_s->SetPreferences($RT::System => { %{ $user_s->Preferences( $RT::System ) || {}}, EmailFrequency => 'Suspended'}); +$user_s->SetPrivileged( 1 ); + + +is(RT::Config->Get('EmailFrequency' => $user_s), 'Suspended'); + +# Make a testing queue for ourselves. +my $testq = RT::Queue->new( RT->SystemUser ); +if( $testq->ValidateName( 'EmailDigest-testqueue' ) ) { + ( $ret, $msg ) = $testq->Create( Name => 'EmailDigest-testqueue' ); + ok( $ret, "Our test queue is created: $msg" ); +} else { + $testq->Load( 'EmailDigest-testqueue' ); + ok( $testq->id, "Our test queue is loaded" ); +} + +# Allow anyone to open a ticket on the test queue. +my $everyone = RT::Group->new( RT->SystemUser ); +( $ret, $msg ) = $everyone->LoadSystemInternalGroup( 'Everyone' ); +ok( $ret, "Loaded 'everyone' group: $msg" ); + +( $ret, $msg ) = $everyone->PrincipalObj->GrantRight( Right => 'CreateTicket', + Object => $testq ); +ok( $ret || $msg =~ /already has/, "Granted everyone CreateTicket on testq: $msg" ); + +# Make user_d an admincc for the queue. +( $ret, $msg ) = $user_d->PrincipalObj->GrantRight( Right => 'AdminQueue', + Object => $testq ); +ok( $ret || $msg =~ /already has/, "Granted dduser AdminQueue on testq: $msg" ); +( $ret, $msg ) = $testq->AddWatcher( Type => 'AdminCc', + PrincipalId => $user_d->PrincipalObj->id ); +ok( $ret || $msg =~ /already/, "dduser added as a queue watcher: $msg" ); + +# Give the others queue rights. +( $ret, $msg ) = $user_n->PrincipalObj->GrantRight( Right => 'AdminQueue', + Object => $testq ); +ok( $ret || $msg =~ /already has/, "Granted emailnormal right on testq: $msg" ); +( $ret, $msg ) = $user_w->PrincipalObj->GrantRight( Right => 'AdminQueue', + Object => $testq ); +ok( $ret || $msg =~ /already has/, "Granted emailweekly right on testq: $msg" ); +( $ret, $msg ) = $user_s->PrincipalObj->GrantRight( Right => 'AdminQueue', + Object => $testq ); +ok( $ret || $msg =~ /already has/, "Granted emailsusp right on testq: $msg" ); + +# Create a ticket with To: Cc: Bcc: fields using our four users. +my $id; +my $ticket = RT::Ticket->new( RT->SystemUser ); +( $id, $ret, $msg ) = $ticket->Create( Queue => $testq->Name, + Requestor => [ $user_w->Name ], + Subject => 'Test ticket for RT::Extension::EmailDigest', + ); +ok( $ret, "Ticket $id created: $msg" ); + +# Make the other users ticket watchers. +( $ret, $msg ) = $ticket->AddWatcher( Type => 'Cc', + PrincipalId => $user_n->PrincipalObj->id ); +ok( $ret, "Added user_n as a ticket watcher: $msg" ); +( $ret, $msg ) = $ticket->AddWatcher( Type => 'Cc', + PrincipalId => $user_s->PrincipalObj->id ); +ok( $ret, "Added user_s as a ticket watcher: $msg" ); + +my $obj; +($id, $msg, $obj ) = $ticket->Correspond( + Content => "This is a ticket response for CC action" ); +ok( $ret, "Transaction created: $msg" ); + +# Get the deferred notifications that should result. Should be two for +# email daily, and one apiece for emailweekly and emailsusp. +my @notifications; + +my $txns = RT::Transactions->new( RT->SystemUser ); +$txns->LimitToTicket( $ticket->id ); +my( $c_daily, $c_weekly, $c_susp ) = ( 0, 0, 0 ); +while( my $txn = $txns->Next ) { + my @daily_rcpt = $txn->DeferredRecipients( 'daily' ); + my @weekly_rcpt = $txn->DeferredRecipients('weekly' ); + my @susp_rcpt = $txn->DeferredRecipients( 'susp' ); + + $c_daily++ if @daily_rcpt; + $c_weekly++ if @weekly_rcpt; + $c_susp++ if @susp_rcpt; + + # If the transaction has content... + if( $txn->ContentObj ) { + # ...none of the deferred folk should be in the header. + my $headerstr = $txn->ContentObj->Headers; + foreach my $rcpt( @daily_rcpt, @weekly_rcpt, @susp_rcpt ) { + ok( $headerstr !~ /$rcpt/, "Deferred recipient $rcpt not found in header" ); + } + } +} + +# Finally, check to see that we got the correct number of each sort of +# deferred recipient. +is( $c_daily, 2, "correct number of daily-sent messages" ); +is( $c_weekly, 2, "correct number of weekly-sent messages" ); +is( $c_susp, 1, "correct number of suspended messages" ); + + + + + +# Now let's actually run the daily and weekly digest tool to make sure we generate those + +# the first time get the content +email_digest_like( '--mode daily --print', qr/in the last day/ ); +# The second time run it for real so we make sure that we get RT to mark the txn as sent +email_digest_like( '--mode daily', qr/maildaily\@/ ); +# now we should have nothing to do, so no content. +email_digest_like( '--mode daily --print', '' ); + +# the first time get the content +email_digest_like( '--mode weekly --print', qr/in the last seven days/ ); +# The second time run it for real so we make sure that we get RT to mark the txn as sent +email_digest_like( '--mode weekly', qr/mailweekly\@/ ); +# now we should have nothing to do, so no content. +email_digest_like( '--mode weekly --print', '' ); + +sub email_digest_like { + my $arg = shift; + my $pattern = shift; + + local $Test::Builder::Level = $Test::Builder::Level + 1; + + my $perl = $^X . ' ' . join ' ', map { "-I$_" } @INC; + open my $digester, "-|", "$perl $RT::SbinPath/rt-email-digest $arg"; + my @results = <$digester>; + my $content = join '', @results; + if ( ref $pattern && ref $pattern eq 'Regexp' ) { + like($content, $pattern); + } + else { + is( $content, $pattern ); + } + close $digester; +} diff --git a/rt/t/mail/disposition-outgoing.t b/rt/t/mail/disposition-outgoing.t new file mode 100644 index 000000000..06295a09c --- /dev/null +++ b/rt/t/mail/disposition-outgoing.t @@ -0,0 +1,69 @@ +use strict; +use warnings; + +use RT::Test tests => undef; + +my $queue = RT::Test->load_or_create_queue( Name => 'General' ); +ok $queue->id, 'loaded queue'; + +my ($ok, $msg) = $queue->AddWatcher( + Type => 'AdminCc', + Email => 'test@example.com', +); +ok $ok, $msg; + +my $mail = <<'.'; +From: root@localhost +Subject: I like inline dispositions and I cannot lie +Content-type: multipart/related; boundary="foo" + +--foo +Content-type: text/plain; charset="UTF-8" + +ho hum just some text + +--foo +Content-type: text/x-patch; name="filename.patch" +Content-disposition: inline; filename="filename.patch" + +a fake patch + +--foo +. + +# inline +{ + my $rt = send_and_receive($mail); + like $rt, qr/Content-Disposition:\s*inline.+?filename\.patch/is, 'found inline disposition'; +} + +# attachment +{ + $mail =~ s/(?<=Content-disposition: )inline/attachment/i; + + my $rt = send_and_receive($mail); + like $rt, qr/Content-Disposition:\s*attachment.+?filename\.patch/is, 'found attachment disposition'; +} + +# no disposition +{ + $mail =~ s/^Content-disposition: .+?\n(?=\n)//ism; + + my $rt = send_and_receive($mail); + like $rt, qr/Content-Disposition:\s*inline.+?filename\.patch/is, 'found default (inline) disposition'; +} + +sub send_and_receive { + my $mail = shift; + my ($stat, $id) = RT::Test->send_via_mailgate($mail); + is( $stat >> 8, 0, "The mail gateway exited normally" ); + ok( $id, "created ticket" ); + + my @mails = RT::Test->fetch_caught_mails; + is @mails, 2, "got 2 outgoing emails"; + + # first is autoreply + pop @mails; +} + +done_testing; diff --git a/rt/t/mail/extractsubjecttag.t b/rt/t/mail/extractsubjecttag.t index fcaba8c98..e76da6f82 100644 --- a/rt/t/mail/extractsubjecttag.t +++ b/rt/t/mail/extractsubjecttag.t @@ -3,11 +3,7 @@ use strict; use warnings; use utf8; -use RT::Test tests => 14; - - -my ($baseurl, $m) = RT::Test->started_ok; -RT::Test->set_mail_catcher; +use RT::Test tests => 13; my $queue = RT::Test->load_or_create_queue( Name => 'Regression', @@ -17,7 +13,7 @@ my $queue = RT::Test->load_or_create_queue( my $subject_tag = 'Windows/Servers-Desktops'; ok $queue && $queue->id, 'loaded or created queue'; -diag "Set Subject Tag" if $ENV{'TEST_VERBOSE'}; +diag "Set Subject Tag"; { is(RT->System->SubjectTag($queue), undef, 'No Subject Tag yet'); my ($status, $msg) = $queue->SetSubjectTag( $subject_tag ); @@ -25,8 +21,8 @@ diag "Set Subject Tag" if $ENV{'TEST_VERBOSE'}; is(RT->System->SubjectTag($queue), $subject_tag, "Set Subject Tag to $subject_tag"); } -my $original_ticket = RT::Ticket->new( $RT::SystemUser ); -diag "Create a ticket and make sure it has the subject tag" if $ENV{'TEST_VERBOSE'}; +my $original_ticket = RT::Ticket->new( RT->SystemUser ); +diag "Create a ticket and make sure it has the subject tag"; { $original_ticket->Create( Queue => $queue->id, @@ -47,7 +43,7 @@ diag "Create a ticket and make sure it has the subject tag" if $ENV{'TEST_VERBOS } -diag "Test that a reply with a Subject Tag doesn't change the subject" if $ENV{'TEST_VERBOSE'}; +diag "Test that a reply with a Subject Tag doesn't change the subject"; { my $ticketid = $original_ticket->Id; my $text = <<EOF; @@ -61,13 +57,13 @@ EOF is ($status >> 8, 0, "The mail gateway exited normally"); is ($id, $ticketid, "Replied to ticket $id correctly"); - my $freshticket = RT::Ticket->new( $RT::SystemUser ); + my $freshticket = RT::Ticket->new( RT->SystemUser ); $freshticket->LoadById($id); is($original_ticket->Subject,$freshticket->Subject,'Stripped Queue Subject Tag correctly'); } -diag "Test that a reply with another RT's subject tag changes the subject" if $ENV{'TEST_VERBOSE'}; +diag "Test that a reply with another RT's subject tag changes the subject"; { my $ticketid = $original_ticket->Id; my $text = <<EOF; @@ -77,14 +73,14 @@ Subject: [$subject_tag #$ticketid] [remote-rt-system #79] test reply with subject tag and remote rt subject tag EOF - diag($text); my ($status, $id) = RT::Test->send_via_mailgate($text, queue => $queue->Name); is ($status >> 8, 0, "The mail gateway exited normally"); is ($id, $ticketid, "Replied to ticket $id correctly"); - my $freshticket = RT::Ticket->new( $RT::SystemUser ); + my $freshticket = RT::Ticket->new( RT->SystemUser ); $freshticket->LoadById($id); like($freshticket->Subject,qr/\[remote-rt-system #79\]/,"Kept remote rt's subject tag"); unlike($freshticket->Subject,qr/\[\Q$subject_tag\E #$ticketid\]/,'Stripped Queue Subject Tag correctly'); } + diff --git a/rt/t/mail/fake-sendmail b/rt/t/mail/fake-sendmail new file mode 100644 index 000000000..44c237746 --- /dev/null +++ b/rt/t/mail/fake-sendmail @@ -0,0 +1,27 @@ +#!/usr/bin/env perl + +# captures command line arguments so you can validate +# what is being generated in sendmailpipe + +use strict; +use warnings; + +die "No \$RT_MAILLOGFILE set in environment" + unless $ENV{RT_MAILLOGFILE}; +open LOG, ">", $ENV{RT_MAILLOGFILE} + or die "Can't write to $ENV{RT_MAILLOGFILE}: $!"; + +my $needs_newline; +for (@ARGV) { + if (/^-/) { + print LOG "\n" if $needs_newline++; + print LOG $_; + } else { + print LOG " $_"; + } +} +print LOG "\n"; + +1 while $_ = <STDIN>; + +exit 0; diff --git a/rt/t/mail/gateway.t b/rt/t/mail/gateway.t index d57b063a2..9f0e669a3 100644 --- a/rt/t/mail/gateway.t +++ b/rt/t/mail/gateway.t @@ -57,7 +57,7 @@ use strict; use warnings; -use RT::Test config => 'Set( $UnsafeEmailCommands, 1);', tests => 159; +use RT::Test config => 'Set( $UnsafeEmailCommands, 1);', tests => 221, actual_server => 1; my ($baseurl, $m) = RT::Test->started_ok; use RT::Tickets; @@ -70,7 +70,7 @@ use LWP::UserAgent; my $url = $m->rt_base_url; -diag "Make sure that when we call the mailgate without URL, it fails" if $ENV{'TEST_VERBOSE'}; +diag "Make sure that when we call the mailgate without URL, it fails"; { my $text = <<EOF; From: root\@localhost @@ -79,12 +79,13 @@ Subject: This is a test of new ticket creation Foob! EOF - my ($status, $id) = RT::Test->send_via_mailgate($text, url => undef); + my ($status, $id) = RT::Test->send_via_mailgate_and_http($text, url => undef); is ($status >> 8, 1, "The mail gateway exited with a failure"); ok (!$id, "No ticket id") or diag "by mistake ticket #$id"; + $m->no_warnings_ok; } -diag "Make sure that when we call the mailgate with wrong URL, it tempfails" if $ENV{'TEST_VERBOSE'}; +diag "Make sure that when we call the mailgate with wrong URL, it tempfails"; { my $text = <<EOF; From: root\@localhost @@ -93,15 +94,16 @@ Subject: This is a test of new ticket creation Foob! EOF - my ($status, $id) = RT::Test->send_via_mailgate($text, url => 'http://this.test.for.non-connection.is.expected.to.generate.an.error'); + my ($status, $id) = RT::Test->send_via_mailgate_and_http($text, url => 'http://this.test.for.non-connection.is.expected.to.generate.an.error'); is ($status >> 8, 75, "The mail gateway exited with a failure"); ok (!$id, "No ticket id"); + $m->no_warnings_ok; } my $everyone_group; -diag "revoke rights tests depend on" if $ENV{'TEST_VERBOSE'}; +diag "revoke rights tests depend on"; { - $everyone_group = RT::Group->new( $RT::SystemUser ); + $everyone_group = RT::Group->new( RT->SystemUser ); $everyone_group->LoadSystemInternalGroup( 'Everyone' ); ok ($everyone_group->Id, "Found group 'everyone'"); @@ -110,7 +112,7 @@ diag "revoke rights tests depend on" if $ENV{'TEST_VERBOSE'}; } } -diag "Test new ticket creation by root who is privileged and superuser" if $ENV{'TEST_VERBOSE'}; +diag "Test new ticket creation by root who is privileged and superuser"; { my $text = <<EOF; From: root\@localhost @@ -121,7 +123,7 @@ Blah! Foob! EOF - my ($status, $id) = RT::Test->send_via_mailgate($text); + my ($status, $id) = RT::Test->send_via_mailgate_and_http($text); is ($status >> 8, 0, "The mail gateway exited normally"); ok ($id, "Created ticket"); @@ -129,9 +131,10 @@ EOF isa_ok ($tick, 'RT::Ticket'); is ($tick->Id, $id, "correct ticket id"); is ($tick->Subject , 'This is a test of new ticket creation', "Created the ticket"); + $m->no_warnings_ok; } -diag "Test the 'X-RT-Mail-Extension' field in the header of a ticket" if $ENV{'TEST_VERBOSE'}; +diag "Test the 'X-RT-Mail-Extension' field in the header of a ticket"; { my $text = <<EOF; From: root\@localhost @@ -141,7 +144,7 @@ Blah! Foob! EOF local $ENV{'EXTENSION'} = "bad value with\nnewlines\n"; - my ($status, $id) = RT::Test->send_via_mailgate($text); + my ($status, $id) = RT::Test->send_via_mailgate_and_http($text); is ($status >> 8, 0, "The mail gateway exited normally"); ok ($id, "Created ticket #$id"); @@ -165,9 +168,10 @@ EOF "bad value with newlines", 'header is in place, without trailing newline char' ); + $m->no_warnings_ok; } -diag "Make sure that not standard --extension is passed" if $ENV{'TEST_VERBOSE'}; +diag "Make sure that not standard --extension is passed"; { my $text = <<EOF; From: root\@localhost @@ -176,7 +180,7 @@ Subject: This is a test of new ticket creation Foob! EOF - my ($status, $id) = RT::Test->send_via_mailgate($text, extension => 'some-extension-arg' ); + my ($status, $id) = RT::Test->send_via_mailgate_and_http($text, extension => 'some-extension-arg' ); is ($status >> 8, 0, "The mail gateway exited normally"); ok ($id, "Created ticket #$id"); @@ -198,9 +202,10 @@ EOF 'some-extension-arg', 'header is in place' ); + $m->no_warnings_ok; } -diag "Test new ticket creation without --action argument" if $ENV{'TEST_VERBOSE'}; +diag "Test new ticket creation without --action argument"; { my $text = <<EOF; From: root\@localhost @@ -210,7 +215,7 @@ Subject: using mailgate without --action arg Blah! Foob! EOF - my ($status, $id) = RT::Test->send_via_mailgate($text, extension => 'some-extension-arg' ); + my ($status, $id) = RT::Test->send_via_mailgate_and_http($text, extension => 'some-extension-arg' ); is ($status >> 8, 0, "The mail gateway exited normally"); ok ($id, "Created ticket #$id"); @@ -218,9 +223,10 @@ EOF isa_ok ($tick, 'RT::Ticket'); is ($tick->Id, $id, "correct ticket id"); is ($tick->Subject, 'using mailgate without --action arg', "using mailgate without --action arg"); + $m->no_warnings_ok; } -diag "This is a test of new ticket creation as an unknown user" if $ENV{'TEST_VERBOSE'}; +diag "This is a test of new ticket creation as an unknown user"; { my $text = <<EOF; From: doesnotexist\@@{[RT->Config->Get('rtname')]} @@ -230,7 +236,7 @@ Subject: This is a test of new ticket creation as an unknown user Blah! Foob! EOF - my ($status, $id) = RT::Test->send_via_mailgate($text); + my ($status, $id) = RT::Test->send_via_mailgate_and_http($text); is ($status >> 8, 0, "The mail gateway exited normally"); ok (!$id, "no ticket created"); @@ -239,12 +245,19 @@ EOF ok ($tick->Id, "found ticket ".$tick->Id); isnt ($tick->Subject , 'This is a test of new ticket creation as an unknown user', "failed to create the new ticket from an unprivileged account"); - my $u = RT::User->new($RT::SystemUser); + my $u = RT::User->new(RT->SystemUser); $u->Load("doesnotexist\@@{[RT->Config->Get('rtname')]}"); ok( !$u->Id, "user does not exist and was not created by failed ticket submission"); + + $m->next_warning_like(qr/RT's configuration does not allow\s+for the creation of a new user for this email/); + $m->next_warning_like(qr/RT could not load a valid user/); + TODO: { + local $TODO = "we're a bit noisy for this warning case"; + $m->no_leftover_warnings_ok; + } } -diag "grant everybody with CreateTicket right" if $ENV{'TEST_VERBOSE'}; +diag "grant everybody with CreateTicket right"; { ok( RT::Test->set_rights( { Principal => $everyone_group->PrincipalObj, @@ -254,7 +267,7 @@ diag "grant everybody with CreateTicket right" if $ENV{'TEST_VERBOSE'}; } my $ticket_id; -diag "now everybody can create tickets. can a random unkown user create tickets?" if $ENV{'TEST_VERBOSE'}; +diag "now everybody can create tickets. can a random unkown user create tickets?"; { my $text = <<EOF; From: doesnotexist\@@{[RT->Config->Get('rtname')]} @@ -264,7 +277,7 @@ Subject: This is a test of new ticket creation as an unknown user Blah! Foob! EOF - my ($status, $id) = RT::Test->send_via_mailgate($text); + my ($status, $id) = RT::Test->send_via_mailgate_and_http($text); is ($status >> 8, 0, "The mail gateway exited normally"); ok ($id, "ticket created"); @@ -274,13 +287,14 @@ EOF is ($tick->Id, $id, "correct ticket id"); is ($tick->Subject , 'This is a test of new ticket creation as an unknown user', "failed to create the new ticket from an unprivileged account"); - my $u = RT::User->new( $RT::SystemUser ); + my $u = RT::User->new( RT->SystemUser ); $u->Load( "doesnotexist\@@{[RT->Config->Get('rtname')]}" ); ok ($u->Id, "user does not exist and was created by ticket submission"); $ticket_id = $id; + $m->no_warnings_ok; } -diag "can another random reply to a ticket without being granted privs? answer should be no." if $ENV{'TEST_VERBOSE'}; +diag "can another random reply to a ticket without being granted privs? answer should be no."; { my $text = <<EOF; From: doesnotexist-2\@@{[RT->Config->Get('rtname')]} @@ -290,16 +304,21 @@ Subject: [@{[RT->Config->Get('rtname')]} #$ticket_id] This is a test of a reply Blah! (Should not work.) Foob! EOF - my ($status, $id) = RT::Test->send_via_mailgate($text); + my ($status, $id) = RT::Test->send_via_mailgate_and_http($text); is ($status >> 8, 0, "The mail gateway exited normally"); ok (!$id, "no way to reply to the ticket"); - my $u = RT::User->new($RT::SystemUser); + my $u = RT::User->new(RT->SystemUser); $u->Load('doesnotexist-2@'.RT->Config->Get('rtname')); ok( !$u->Id, " user does not exist and was not created by ticket correspondence submission"); + $m->next_warning_like(qr/RT's configuration does not allow\s+for the creation of a new user for this email \(doesnotexist-2\@example\.com\)/); + TODO: { + local $TODO = "we're a bit noisy for this warning case"; + $m->no_leftover_warnings_ok; + } } -diag "grant everyone 'ReplyToTicket' right" if $ENV{'TEST_VERBOSE'}; +diag "grant everyone 'ReplyToTicket' right"; { ok( RT::Test->set_rights( { Principal => $everyone_group->PrincipalObj, @@ -308,7 +327,7 @@ diag "grant everyone 'ReplyToTicket' right" if $ENV{'TEST_VERBOSE'}; ), "Granted everybody the right to reply to tickets" ); } -diag "can another random reply to a ticket after being granted privs? answer should be yes" if $ENV{'TEST_VERBOSE'}; +diag "can another random reply to a ticket after being granted privs? answer should be yes"; { my $text = <<EOF; From: doesnotexist-2\@@{[RT->Config->Get('rtname')]} @@ -318,16 +337,17 @@ Subject: [@{[RT->Config->Get('rtname')]} #$ticket_id] This is a test of a reply Blah! Foob! EOF - my ($status, $id) = RT::Test->send_via_mailgate($text); + my ($status, $id) = RT::Test->send_via_mailgate_and_http($text); is ($status >> 8, 0, "The mail gateway exited normally"); is ($id, $ticket_id, "replied to the ticket"); - my $u = RT::User->new($RT::SystemUser); + my $u = RT::User->new(RT->SystemUser); $u->Load('doesnotexist-2@'.RT->Config->Get('rtname')); ok ($u->Id, "user exists and was created by ticket correspondence submission"); + $m->no_warnings_ok; } -diag "add a reply to the ticket using '--extension ticket' feature" if $ENV{'TEST_VERBOSE'}; +diag "add a reply to the ticket using '--extension ticket' feature"; { my $text = <<EOF; From: doesnotexist-2\@@{[RT->Config->Get('rtname')]} @@ -338,7 +358,7 @@ Blah! Foob! EOF local $ENV{'EXTENSION'} = $ticket_id; - my ($status, $id) = RT::Test->send_via_mailgate($text, extension => 'ticket'); + my ($status, $id) = RT::Test->send_via_mailgate_and_http($text, extension => 'ticket'); is ($status >> 8, 0, "The mail gateway exited normally"); is ($id, $ticket_id, "replied to the ticket"); @@ -357,9 +377,10 @@ EOF my $attachment = $txn->Attachments->First; isa_ok ($attachment, 'RT::Attachment'); is ($attachment->GetHeader('X-RT-Mail-Extension'), $id, 'header is in place'); + $m->no_warnings_ok; } -diag "can another random comment on a ticket without being granted privs? answer should be no" if $ENV{'TEST_VERBOSE'}; +diag "can another random comment on a ticket without being granted privs? answer should be no"; { my $text = <<EOF; From: doesnotexist-3\@@{[RT->Config->Get('rtname')]} @@ -369,17 +390,22 @@ Subject: [@{[RT->Config->Get('rtname')]} #$ticket_id] This is a test of a commen Blah! (Should not work.) Foob! EOF - my ($status, $id) = RT::Test->send_via_mailgate($text, action => 'comment'); + my ($status, $id) = RT::Test->send_via_mailgate_and_http($text, action => 'comment'); is ($status >> 8, 0, "The mail gateway exited normally"); ok (!$id, "no way to comment on the ticket"); - my $u = RT::User->new($RT::SystemUser); + my $u = RT::User->new(RT->SystemUser); $u->Load('doesnotexist-3@'.RT->Config->Get('rtname')); ok( !$u->Id, " user does not exist and was not created by ticket comment submission"); + $m->next_warning_like(qr/RT's configuration does not allow\s+for the creation of a new user for this email \(doesnotexist-3\@example\.com\)/); + TODO: { + local $TODO = "we're a bit noisy for this warning case"; + $m->no_leftover_warnings_ok; + } } -diag "grant everyone 'CommentOnTicket' right" if $ENV{'TEST_VERBOSE'}; +diag "grant everyone 'CommentOnTicket' right"; { ok( RT::Test->set_rights( { Principal => $everyone_group->PrincipalObj, @@ -388,7 +414,7 @@ diag "grant everyone 'CommentOnTicket' right" if $ENV{'TEST_VERBOSE'}; ), "Granted everybody the right to comment on tickets"); } -diag "can another random reply to a ticket after being granted privs? answer should be yes" if $ENV{'TEST_VERBOSE'}; +diag "can another random reply to a ticket after being granted privs? answer should be yes"; { my $text = <<EOF; From: doesnotexist-3\@@{[RT->Config->Get('rtname')]} @@ -398,16 +424,17 @@ Subject: [@{[RT->Config->Get('rtname')]} #$ticket_id] This is a test of a commen Blah! Foob! EOF - my ($status, $id) = RT::Test->send_via_mailgate($text, action => 'comment'); + my ($status, $id) = RT::Test->send_via_mailgate_and_http($text, action => 'comment'); is ($status >> 8, 0, "The mail gateway exited normally"); is ($id, $ticket_id, "replied to the ticket"); - my $u = RT::User->new($RT::SystemUser); + my $u = RT::User->new(RT->SystemUser); $u->Load('doesnotexist-3@'.RT->Config->Get('rtname')); ok ($u->Id, " user exists and was created by ticket comment submission"); + $m->no_warnings_ok; } -diag "add comment to the ticket using '--extension action' feature" if $ENV{'TEST_VERBOSE'}; +diag "add comment to the ticket using '--extension action' feature"; { my $text = <<EOF; From: doesnotexist-3\@@{[RT->Config->Get('rtname')]} @@ -418,7 +445,7 @@ Blah! Foob! EOF local $ENV{'EXTENSION'} = 'comment'; - my ($status, $id) = RT::Test->send_via_mailgate($text, extension => 'action'); + my ($status, $id) = RT::Test->send_via_mailgate_and_http($text, extension => 'action'); is ($status >> 8, 0, "The mail gateway exited normally"); is ($id, $ticket_id, "added comment to the ticket"); @@ -442,12 +469,13 @@ EOF my $attachment = $txn->Attachments->First; isa_ok ($attachment, 'RT::Attachment'); is ($attachment->GetHeader('X-RT-Mail-Extension'), 'comment', 'header is in place'); + $m->no_warnings_ok; } -diag "Testing preservation of binary attachments" if $ENV{'TEST_VERBOSE'}; +diag "Testing preservation of binary attachments"; { # Get a binary blob (Best Practical logo) - my $LOGO_FILE = $RT::MasonComponentRoot .'/NoAuth/images/bplogo.gif'; + my $LOGO_FILE = $RT::MasonComponentRoot .'/NoAuth/images/bpslogo.png'; # Create a mime entity with an attachment my $entity = MIME::Entity->build( @@ -459,11 +487,11 @@ diag "Testing preservation of binary attachments" if $ENV{'TEST_VERBOSE'}; $entity->attach( Path => $LOGO_FILE, - Type => 'image/gif', + Type => 'image/png', Encoding => 'base64', ); # Create a ticket with a binary attachment - my ($status, $id) = RT::Test->send_via_mailgate($entity); + my ($status, $id) = RT::Test->send_via_mailgate_and_http($entity); is ($status >> 8, 0, "The mail gateway exited normally"); ok ($id, "created ticket"); @@ -475,11 +503,11 @@ diag "Testing preservation of binary attachments" if $ENV{'TEST_VERBOSE'}; my $file = `cat $LOGO_FILE`; ok ($file, "Read in the logo image"); - diag "for the raw file the md5 hex is ". Digest::MD5::md5_hex($file) if $ENV{'TEST_VERBOSE'}; + diag "for the raw file the md5 hex is ". Digest::MD5::md5_hex($file); # Verify that the binary attachment is valid in the database - my $attachments = RT::Attachments->new($RT::SystemUser); - $attachments->Limit(FIELD => 'ContentType', VALUE => 'image/gif'); + my $attachments = RT::Attachments->new(RT->SystemUser); + $attachments->Limit(FIELD => 'ContentType', VALUE => 'image/png'); my $txn_alias = $attachments->Join( ALIAS1 => 'main', FIELD1 => 'TransactionId', @@ -488,25 +516,27 @@ diag "Testing preservation of binary attachments" if $ENV{'TEST_VERBOSE'}; ); $attachments->Limit( ALIAS => $txn_alias, FIELD => 'ObjectType', VALUE => 'RT::Ticket' ); $attachments->Limit( ALIAS => $txn_alias, FIELD => 'ObjectId', VALUE => $id ); - is ($attachments->Count, 1, 'Found only one gif attached to the ticket'); + is ($attachments->Count, 1, 'Found only one png attached to the ticket'); my $attachment = $attachments->First; ok ($attachment->Id, 'loaded attachment object'); my $acontent = $attachment->Content; - diag "coming from the database, md5 hex is ".Digest::MD5::md5_hex($acontent) if $ENV{'TEST_VERBOSE'}; + diag "coming from the database, md5 hex is ".Digest::MD5::md5_hex($acontent); is ($acontent, $file, 'The attachment isn\'t screwed up in the database.'); # Grab the binary attachment via the web ui my $ua = new LWP::UserAgent; my $full_url = "$url/Ticket/Attachment/". $attachment->TransactionId - ."/". $attachment->id. "/bplogo.gif?&user=root&pass=password"; + ."/". $attachment->id. "/bpslogo.png?&user=root&pass=password"; my $r = $ua->get( $full_url ); # Verify that the downloaded attachment is the same as what we uploaded. is ($file, $r->content, 'The attachment isn\'t screwed up in download'); + + $m->no_warnings_ok; } -diag "Simple I18N testing" if $ENV{'TEST_VERBOSE'}; +diag "Simple I18N testing"; { my $text = <<EOF; From: root\@localhost @@ -519,7 +549,7 @@ Content-Type: text/plain; charset="utf-8" \303\241\303\251\303\255\303\263\303\272 bye EOF - my ($status, $id) = RT::Test->send_via_mailgate($text); + my ($status, $id) = RT::Test->send_via_mailgate_and_http($text); is ($status >> 8, 0, "The mail gateway exited normally"); ok ($id, "created ticket"); @@ -540,9 +570,11 @@ EOF $tick->Transactions->First->Content =~ /$unistring/i, $tick->Id." appears to be unicode ". $tick->Transactions->First->Attachments->First->Id ); + + $m->no_warnings_ok; } -diag "supposedly I18N fails on the second message sent in." if $ENV{'TEST_VERBOSE'}; +diag "supposedly I18N fails on the second message sent in."; { my $text = <<EOF; From: root\@localhost @@ -555,7 +587,7 @@ Content-Type: text/plain; charset="utf-8" \303\241\303\251\303\255\303\263\303\272 bye EOF - my ($status, $id) = RT::Test->send_via_mailgate($text); + my ($status, $id) = RT::Test->send_via_mailgate_and_http($text); is ($status >> 8, 0, "The mail gateway exited normally"); ok ($id, "created ticket"); @@ -572,9 +604,11 @@ EOF $tick->Transactions->First->Content =~ $unistring, "It appears to be unicode - ". $tick->Transactions->First->Content ); + + $m->no_warnings_ok; } -diag "check that mailgate doesn't suffer from empty Reply-To:" if $ENV{'TEST_VERBOSE'}; +diag "check that mailgate doesn't suffer from empty Reply-To:"; { my $text = <<EOF; From: root\@localhost @@ -585,7 +619,7 @@ Content-Type: text/plain; charset="utf-8" test EOF - my ($status, $id) = RT::Test->send_via_mailgate($text); + my ($status, $id) = RT::Test->send_via_mailgate_and_http($text); is ($status >> 8, 0, "The mail gateway exited normally"); ok ($id, "created ticket"); @@ -595,6 +629,8 @@ EOF is ($tick->Id, $id, "correct ticket"); like $tick->RequestorAddresses, qr/root\@localhost/, 'correct requestor'; + + $m->no_warnings_ok; } @@ -607,18 +643,17 @@ skip "Advanced mailgate actions require an unsafe configuration", 47 # create new queue to be shure we don't mess with rights use RT::Queue; -my $queue = RT::Queue->new($RT::SystemUser); +my $queue = RT::Queue->new(RT->SystemUser); my ($qid) = $queue->Create( Name => 'ext-mailgate'); ok( $qid, 'queue created for ext-mailgate tests' ); -# {{{ Check take and resolve actions # create ticket that is owned by nobody use RT::Ticket; -my $tick = RT::Ticket->new($RT::SystemUser); +my $tick = RT::Ticket->new(RT->SystemUser); my ($id) = $tick->Create( Queue => 'ext-mailgate', Subject => 'test'); ok( $id, 'new ticket created' ); -is( $tick->Owner, $RT::Nobody->Id, 'owner of the new ticket is nobody' ); +is( $tick->Owner, RT->Nobody->Id, 'owner of the new ticket is nobody' ); $! = 0; ok(open(MAIL, '|-', "$RT::BinPath/rt-mailgate --url $url --queue ext-mailgate --action take"), "Opened the mailgate - $!"); @@ -630,7 +665,7 @@ EOF close (MAIL); is ($? >> 8, 0, "The mail gateway exited normally"); -$tick = RT::Ticket->new($RT::SystemUser); +$tick = RT::Ticket->new(RT->SystemUser); $tick->Load( $id ); is( $tick->Id, $id, 'load correct ticket'); is( $tick->OwnerObj->EmailAddress, 'root@localhost', 'successfuly take ticket via email'); @@ -639,9 +674,11 @@ is( $tick->OwnerObj->EmailAddress, 'root@localhost', 'successfuly take ticket vi is( $tick->Transactions->Count, 2, 'no superfluous transactions'); my $status; -($status, $msg) = $tick->SetOwner( $RT::Nobody->Id, 'Force' ); +($status, $msg) = $tick->SetOwner( RT->Nobody->Id, 'Force' ); ok( $status, 'successfuly changed owner: '. ($msg||'') ); -is( $tick->Owner, $RT::Nobody->Id, 'set owner back to nobody'); +is( $tick->Owner, RT->Nobody->Id, 'set owner back to nobody'); + +$m->no_warnings_ok; $! = 0; @@ -657,7 +694,7 @@ is ($? >> 8, 0, "The mail gateway exited normally"); DBIx::SearchBuilder::Record::Cachable->FlushCache; -$tick = RT::Ticket->new($RT::SystemUser); +$tick = RT::Ticket->new(RT->SystemUser); $tick->Load( $id ); is( $tick->Id, $id, "load correct ticket #$id"); is( $tick->OwnerObj->EmailAddress, 'root@localhost', 'successfuly take ticket via email'); @@ -668,6 +705,9 @@ $txns->OrderBy( FIELD => 'id', ORDER => 'DESC' ); is( $tick->Transactions->Count, 6, 'no superfluous transactions'); is( $txns->First->Subject, "[$RT::rtname \#$id] correspondence", 'successfuly add correspond within take via email' ); +$m->no_warnings_ok; + + $! = 0; ok(open(MAIL, '|-', "$RT::BinPath/rt-mailgate --url $url --queue ext-mailgate --action resolve"), "Opened the mailgate - $!"); print MAIL <<EOF; @@ -680,14 +720,14 @@ is ($? >> 8, 0, "The mail gateway exited normally"); DBIx::SearchBuilder::Record::Cachable->FlushCache; -$tick = RT::Ticket->new($RT::SystemUser); +$tick = RT::Ticket->new(RT->SystemUser); $tick->Load( $id ); is( $tick->Id, $id, 'load correct ticket'); is( $tick->Status, 'resolved', 'successfuly resolved ticket via email'); is( $tick->Transactions->Count, 7, 'no superfluous transactions'); use RT::User; -my $user = RT::User->new( $RT::SystemUser ); +my $user = RT::User->new( RT->SystemUser ); my ($uid) = $user->Create( Name => 'ext-mailgate', EmailAddress => 'ext-mailgate@localhost', Privileged => 1, @@ -696,12 +736,14 @@ my ($uid) = $user->Create( Name => 'ext-mailgate', ok( $uid, 'user created for ext-mailgate tests' ); ok( !$user->HasRight( Right => 'OwnTicket', Object => $queue ), "User can't own ticket" ); -$tick = RT::Ticket->new($RT::SystemUser); +$tick = RT::Ticket->new(RT->SystemUser); ($id) = $tick->Create( Queue => $qid, Subject => 'test' ); ok( $id, 'create new ticket' ); my $rtname = RT->Config->Get('rtname'); +$m->no_warnings_ok; + $! = 0; ok(open(MAIL, '|-', "$RT::BinPath/rt-mailgate --url $url --queue ext-mailgate --action take"), "Opened the mailgate - $!"); print MAIL <<EOF; @@ -720,6 +762,10 @@ ok( $status, "successfuly granted right: $msg" ); my $ace_id = $status; ok( $user->HasRight( Right => 'ReplyToTicket', Object => $tick ), "User can reply to ticket" ); +$m->next_warning_like(qr/Permission Denied/); +$m->next_warning_like(qr/Could not record email: Ticket not taken/); +$m->no_leftover_warnings_ok; + $! = 0; ok(open(MAIL, '|-', "$RT::BinPath/rt-mailgate --url $url --queue ext-mailgate --action correspond-take"), "Opened the mailgate - $!"); print MAIL <<EOF; @@ -735,6 +781,10 @@ DBIx::SearchBuilder::Record::Cachable->FlushCache; cmp_ok( $tick->Owner, '!=', $user->id, "we didn't change owner" ); is( $tick->Transactions->Count, 3, "one transactions added" ); +$m->next_warning_like(qr/Permission Denied/); +$m->next_warning_like(qr/Could not record email: Ticket not taken/); +$m->no_leftover_warnings_ok; + $! = 0; ok(open(MAIL, '|-', "$RT::BinPath/rt-mailgate --url $url --queue ext-mailgate --action take-correspond"), "Opened the mailgate - $!"); print MAIL <<EOF; @@ -750,12 +800,16 @@ DBIx::SearchBuilder::Record::Cachable->FlushCache; cmp_ok( $tick->Owner, '!=', $user->id, "we didn't change owner" ); is( $tick->Transactions->Count, 3, "no transactions added, user can't take ticket first" ); +$m->next_warning_like(qr/Permission Denied/); +$m->next_warning_like(qr/Could not record email: Ticket not taken/); +$m->no_leftover_warnings_ok; + # revoke ReplyToTicket right use RT::ACE; -my $ace = RT::ACE->new($RT::SystemUser); +my $ace = RT::ACE->new(RT->SystemUser); $ace->Load( $ace_id ); $ace->Delete; -my $acl = RT::ACL->new($RT::SystemUser); +my $acl = RT::ACL->new(RT->SystemUser); $acl->Limit( FIELD => 'RightName', VALUE => 'ReplyToTicket' ); $acl->LimitToObject( $RT::System ); while( my $ace = $acl->Next ) { @@ -765,9 +819,9 @@ while( my $ace = $acl->Next ) { ok( !$user->HasRight( Right => 'ReplyToTicket', Object => $tick ), "User can't reply to ticket any more" ); -my $group = RT::Group->new( $RT::SystemUser ); +my $group = RT::Group->new( RT->SystemUser ); ok( $group->LoadQueueRoleGroup( Queue => $qid, Type=> 'Owner' ), "load queue owners role group" ); -$ace = RT::ACE->new( $RT::SystemUser ); +$ace = RT::ACE->new( RT->SystemUser ); ($ace_id, $msg) = $group->PrincipalObj->GrantRight( Right => 'ReplyToTicket', Object => $queue ); ok( $ace_id, "Granted queue owners role group with ReplyToTicket right" ); @@ -793,10 +847,7 @@ is( $tick->Owner, $user->id, "we changed owner" ); ok( $user->HasRight( Right => 'ReplyToTicket', Object => $tick ), "owner can reply to ticket" ); is( $tick->Transactions->Count, 5, "transactions added" ); +$m->no_warnings_ok; -# }}} }; - -1; - diff --git a/rt/t/mail/gnupg-bad.t b/rt/t/mail/gnupg-bad.t index 2d8e03575..c9b28c902 100644 --- a/rt/t/mail/gnupg-bad.t +++ b/rt/t/mail/gnupg-bad.t @@ -2,57 +2,43 @@ use strict; use warnings; -use RT::Test tests => 6; - -plan skip_all => 'GnuPG required.' - unless eval 'use GnuPG::Interface; 1'; -plan skip_all => 'gpg executable is required.' - unless RT::Test->find_executable('gpg'); - - -use Cwd 'getcwd'; - -my $homedir = RT::Test::get_abs_relocatable_dir(File::Spec->updir(), - qw(data gnupg keyrings)); - -RT->Config->Set( 'GnuPG', - Enable => 1, - OutgoingMessagesFormat => 'RFC' ); - -RT->Config->Set( 'GnuPGOptions', - homedir => $homedir, - passphrase => 'test', - 'no-permission-warning' => undef); +use RT::Test::GnuPG + tests => 7, + gnupg_options => { + passphrase => 'rt-test', + homedir => RT::Test::get_abs_relocatable_dir( + File::Spec->updir(), qw/data gnupg keyrings/ + ), + }; RT->Config->Set( 'MailPlugins' => 'Auth::MailFrom', 'Auth::GnuPG' ); my ($baseurl, $m) = RT::Test->started_ok; -$m->get( $baseurl."?user=root;pass=password" ); -$m->content_like(qr/Logout/, 'we did log in'); +$m->login; $m->get( $baseurl.'/Admin/Queues/'); $m->follow_link_ok( {text => 'General'} ); $m->submit_form( form_number => 3, fields => { CorrespondAddress => 'rt@example.com' } ); $m->content_like(qr/rt\@example.com.* - never/, 'has key info.'); -ok(my $user = RT::User->new($RT::SystemUser)); +ok(my $user = RT::User->new(RT->SystemUser)); ok($user->Load('root'), "Loaded user 'root'"); $user->SetEmailAddress('rt@example.com'); if (0) { # XXX: need to generate these mails - diag "no signature" if $ENV{TEST_VERBOSE}; - diag "no encryption on encrypted queue" if $ENV{TEST_VERBOSE}; - diag "mismatched signature" if $ENV{TEST_VERBOSE}; - diag "unknown public key" if $ENV{TEST_VERBOSE}; - diag "unknown private key" if $ENV{TEST_VERBOSE}; - diag "signer != sender" if $ENV{TEST_VERBOSE}; - diag "encryption to user whose pubkey is not signed" if $ENV{TEST_VERBOSE}; - diag "no encryption of attachment on encrypted queue" if $ENV{TEST_VERBOSE}; - diag "no signature of attachment" if $ENV{TEST_VERBOSE}; - diag "revoked key" if $ENV{TEST_VERBOSE}; - diag "expired key" if $ENV{TEST_VERBOSE}; - diag "unknown algorithm" if $ENV{TEST_VERBOSE}; + diag "no signature"; + diag "no encryption on encrypted queue"; + diag "mismatched signature"; + diag "unknown public key"; + diag "unknown private key"; + diag "signer != sender"; + diag "encryption to user whose pubkey is not signed"; + diag "no encryption of attachment on encrypted queue"; + diag "no signature of attachment"; + diag "revoked key"; + diag "expired key"; + diag "unknown algorithm"; } diff --git a/rt/t/mail/gnupg-incoming.t b/rt/t/mail/gnupg-incoming.t index 230aa9c58..e591add6c 100644 --- a/rt/t/mail/gnupg-incoming.t +++ b/rt/t/mail/gnupg-incoming.t @@ -2,35 +2,25 @@ use strict; use warnings; -use RT::Test tests => 39; - -plan skip_all => 'GnuPG required.' - unless eval 'use GnuPG::Interface; 1'; -plan skip_all => 'gpg executable is required.' - unless RT::Test->find_executable('gpg'); +my $homedir; +BEGIN { + require RT::Test; + $homedir = + RT::Test::get_abs_relocatable_dir( File::Spec->updir(), + qw/data gnupg keyrings/ ); +} +use RT::Test::GnuPG + tests => 41, + actual_server => 1, + gnupg_options => { + passphrase => 'rt-test', + homedir => $homedir, + }; -use File::Temp; -use Cwd 'getcwd'; use String::ShellQuote 'shell_quote'; use IPC::Run3 'run3'; -my $homedir = RT::Test::get_abs_relocatable_dir(File::Spec->updir(), - qw(data gnupg keyrings)); - -# catch any outgoing emails -RT::Test->set_mail_catcher; - -RT->Config->Set( 'GnuPG', - Enable => 1, - OutgoingMessagesFormat => 'RFC' ); - -RT->Config->Set( 'GnuPGOptions', - homedir => $homedir, - 'no-permission-warning' => undef); - -RT->Config->Set( 'MailPlugins' => 'Auth::MailFrom', 'Auth::GnuPG' ); - my ($baseurl, $m) = RT::Test->started_ok; # configure key for General queue @@ -41,7 +31,7 @@ $m->submit_form( form_number => 3, fields => { CorrespondAddress => 'general@example.com' } ); $m->content_like(qr/general\@example.com.* - never/, 'has key info.'); -ok(my $user = RT::User->new($RT::SystemUser)); +ok(my $user = RT::User->new(RT->SystemUser)); ok($user->Load('root'), "Loaded user 'root'"); $user->SetEmailAddress('recipient@example.com'); @@ -71,7 +61,7 @@ RT::Test->close_mailgate_ok($mail); qr/^X-RT-Incoming-Encryption: Not encrypted/m, 'recorded incoming mail that is not encrypted' ); - like( $txn->Attachments->First->Content, qr'Blah'); + like( $txn->Attachments->First->Content, qr/Blah/); } # test for signed mail @@ -79,7 +69,7 @@ my $buf = ''; run3( shell_quote( - qw(gpg --armor --sign), + qw(gpg --batch --no-tty --armor --sign), '--default-key' => 'recipient@example.com', '--homedir' => $homedir, '--passphrase' => 'recipient', @@ -113,7 +103,7 @@ RT::Test->close_mailgate_ok($mail); 'recorded incoming mail that is encrypted' ); # test for some kind of PGP-Signed-By: Header - like( $attach->Content, qr'fnord'); + like( $attach->Content, qr/fnord/); } # test for clear-signed mail @@ -121,7 +111,7 @@ $buf = ''; run3( shell_quote( - qw(gpg --armor --sign --clearsign), + qw(gpg --batch --no-tty --armor --sign --clearsign), '--default-key' => 'recipient@example.com', '--homedir' => $homedir, '--passphrase' => 'recipient', @@ -154,7 +144,7 @@ RT::Test->close_mailgate_ok($mail); 'recorded incoming mail that is encrypted' ); # test for some kind of PGP-Signed-By: Header - like( $attach->Content, qr'clearfnord'); + like( $attach->Content, qr/clearfnord/); } # test for signed and encrypted mail @@ -162,7 +152,7 @@ $buf = ''; run3( shell_quote( - qw(gpg --encrypt --armor --sign), + qw(gpg --batch --no-tty --encrypt --armor --sign), '--recipient' => 'general@example.com', '--default-key' => 'recipient@example.com', '--homedir' => $homedir, @@ -200,7 +190,7 @@ RT::Test->close_mailgate_ok($mail); 'PGP', 'recorded incoming mail that is encrypted' ); - like( $attach->Content, qr'orz'); + like( $attach->Content, qr/orz/); is( $orig->GetHeader('Content-Type'), 'application/x-rt-original-message'); ok(index($orig->Content, $buf) != -1, 'found original msg'); @@ -211,7 +201,7 @@ $buf = ''; run3( shell_quote( - qw(gpg --armor --sign), + qw(gpg --batch --no-tty --armor --sign), '--default-key' => 'rt@example.com', '--homedir' => $homedir, '--passphrase' => 'test', @@ -247,7 +237,7 @@ $buf = ''; run3( shell_quote( - qw(gpg --armor --encrypt), + qw(gpg --batch --no-tty --armor --encrypt), '--recipient' => 'random@localhost', '--homedir' => $homedir, ), @@ -274,7 +264,7 @@ RT::Test->close_mailgate_ok($mail); TODO: { local $TODO = "this test requires keys associated with queues"; - unlike( $attach->Content, qr'should not be there either'); + unlike( $attach->Content, qr/should not be there either/); } } @@ -284,7 +274,7 @@ $buf = ''; run3( shell_quote( - qw(gpg --armor --encrypt), + qw(gpg --batch --no-tty --armor --encrypt), '--recipient' => 'rt@example.com', '--homedir' => $homedir, ), @@ -314,6 +304,6 @@ is(@mail, 1, 'caught outgoing mail.'); my $tick = RT::Test->last_ticket; my $txn = $tick->Transactions->First; my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef}; - unlike( ($attach ? $attach->Content : ''), qr'really should not be there either'); + unlike( ($attach ? $attach->Content : ''), qr/really should not be there either/); } diff --git a/rt/t/mail/gnupg-outgoing-encrypted.t b/rt/t/mail/gnupg-outgoing-encrypted.t new file mode 100644 index 000000000..4f2a28f55 --- /dev/null +++ b/rt/t/mail/gnupg-outgoing-encrypted.t @@ -0,0 +1,27 @@ +#!/usr/bin/perl -w +use strict; +use warnings; + +use RT::Test::GnuPG + tests => 103, + gnupg_options => { + passphrase => 'rt-test', + 'trust-model' => 'always', + }; + +RT::Test->import_gnupg_key('rt-recipient@example.com'); +RT::Test->import_gnupg_key( 'rt-test@example.com', 'public' ); + +my $queue = RT::Test->load_or_create_queue( + Name => 'Regression', + CorrespondAddress => 'rt-recipient@example.com', + CommentAddress => 'rt-recipient@example.com', + Encrypt => 1, +); +ok $queue && $queue->id, 'loaded or created queue'; + +my ( $baseurl, $m ) = RT::Test->started_ok; +ok $m->login, 'logged in'; + +create_and_test_outgoing_emails( $queue, $m ); + diff --git a/rt/t/mail/gnupg-outgoing-plain.t b/rt/t/mail/gnupg-outgoing-plain.t new file mode 100644 index 000000000..ee9a8ac81 --- /dev/null +++ b/rt/t/mail/gnupg-outgoing-plain.t @@ -0,0 +1,25 @@ +#!/usr/bin/perl -w +use strict; +use warnings; + +use RT::Test::GnuPG + tests => 103, + gnupg_options => { + passphrase => 'rt-test', + 'trust-model' => 'always', + }; + +RT::Test->import_gnupg_key('rt-recipient@example.com'); +RT::Test->import_gnupg_key( 'rt-test@example.com', 'public' ); + +my $queue = RT::Test->load_or_create_queue( + Name => 'Regression', + CorrespondAddress => 'rt-recipient@example.com', + CommentAddress => 'rt-recipient@example.com', +); +ok $queue && $queue->id, 'loaded or created queue'; + +my ( $baseurl, $m ) = RT::Test->started_ok; +ok $m->login, 'logged in'; + +create_and_test_outgoing_emails( $queue, $m ); diff --git a/rt/t/mail/gnupg-outgoing-signed.t b/rt/t/mail/gnupg-outgoing-signed.t new file mode 100644 index 000000000..2ea20a2d7 --- /dev/null +++ b/rt/t/mail/gnupg-outgoing-signed.t @@ -0,0 +1,27 @@ +#!/usr/bin/perl -w +use strict; +use warnings; + +use RT::Test::GnuPG + tests => 103, + gnupg_options => { + passphrase => 'rt-test', + 'trust-model' => 'always', + }; + +RT::Test->import_gnupg_key('rt-recipient@example.com'); +RT::Test->import_gnupg_key( 'rt-test@example.com', 'public' ); + +my $queue = RT::Test->load_or_create_queue( + Name => 'Regression', + CorrespondAddress => 'rt-recipient@example.com', + CommentAddress => 'rt-recipient@example.com', + Sign => 1, +); +ok $queue && $queue->id, 'loaded or created queue'; + +my ( $baseurl, $m ) = RT::Test->started_ok; +ok $m->login, 'logged in'; + +create_and_test_outgoing_emails( $queue, $m ); + diff --git a/rt/t/mail/gnupg-outgoing-signed_encrypted.t b/rt/t/mail/gnupg-outgoing-signed_encrypted.t new file mode 100644 index 000000000..0b82cf1ca --- /dev/null +++ b/rt/t/mail/gnupg-outgoing-signed_encrypted.t @@ -0,0 +1,28 @@ +#!/usr/bin/perl -w +use strict; +use warnings; + +use RT::Test::GnuPG + tests => 103, + gnupg_options => { + passphrase => 'rt-test', + 'trust-model' => 'always', + }; + +RT::Test->import_gnupg_key('rt-recipient@example.com'); +RT::Test->import_gnupg_key( 'rt-test@example.com', 'public' ); + +my $queue = RT::Test->load_or_create_queue( + Name => 'Regression', + CorrespondAddress => 'rt-recipient@example.com', + CommentAddress => 'rt-recipient@example.com', + Sign => 1, + Encrypt => 1, +); +ok $queue && $queue->id, 'loaded or created queue'; + +my ( $baseurl, $m ) = RT::Test->started_ok; +ok $m->login, 'logged in'; + +create_and_test_outgoing_emails( $queue, $m ); + diff --git a/rt/t/mail/gnupg-realmail.t b/rt/t/mail/gnupg-realmail.t index 198402b23..7d1dbcab5 100644 --- a/rt/t/mail/gnupg-realmail.t +++ b/rt/t/mail/gnupg-realmail.t @@ -2,32 +2,13 @@ use strict; use warnings; -use RT::Test tests => 196; - -plan skip_all => 'GnuPG required.' - unless eval 'use GnuPG::Interface; 1'; -plan skip_all => 'gpg executable is required.' - unless RT::Test->find_executable('gpg'); - +use RT::Test::GnuPG tests => 198, gnupg_options => { passphrase => 'rt-test' }; use Digest::MD5 qw(md5_hex); -use File::Temp qw(tempdir); -my $homedir = tempdir( CLEANUP => 1 ); - -RT->Config->Set( 'GnuPG', - Enable => 1, - OutgoingMessagesFormat => 'RFC' ); - -RT->Config->Set( 'GnuPGOptions', - homedir => $homedir, - passphrase => 'rt-test', - 'no-permission-warning' => undef); - -RT->Config->Set( 'MailPlugins' => 'Auth::MailFrom', 'Auth::GnuPG' ); - RT::Test->import_gnupg_key('rt-recipient@example.com'); RT::Test->import_gnupg_key('rt-test@example.com', 'public'); +RT::Test->trust_gnupg_key('rt-test@example.com'); my ($baseurl, $m) = RT::Test->started_ok; ok $m->login, 'we did log in'; @@ -37,17 +18,12 @@ $m->submit_form( form_number => 3, fields => { CorrespondAddress => 'rt-recipient@example.com' } ); $m->content_like(qr/rt-recipient\@example.com.* - never/, 'has key info.'); -RT::Test->set_rights( - Principal => 'Everyone', - Right => ['CreateTicket'], -); - my $eid = 0; for my $usage (qw/signed encrypted signed&encrypted/) { for my $format (qw/MIME inline/) { for my $attachment (qw/plain text-attachment binary-attachment/) { ++$eid; - diag "Email $eid: $usage, $attachment email with $format format" if $ENV{TEST_VERBOSE}; + diag "Email $eid: $usage, $attachment email with $format format"; eval { email_ok($eid, $usage, $format, $attachment) }; } } @@ -57,13 +33,13 @@ $eid = 18; { my ($usage, $format, $attachment) = ('signed', 'inline', 'plain'); ++$eid; - diag "Email $eid: $usage, $attachment email with $format format" if $ENV{TEST_VERBOSE}; + diag "Email $eid: $usage, $attachment email with $format format"; eval { email_ok($eid, $usage, $format, $attachment) }; } sub email_ok { my ($eid, $usage, $format, $attachment) = @_; - diag "email_ok $eid: $usage, $format, $attachment" if $ENV{'TEST_VERBOSE'}; + diag "email_ok $eid: $usage, $format, $attachment"; my $emaildatadir = RT::Test::get_relocatable_dir(File::Spec->updir(), qw(data gnupg emails)); @@ -74,7 +50,7 @@ sub email_ok { is ($status >> 8, 0, "$eid: The mail gateway exited normally"); ok ($id, "$eid: got id of a newly created ticket - $id"); - my $tick = RT::Ticket->new( $RT::SystemUser ); + my $tick = RT::Ticket->new( RT->SystemUser ); $tick->Load( $id ); ok ($tick->id, "$eid: loaded ticket #$id"); diff --git a/rt/t/mail/gnupg-reverification.t b/rt/t/mail/gnupg-reverification.t index f116d9380..96a37a080 100644 --- a/rt/t/mail/gnupg-reverification.t +++ b/rt/t/mail/gnupg-reverification.t @@ -2,43 +2,16 @@ use strict; use warnings; -use RT::Test tests => 120; +use RT::Test::GnuPG tests => 216, gnupg_options => { passphrase => 'rt-test' }; -plan skip_all => 'GnuPG required.' - unless eval 'use GnuPG::Interface; 1'; -plan skip_all => 'gpg executable is required.' - unless RT::Test->find_executable('gpg'); - - -use File::Temp qw(tempdir); -my $homedir = tempdir( CLEANUP => 1 ); - -RT->Config->Set( 'GnuPG', - Enable => 1, - OutgoingMessagesFormat => 'RFC' ); - -RT->Config->Set( 'GnuPGOptions', - homedir => $homedir, - passphrase => 'rt-test', - 'no-permission-warning' => undef); - -RT->Config->Set( 'MailPlugins' => 'Auth::MailFrom', 'Auth::GnuPG' ); - - -diag "load Everyone group" if $ENV{'TEST_VERBOSE'}; +diag "load Everyone group"; my $everyone; { - $everyone = RT::Group->new( $RT::SystemUser ); + $everyone = RT::Group->new( RT->SystemUser ); $everyone->LoadSystemInternalGroup('Everyone'); ok $everyone->id, "loaded 'everyone' group"; } -RT::Test->set_rights( - Principal => $everyone, - Right => ['CreateTicket'], -); - - my ($baseurl, $m) = RT::Test->started_ok; ok $m->login, 'we get log in'; @@ -50,7 +23,7 @@ my $emaildatadir = RT::Test::get_relocatable_dir(File::Spec->updir(), qw(data gnupg emails)); my @files = glob("$emaildatadir/*-signed-*"); foreach my $file ( @files ) { - diag "testing $file" if $ENV{'TEST_VERBOSE'}; + diag "testing $file"; my ($eid) = ($file =~ m{(\d+)[^/\\]+$}); ok $eid, 'figured id of a file'; @@ -58,35 +31,61 @@ foreach my $file ( @files ) { my $email_content = RT::Test->file_content( $file ); ok $email_content, "$eid: got content of email"; - my ($status, $id) = RT::Test->send_via_mailgate( $email_content ); + my $warnings; + my ($status, $id); + + { + # We don't use Test::Warn here because we get multi-line + # warnings, which Test::Warn only records the first line of. + local $SIG{__WARN__} = sub { + $warnings .= "@_"; + }; + + ($status, $id) = RT::Test->send_via_mailgate( $email_content ); + } + is $status >> 8, 0, "$eid: the mail gateway exited normally"; ok $id, "$eid: got id of a newly created ticket - $id"; - my $ticket = RT::Ticket->new( $RT::SystemUser ); + like($warnings, qr/Had a problem during decrypting and verifying/); + like($warnings, qr/public key not found/); + + my $ticket = RT::Ticket->new( RT->SystemUser ); $ticket->Load( $id ); ok $ticket->id, "$eid: loaded ticket #$id"; is $ticket->Subject, "Test Email ID:$eid", "$eid: correct subject"; $m->goto_ticket( $id ); - $m->content_like( - qr/Not possible to check the signature, the reason is missing public key/is, + $m->content_contains( + "Not possible to check the signature, the reason is missing public key", "$eid: signature is not verified", ); $m->content_like(qr/This is .*ID:$eid/ims, "$eid: content is there and message is decrypted"); + $m->next_warning_like(qr/public key not found/); + + # some mails contain multiple signatures + if ($eid == 5 || $eid == 17 || $eid == 18) { + $m->next_warning_like(qr/public key not found/); + } + + $m->no_leftover_warnings_ok; + push @ticket_ids, $id; } -diag "import key into keyring" if $ENV{'TEST_VERBOSE'}; +diag "import key into keyring"; RT::Test->import_gnupg_key('rt-test@example.com', 'public'); foreach my $id ( @ticket_ids ) { - diag "testing ticket #$id" if $ENV{'TEST_VERBOSE'}; + diag "testing ticket #$id"; $m->goto_ticket( $id ); - $m->content_like( - qr/The signature is good/is, + $m->content_contains( + "The signature is good", "signature is re-verified and now good", ); + + $m->no_warnings_ok; } diff --git a/rt/t/mail/gnupg-special.t b/rt/t/mail/gnupg-special.t index 6a31ef131..7dd63478a 100644 --- a/rt/t/mail/gnupg-special.t +++ b/rt/t/mail/gnupg-special.t @@ -2,32 +2,10 @@ use strict; use warnings; -use RT::Test tests => 23; - -plan skip_all => 'GnuPG required.' - unless eval 'use GnuPG::Interface; 1'; -plan skip_all => 'gpg executable is required.' - unless RT::Test->find_executable('gpg'); +use RT::Test::GnuPG tests => 25, gnupg_options => { passphrase => 'rt-test' }; use Digest::MD5 qw(md5_hex); -use File::Temp qw(tempdir); -my $homedir = tempdir( CLEANUP => 1 ); - -# catch any outgoing emails -RT::Test->set_mail_catcher; - -RT->Config->Set( 'GnuPG', - Enable => 1, - OutgoingMessagesFormat => 'RFC' ); - -RT->Config->Set( 'GnuPGOptions', - homedir => $homedir, - 'passphrase' => 'rt-test', - 'no-permission-warning' => undef); - -RT->Config->Set( 'MailPlugins' => 'Auth::MailFrom', 'Auth::GnuPG' ); - RT::Test->import_gnupg_key('rt-recipient@example.com'); RT::Test->import_gnupg_key('rt-test@example.com', 'public'); @@ -46,19 +24,14 @@ ok( $m->login, 'we did log in' ); $m->content_like(qr/rt-recipient\@example.com.* - never/, 'has key info.'); } -ok(my $user = RT::User->new($RT::SystemUser)); +ok(my $user = RT::User->new(RT->SystemUser)); ok($user->Load('root'), "Loaded user 'root'"); $user->SetEmailAddress('recipient@example.com'); -RT::Test->set_rights( - Principal => 'Everyone', - Right => ['CreateTicket'], -); - { my $id = send_via_mailgate('quoted_inline_signature.txt'); - my $tick = RT::Ticket->new( $RT::SystemUser ); + my $tick = RT::Ticket->new( RT->SystemUser ); $tick->Load( $id ); ok ($tick->id, "loaded ticket #$id"); diff --git a/rt/t/mail/mime_decoding.t b/rt/t/mail/mime_decoding.t index 8257aee80..b02f9795f 100644 --- a/rt/t/mail/mime_decoding.t +++ b/rt/t/mail/mime_decoding.t @@ -1,11 +1,11 @@ #!/usr/bin/perl use strict; use warnings; -use RT::Test nodata => 1, tests => 6; +use RT::Test nodb => 1, tests => 8; use_ok('RT::I18N'); -diag q{'=' char in a leading part before an encoded part} if $ENV{TEST_VERBOSE}; +diag q{'=' char in a leading part before an encoded part}; { my $str = 'key="plain"; key="=?UTF-8?B?0LzQvtC5X9GE0LDQudC7LmJpbg==?="'; is( @@ -15,8 +15,7 @@ diag q{'=' char in a leading part before an encoded part} if $ENV{TEST_VERBOSE}; ); } -diag q{not compliant with standards, but MUAs send such field when attachment has non-ascii in name} - if $ENV{TEST_VERBOSE}; +diag q{not compliant with standards, but MUAs send such field when attachment has non-ascii in name}; { my $str = 'attachment; filename="=?UTF-8?B?0LzQvtC5X9GE0LDQudC7LmJpbg==?="'; is( @@ -26,7 +25,7 @@ diag q{not compliant with standards, but MUAs send such field when attachment ha ); } -diag q{'=' char in a trailing part after an encoded part} if $ENV{TEST_VERBOSE}; +diag q{'=' char in a trailing part after an encoded part}; { my $str = 'attachment; filename="=?UTF-8?B?0LzQvtC5X9GE0LDQudC7LmJpbg==?="; some_prop="value"'; is( @@ -36,7 +35,7 @@ diag q{'=' char in a trailing part after an encoded part} if $ENV{TEST_VERBOSE}; ); } -diag q{regression test for #5248 from rt3.fsck.com} if $ENV{TEST_VERBOSE}; +diag q{regression test for #5248 from rt3.fsck.com}; { my $str = qq{Subject: =?ISO-8859-1?Q?Re=3A_=5BXXXXXX=23269=5D_=5BComment=5D_Frag?=} . qq{\n =?ISO-8859-1?Q?e_zu_XXXXXX--xxxxxx_/_Xxxxx=FCxxxxxxxxxx?=}; @@ -47,7 +46,7 @@ diag q{regression test for #5248 from rt3.fsck.com} if $ENV{TEST_VERBOSE}; ); } -diag q{newline and encoded file name} if $ENV{TEST_VERBOSE}; +diag q{newline and encoded file name}; { my $str = qq{application/vnd.ms-powerpoint;\n\tname="=?ISO-8859-1?Q?Main_presentation.ppt?="}; is( @@ -57,3 +56,26 @@ diag q{newline and encoded file name} if $ENV{TEST_VERBOSE}; ); } +diag q{rfc2231}; +{ + my $str = +"filename*=ISO-8859-1''%74%E9%73%74%2E%74%78%74 filename*=ISO-8859-1''%74%E9%73%74%2E%74%78%74"; + is( + RT::I18N::DecodeMIMEWordsToEncoding( $str, 'utf-8' ), + 'filename=tést.txt filename=tést.txt', + 'right decodig' + ); +} + +diag q{canonicalize mime word encodings like gb2312}; +{ + my $str = qq{Subject: =?gb2312?B?1NrKwL3nuPe12Lmy09CzrN9eX1NpbXBsaWZpZWRfQ05fR0IyMzEyYQ==?= + =?gb2312?B?dHRhY2hlbWVudCB0ZXN0IGluIENOIHNpbXBsaWZpZWQ=?=}; + + is( + RT::I18N::DecodeMIMEWordsToUTF8($str), + qq{Subject: 在世界各地共有超過_Simplified_CN_GB2312attachement test in CN simplified}, + "right decoding" + ); +} + diff --git a/rt/t/mail/multipart.t b/rt/t/mail/multipart.t index dc97b266f..a68710a75 100644 --- a/rt/t/mail/multipart.t +++ b/rt/t/mail/multipart.t @@ -46,19 +46,11 @@ # those contributions and any derivatives thereof. # # END BPS TAGGED BLOCK }}} - -=head1 NAME - -rt-mailgate - Mail interface to RT3. - -=cut - use strict; use warnings; -use RT::Test tests => 5; +use RT::Test tests => 4; use RT::Test::Email; -my ($baseurl, $m) = RT::Test->started_ok; my $queue = RT::Test->load_or_create_queue( Name => 'General' ); my $user = RT::Test->load_or_create_user( Name => 'bob', EmailAddress => 'bob@example.com' ); diff --git a/rt/t/mail/one-time-recipients.t b/rt/t/mail/one-time-recipients.t new file mode 100644 index 000000000..985f95562 --- /dev/null +++ b/rt/t/mail/one-time-recipients.t @@ -0,0 +1,209 @@ +#!/usr/bin/perl +use strict; +use warnings; +use utf8; + +use RT::Test tests => 38; + +my $queue = RT::Test->load_or_create_queue( + Name => 'General', + CorrespondAddress => 'rt-recipient@example.com', + CommentAddress => 'rt-recipient@example.com', +); +ok $queue && $queue->id, 'loaded or created queue'; + +my $user = RT::Test->load_or_create_user( + Name => 'root', + EmailAddress => 'root@localhost', +); +ok $user && $user->id, 'loaded or created user'; + +diag "Reply to ticket with actor as one time cc"; +{ + my $ticket = RT::Ticket->new( RT::CurrentUser->new( $user ) ); + my ($status, undef, $msg) = $ticket->Create( + Queue => $queue->id, + Subject => 'test', + Requestor => 'root@localhost', + ); + ok $status, "created ticket"; + + my @mails = RT::Test->fetch_caught_mails; + ok @mails, "got some outgoing emails"; + foreach my $mail ( @mails ) { + my $entity = parse_mail( $mail ); + my $to = $entity->head->get('To'); + $to =~ s/^\s+|\s+$//; + is $to, 'root@localhost', 'got mail' + } + + RT->Config->Set( NotifyActor => 1 ); + ($status, $msg) = $ticket->Correspond( + Content => 'test mail', + ); + ok $status, "replied to a ticket"; + + @mails = RT::Test->fetch_caught_mails; + ok @mails, "got some outgoing emails"; + foreach my $mail ( @mails ) { + my $entity = parse_mail( $mail ); + my $to = $entity->head->get('To'); + $to =~ s/^\s+|\s+$//; + is $to, 'root@localhost', 'got mail' + } + + RT->Config->Set( NotifyActor => 0 ); + ($status, $msg) = $ticket->Correspond( + Content => 'test mail', + ); + ok $status, "replied to a ticket"; + + @mails = RT::Test->fetch_caught_mails; + ok !@mails, "no mail - don't notify actor"; + + ($status, $msg) = $ticket->Correspond( + Content => 'test mail', + CcMessageTo => 'root@localhost', + ); + ok $status, "replied to a ticket"; + + @mails = RT::Test->fetch_caught_mails; + ok @mails, "got some outgoing emails"; + foreach my $mail ( @mails ) { + my $entity = parse_mail( $mail ); + my $to = $entity->head->get('Cc'); + $to =~ s/^\s+|\s+$//; + is $to, 'root@localhost', 'got mail' + } +} + +diag "Reply to ticket with requestor squelched"; +{ + my $ticket = RT::Ticket->new( RT::CurrentUser->new( $user ) ); + my ($status, undef, $msg) = $ticket->Create( + Queue => $queue->id, + Subject => 'test', + Requestor => 'test@localhost', + ); + ok $status, "created ticket"; + + my @mails = RT::Test->fetch_caught_mails; + ok @mails, "got some outgoing emails"; + foreach my $mail ( @mails ) { + my $entity = parse_mail( $mail ); + my $to = $entity->head->get('To'); + $to =~ s/^\s+|\s+$//; + is $to, 'test@localhost', 'got mail' + } + + ($status, $msg) = $ticket->Correspond( + Content => 'test mail', + ); + ok $status, "replied to a ticket"; + + @mails = RT::Test->fetch_caught_mails; + ok @mails, "got some outgoing emails"; + foreach my $mail ( @mails ) { + my $entity = parse_mail( $mail ); + my $to = $entity->head->get('To'); + $to =~ s/^\s+|\s+$//; + is $to, 'test@localhost', 'got mail' + } + + $ticket->SquelchMailTo('test@localhost'); + ($status, $msg) = $ticket->Correspond( + Content => 'test mail', + ); + ok $status, "replied to a ticket"; + + @mails = RT::Test->fetch_caught_mails; + ok !@mails, "no mail - squelched"; + + ($status, $msg) = $ticket->Correspond( + Content => 'test mail', + CcMessageTo => 'test@localhost', + ); + ok $status, "replied to a ticket"; + + @mails = RT::Test->fetch_caught_mails; + ok @mails, "got some outgoing emails"; + foreach my $mail ( @mails ) { + my $entity = parse_mail( $mail ); + my $to = $entity->head->get('Cc'); + $to =~ s/^\s+|\s+$//; + is $to, 'test@localhost', 'got mail' + } +} + +diag "Reply to ticket with requestor squelched"; +{ + my $ticket = RT::Ticket->new( RT::CurrentUser->new( $user ) ); + my ($status, undef, $msg) = $ticket->Create( + Queue => $queue->id, + Subject => 'test', + Requestor => 'test@localhost', + ); + ok $status, "created ticket"; + + my @mails = RT::Test->fetch_caught_mails; + ok @mails, "got some outgoing emails"; + foreach my $mail ( @mails ) { + my $entity = parse_mail( $mail ); + my $to = $entity->head->get('To'); + $to =~ s/^\s+|\s+$//; + is $to, 'test@localhost', 'got mail' + } + + ($status, $msg) = $ticket->Correspond( + Content => 'test mail', + ); + ok $status, "replied to a ticket"; + + @mails = RT::Test->fetch_caught_mails; + ok @mails, "got some outgoing emails"; + foreach my $mail ( @mails ) { + my $entity = parse_mail( $mail ); + my $to = $entity->head->get('To'); + $to =~ s/^\s+|\s+$//; + is $to, 'test@localhost', 'got mail' + } + + ($status, $msg) = $ticket->Correspond( + Content => 'test mail', + SquelchMailTo => ['test@localhost'], + ); + ok $status, "replied to a ticket"; + + @mails = RT::Test->fetch_caught_mails; + ok !@mails, "no mail - squelched"; + + ($status, $msg) = $ticket->Correspond( + Content => 'test mail', + ); + ok $status, "replied to a ticket"; + + @mails = RT::Test->fetch_caught_mails; + ok @mails, "got some outgoing emails"; + foreach my $mail ( @mails ) { + my $entity = parse_mail( $mail ); + my $to = $entity->head->get('To'); + $to =~ s/^\s+|\s+$//; + is $to, 'test@localhost', 'got mail' + } + + ($status, $msg) = $ticket->Correspond( + Content => 'test mail', + CcMessageTo => 'test@localhost', + SquelchMailTo => ['test@localhost'], + ); + ok $status, "replied to a ticket"; + + @mails = RT::Test->fetch_caught_mails; + ok @mails, "got some outgoing emails"; + foreach my $mail ( @mails ) { + my $entity = parse_mail( $mail ); + my $to = $entity->head->get('Cc'); + $to =~ s/^\s+|\s+$//; + is $to, 'test@localhost', 'got mail' + } +} diff --git a/rt/t/mail/outlook.t b/rt/t/mail/outlook.t index 15bfa21bc..00bbc9445 100644 --- a/rt/t/mail/outlook.t +++ b/rt/t/mail/outlook.t @@ -56,11 +56,11 @@ rt-mailgate - Mail interface to RT3. use strict; use warnings; -use RT::Test tests => 43; -my ($baseurl, $m) = RT::Test->started_ok; +use RT::Test tests => 42; + # 12.0 is outlook 2007, 14.0 is 2010 for my $mailer ( 'Microsoft Office Outlook 12.0', 'Microsoft Outlook 14.0' ) { - diag "Test mail with multipart/alternative" if $ENV{'TEST_VERBOSE'}; + diag "Test mail with multipart/alternative"; { my $text = <<EOF; From: root\@localhost @@ -106,8 +106,7 @@ EOF $mailer . ' with multipart/alternative, \n\n are replaced' ); } - diag "Test mail with multipart/mixed, with multipart/alternative in it" - if $ENV{'TEST_VERBOSE'}; + diag "Test mail with multipart/mixed, with multipart/alternative in it"; { my $text = <<EOF; From: root\@localhost @@ -167,8 +166,7 @@ EOF $mailer . ' with multipart/multipart, \n\n are replaced' ); } - diag "Test mail with with outlook, but the content type is text/plain" - if $ENV{'TEST_VERBOSE'}; + diag "Test mail with with outlook, but the content type is text/plain"; { my $text = <<EOF; From: root\@localhost @@ -203,8 +201,7 @@ EOF } } -diag "Test mail with with multipart/alternative but x-mailer is not outlook " - if $ENV{'TEST_VERBOSE'}; +diag "Test mail with with multipart/alternative but x-mailer is not outlook "; { my $text = <<EOF; From: root\@localhost diff --git a/rt/t/mail/rfc822-attachment.t b/rt/t/mail/rfc822-attachment.t new file mode 100644 index 000000000..f498ec55a --- /dev/null +++ b/rt/t/mail/rfc822-attachment.t @@ -0,0 +1,137 @@ +use strict; +use warnings; + +use RT::Test tests => undef; + +use MIME::Entity; + +diag "simple rfc822 attachment"; +{ + + my $top = MIME::Entity->build( + From => 'root@localhost', + To => 'rt@localhost', + Subject => 'this is top', + Data => ['top mail'], + ); + + my $rfc822 = MIME::Entity->build( + From => 'foo@localhost', + To => 'bar@localhost', + Subject => 'rfc822', + Data => ['rfc822 attachment'], + 'X-Brokenness' => 'high', + ); + + $top->attach( + Data => $rfc822->stringify, + Type => 'message/rfc822', + ); + + my $parsed = content_as_mime($top); + + for my $mime ($top, $parsed) { + diag "testing mail"; + is $mime->parts, 2, 'two mime parts'; + + like $mime->head->get('Subject'), qr/this is top/, 'top subject'; + like $mime->head->get('From'), qr/root\@localhost/, 'top From'; + like $mime->parts(0)->bodyhandle->as_string, qr/top mail/, 'content of top'; + + my $attach = $mime->parts(1); + my $body = $attach->bodyhandle->as_string; + + like $attach->head->mime_type, qr/message\/rfc822/, 'attach of type message/rfc822'; + like $body, qr/rfc822 attachment/, 'attach content'; + + headers_like( + $attach, + Subject => 'rfc822', + From => 'foo@localhost', + 'X-Brokenness' => 'high', + ); + } +} + +diag "multipart rfc822 attachment"; +{ + + my $top = MIME::Entity->build( + From => 'root@localhost', + To => 'rt@localhost', + Subject => 'this is top', + Data => ['top mail'], + ); + + my $rfc822 = MIME::Entity->build( + From => 'foo@localhost', + To => 'bar@localhost', + Subject => 'rfc822', + Data => ['rfc822 attachment'], + 'X-Brokenness' => 'high', + ); + + $rfc822->attach( + Data => '<b>attachment of rfc822 attachment</b>', + Type => 'text/html', + ); + + $top->attach( + Data => $rfc822->stringify, + Type => 'message/rfc822', + ); + + my $parsed = content_as_mime($top); + + for my $mime ($top, $parsed) { + diag "testing mail"; + is $mime->parts, 2, 'two mime parts'; + + like $mime->head->get('Subject'), qr/this is top/, 'top subject'; + like $mime->head->get('From'), qr/root\@localhost/, 'top From'; + like $mime->parts(0)->bodyhandle->as_string, qr/top mail/, 'content of top'; + + my $attach = $mime->parts(1); + my $body = $attach->bodyhandle->as_string; + + like $attach->head->mime_type, qr/message\/rfc822/, 'attach of type message/rfc822'; + like $body, qr/rfc822 attachment/, 'attach content'; + like $body, qr/attachment of rfc822 attachment/, 'attach content'; + + headers_like( + $attach, + Subject => 'rfc822', + From => 'foo@localhost', + 'X-Brokenness' => 'high', + 'Content-Type' => 'text/plain', + 'Content-type' => 'text/html', + ); + } +} + +sub content_as_mime { + my $entity = shift; + my ( $status, $id ) = RT::Test->send_via_mailgate($entity); + is( $status >> 8, 0, "The mail gateway exited normally" ); + ok( $id, "created ticket" ); + # We can't simply use Txn->ContentAsMIME since that is wrapped in a + # message/rfc822 entity + return RT::Test->last_ticket->Transactions->First->Attachments->First->ContentAsMIME(Children => 1); +} + +sub headers_like { + my $attach = shift; + my %header = (@_); + my $body = $attach->bodyhandle->as_string; + for my $name (keys %header) { + if (lc $name eq 'content-type') { + like $attach->head->get($name), qr/message\/rfc822/, "attach $name message/rfc822, not from a subpart"; + } else { + is $attach->head->get($name), undef, "attach $name not in part header"; + } + like $body, qr/$name: $header{$name}/i, "attach $name in part body"; + } +} + +done_testing; + diff --git a/rt/t/mail/sendmail.t b/rt/t/mail/sendmail.t index 1f97bbb9f..bb5d2db80 100644 --- a/rt/t/mail/sendmail.t +++ b/rt/t/mail/sendmail.t @@ -3,7 +3,7 @@ use strict; use File::Spec (); -use RT::Test tests => 137; +use RT::Test tests => 141; use RT::EmailParser; use RT::Tickets; @@ -13,7 +13,7 @@ my @_outgoing_messages; my @scrips_fired; #We're not testing acls here. -my $everyone = RT::Group->new($RT::SystemUser); +my $everyone = RT::Group->new(RT->SystemUser); $everyone->LoadSystemInternalGroup('Everyone'); $everyone->PrincipalObj->GrantRight( Right =>'SuperUser' ); @@ -22,13 +22,13 @@ is (__PACKAGE__, 'main', "We're operating in the main package"); { no warnings qw/redefine/; - sub RT::Action::SendEmail::SendMessage { + *RT::Action::SendEmail::SendMessage = sub { my $self = shift; my $MIME = shift; main::_fired_scrip($self->ScripObj); main::is(ref($MIME) , 'MIME::Entity', "hey, look. it's a mime entity"); - } + }; } # some utils @@ -52,7 +52,7 @@ use RT::Interface::Email; my %args = (message => $content, queue => 1, action => 'correspond'); my ($status, $msg) = RT::Interface::Email::Gateway(\%args); ok($status, "successfuly used Email::Gateway interface") or diag("error: $msg"); -my $tickets = RT::Tickets->new($RT::SystemUser); +my $tickets = RT::Tickets->new(RT->SystemUser); $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); my $tick= $tickets->First(); @@ -79,10 +79,10 @@ Foob!'); use Data::Dumper; -my $ticket = RT::Ticket->new($RT::SystemUser); +my $ticket = RT::Ticket->new(RT->SystemUser); my ($id, undef, $create_msg ) = $ticket->Create(Requestor => ['root@localhost'], Queue => 'general', Subject => 'I18NTest', MIMEObj => $parser->Entity); ok ($id,$create_msg); -$tickets = RT::Tickets->new($RT::SystemUser); +$tickets = RT::Tickets->new(RT->SystemUser); $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); $tick = $tickets->First(); @@ -115,7 +115,7 @@ use RT::Interface::Email; %args = (message => $content, queue => 1, action => 'correspond'); RT::Interface::Email::Gateway(\%args); - $tickets = RT::Tickets->new($RT::SystemUser); + $tickets = RT::Tickets->new(RT->SystemUser); $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); $tick = $tickets->First(); @@ -157,7 +157,7 @@ use RT::Interface::Email; %args = (message => $content, queue => 1, action => 'correspond'); RT::Interface::Email::Gateway(\%args); -$tickets = RT::Tickets->new($RT::SystemUser); +$tickets = RT::Tickets->new(RT->SystemUser); $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); $tick = $tickets->First(); @@ -192,8 +192,7 @@ sub _fired_scrip { sub utf8_redef_sendmessage { no warnings qw/redefine/; - eval ' - sub RT::Action::SendEmail::SendMessage { + *RT::Action::SendEmail::SendMessage = sub { my $self = shift; my $MIME = shift; @@ -201,26 +200,25 @@ sub utf8_redef_sendmessage { ok(1, $self->ScripObj->ConditionObj->Name . " ".$self->ScripObj->ActionObj->Name); main::_fired_scrip($self->ScripObj); $MIME->make_singlepart; - main::is( ref($MIME) , \'MIME::Entity\', - "hey, look. it\'s a mime entity" ); - main::is( ref( $MIME->head ) , \'MIME::Head\', + main::is( ref($MIME) , 'MIME::Entity', + "hey, look. it's a mime entity" ); + main::is( ref( $MIME->head ) , 'MIME::Head', "its mime header is a mime header. yay" ); - main::like( $MIME->head->get(\'Content-Type\') , qr/utf-8/, + main::like( $MIME->head->get('Content-Type') , qr/utf-8/, "Its content type is utf-8" ); my $message_as_string = $MIME->bodyhandle->as_string(); use Encode; $message_as_string = Encode::decode_utf8($message_as_string); main::like( $message_as_string , qr/H\x{e5}vard/, -"The message\'s content contains havard\'s name. this will fail if it\'s not utf8 out"); +"The message's content contains havard's name. this will fail if it's not utf8 out"); - }'; + }; } sub iso8859_redef_sendmessage { no warnings qw/redefine/; - eval ' - sub RT::Action::SendEmail::SendMessage { + *RT::Action::SendEmail::SendMessage = sub { my $self = shift; my $MIME = shift; @@ -228,22 +226,20 @@ sub iso8859_redef_sendmessage { ok(1, $self->ScripObj->ConditionObj->Name . " ".$self->ScripObj->ActionObj->Name); main::_fired_scrip($self->ScripObj); $MIME->make_singlepart; - main::is( ref($MIME) , \'MIME::Entity\', - "hey, look. it\'s a mime entity" ); - main::is( ref( $MIME->head ) , \'MIME::Head\', + main::is( ref($MIME) , 'MIME::Entity', + "hey, look. it's a mime entity" ); + main::is( ref( $MIME->head ) , 'MIME::Head', "its mime header is a mime header. yay" ); - main::like( $MIME->head->get(\'Content-Type\') , qr/iso-8859-1/, + main::like( $MIME->head->get('Content-Type') , qr/iso-8859-1/, "Its content type is iso-8859-1 - " . $MIME->head->get("Content-Type") ); my $message_as_string = $MIME->bodyhandle->as_string(); use Encode; $message_as_string = Encode::decode("iso-8859-1",$message_as_string); main::like( - $message_as_string , qr/H\x{e5}vard/, "The message\'s content contains havard\'s name. this will fail if it\'s not utf8 out"); - - }'; + $message_as_string , qr/H\x{e5}vard/, "The message's content contains havard's name. this will fail if it's not utf8 out"); + }; } -# {{{ test a multipart alternative containing a text-html part with an umlaut my $alt_umlaut_email = RT::Test::get_relocatable_file( 'multipart-alternative-with-umlaut', (File::Spec->updir(), 'data', 'emails')); @@ -260,7 +256,7 @@ $parser->ParseMIMEEntityFromScalar($content); %args = (message => $content, queue => 1, action => 'correspond'); RT::Interface::Email::Gateway(\%args); # TODO: following 5 lines should replaced by get_latest_ticket_ok() - $tickets = RT::Tickets->new($RT::SystemUser); + $tickets = RT::Tickets->new(RT->SystemUser); $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); $tick = $tickets->First(); @@ -272,9 +268,7 @@ $parser->ParseMIMEEntityFromScalar($content); } -# }}} -# {{{ test a text-html message with an umlaut my $text_html_email = RT::Test::get_relocatable_file('text-html-with-umlaut', (File::Spec->updir(), 'data', 'emails')); $content = RT::Test->file_content($text_html_email); @@ -287,7 +281,7 @@ $parser->ParseMIMEEntityFromScalar($content); %args = (message => $content, queue => 1, action => 'correspond'); RT::Interface::Email::Gateway(\%args); - $tickets = RT::Tickets->new($RT::SystemUser); + $tickets = RT::Tickets->new(RT->SystemUser); $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); $tick = $tickets->First(); @@ -299,32 +293,54 @@ is (count_attachs($tick), 1 , "Has one attachment, presumably a text-html and a sub text_html_redef_sendmessage { no warnings qw/redefine/; - eval 'sub RT::Action::SendEmail::SendMessage { - my $self = shift; - my $MIME = shift; - return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" ); - is ($MIME->parts, 0, "generated correspondence mime entity - does not have parts"); - is ($MIME->head->mime_type , "text/plain", "The mime type is a plain"); - }'; + *RT::Action::SendEmail::SendMessage = sub { + my $self = shift; + my $MIME = shift; + return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" ); + is ($MIME->parts, 0, "generated correspondence mime entity + does not have parts"); + is ($MIME->head->mime_type , "text/plain", "The mime type is a plain"); + }; } -# }}} -# {{{ test a text-html message with russian characters my $russian_email = RT::Test::get_relocatable_file('text-html-in-russian', (File::Spec->updir(), 'data', 'emails')); $content = RT::Test->file_content($russian_email); $parser->ParseMIMEEntityFromScalar($content); - # be as much like the mail gateway as possible. &text_html_redef_sendmessage; %args = (message => $content, queue => 1, action => 'correspond'); - RT::Interface::Email::Gateway(\%args); - $tickets = RT::Tickets->new($RT::SystemUser); + +{ + +my @warnings; +local $SIG{__WARN__} = sub { + push @warnings, "@_"; +}; + +RT::Interface::Email::Gateway(\%args); + +TODO: { + local $TODO = +'need a better approach of encoding converter, should be fixed in 4.2'; +ok( @warnings == 1 || @warnings == 2, "1 or 2 warnings are ok" ); +ok( @warnings == 1 || ( @warnings == 2 && $warnings[1] eq $warnings[0] ), + 'if there are 2 warnings, they should be same' ); + +like( + $warnings[0], + qr/\QEncoding error: "\x{041f}" does not map to iso-8859-1/, +"The badly formed Russian spam we have isn't actually well-formed UTF8, which makes Encode (correctly) warn", +); + +} +} + + $tickets = RT::Tickets->new(RT->SystemUser); $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); $tick = $tickets->First(); @@ -334,9 +350,7 @@ like (first_attach($tick)->ContentType , qr/text\/html/, "We recorded the conten is (count_attachs($tick) ,1 , "Has one attachment, presumably a text-html and a multipart alternative"); -# }}} -# {{{ test a message containing a russian subject and NO content type RT->Config->Set( EmailInputEncodings => 'koi8-r', RT->Config->Get('EmailInputEncodings') ); RT->Config->Set( EmailOutputEncoding => 'koi8-r' ); @@ -351,7 +365,7 @@ $parser->ParseMIMEEntityFromScalar($content); &text_plain_russian_redef_sendmessage; %args = (message => $content, queue => 1, action => 'correspond'); RT::Interface::Email::Gateway(\%args); - $tickets = RT::Tickets->new($RT::SystemUser); + $tickets = RT::Tickets->new(RT->SystemUser); $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); $tick= $tickets->First(); @@ -362,26 +376,23 @@ is (count_attachs($tick) ,1 , "Has one attachment, presumably a text-plain"); is ($tick->Subject, "\x{442}\x{435}\x{441}\x{442} \x{442}\x{435}\x{441}\x{442}", "Recorded the subject right"); sub text_plain_russian_redef_sendmessage { no warnings qw/redefine/; - eval 'sub RT::Action::SendEmail::SendMessage { - my $self = shift; - my $MIME = shift; - return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" ); - is ($MIME->head->mime_type , "text/plain", "The only part is text/plain "); - my $subject = $MIME->head->get("subject"); - chomp($subject); - #is( $subject , /^=\?KOI8-R\?B\?W2V4YW1wbGUuY39tICM3XSDUxdPUINTF09Q=\?=/ , "The $subject is encoded correctly"); - }; - '; + *RT::Action::SendEmail::SendMessage = sub { + my $self = shift; + my $MIME = shift; + return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" ); + is ($MIME->head->mime_type , "text/plain", "The only part is text/plain "); + my $subject = $MIME->head->get("subject"); + chomp($subject); + #is( $subject , /^=\?KOI8-R\?B\?W2V4YW1wbGUuY39tICM3XSDUxdPUINTF09Q=\?=/ , "The $subject is encoded correctly"); + }; } my @input_encodings = RT->Config->Get( 'EmailInputEncodings' ); shift @input_encodings; RT->Config->Set(EmailInputEncodings => @input_encodings ); RT->Config->Set(EmailOutputEncoding => 'utf-8'); -# }}} -# {{{ test a message containing a nested RFC 822 message my $nested_rfc822_email = RT::Test::get_relocatable_file('nested-rfc-822', (File::Spec->updir(), 'data', 'emails')); @@ -395,7 +406,7 @@ $parser->ParseMIMEEntityFromScalar($content); &text_plain_nested_redef_sendmessage; %args = (message => $content, queue => 1, action => 'correspond'); RT::Interface::Email::Gateway(\%args); - $tickets = RT::Tickets->new($RT::SystemUser); + $tickets = RT::Tickets->new(RT->SystemUser); $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); $tick= $tickets->First(); @@ -405,24 +416,28 @@ like (first_attach($tick)->ContentType , qr/multipart\/mixed/, "We recorded the is (count_attachs($tick) , 5 , "Has one attachment, presumably a text-plain and a message RFC 822 and another plain"); sub text_plain_nested_redef_sendmessage { no warnings qw/redefine/; - eval 'sub RT::Action::SendEmail::SendMessage { - my $self = shift; - my $MIME = shift; - return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" ); - is ($MIME->head->mime_type , "multipart/mixed", "It is a mixed multipart"); - my $subject = $MIME->head->get("subject"); - $subject = MIME::Base64::decode_base64( $subject); - chomp($subject); - # TODO, why does this test fail - #ok($subject =~ qr{Niv\x{e5}er}, "The subject matches the word - $subject"); - 1; - }'; + *RT::Action::SendEmail::SendMessage = sub { + my $self = shift; + my $MIME = shift; + + return (1) unless ($self->ScripObj->ScripActionObj->Name eq "Notify AdminCcs" ); + + is ($MIME->head->mime_type , "multipart/mixed", "It is a mixed multipart"); + + use MIME::Words qw(:all); + my $encoded_subject = $MIME->head->get("subject"); + my $subject = decode_mimewords($encoded_subject); + + # MIME::Words isn't actually UTF8-safe. There go 4 hours I'll never get back. + utf8::decode($subject); + like($subject, qr/Niv\x{e5}er/, "The subject matches the word - $subject"); + + 1; + }; } -# }}} -# {{{ test a multipart alternative containing a uuencoded mesage generated by lotus notes my $uuencoded_email = RT::Test::get_relocatable_file('notes-uuencoded', (File::Spec->updir(), 'data', 'emails')); @@ -437,7 +452,7 @@ $parser->ParseMIMEEntityFromScalar($content); local *RT::Action::SendEmail::SendMessage = sub { return 1}; %args = (message => $content, queue => 1, action => 'correspond'); RT::Interface::Email::Gateway(\%args); - $tickets = RT::Tickets->new($RT::SystemUser); + $tickets = RT::Tickets->new(RT->SystemUser); $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); $tick= $tickets->First(); @@ -447,9 +462,7 @@ $parser->ParseMIMEEntityFromScalar($content); is (count_attachs($tick) , 3 , "Has three attachments"); } -# }}} -# {{{ test a multipart that crashes the file-based mime-parser works my $crashes_file_based_parser_email = RT::Test::get_relocatable_file( 'crashes-file-based-parser', (File::Spec->updir(), 'data', 'emails')); @@ -464,7 +477,7 @@ no warnings qw/redefine/; local *RT::Action::SendEmail::SendMessage = sub { return 1}; %args = (message => $content, queue => 1, action => 'correspond'); RT::Interface::Email::Gateway(\%args); - $tickets = RT::Tickets->new($RT::SystemUser); + $tickets = RT::Tickets->new(RT->SystemUser); $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); $tick= $tickets->First(); @@ -476,9 +489,7 @@ is (count_attachs($tick) , 5 , "Has three attachments"); -# }}} -# {{{ test a multi-line RT-Send-CC header my $rt_send_cc_email = RT::Test::get_relocatable_file('rt-send-cc', (File::Spec->updir(), 'data', 'emails')); @@ -490,7 +501,7 @@ $parser->ParseMIMEEntityFromScalar($content); %args = (message => $content, queue => 1, action => 'correspond'); RT::Interface::Email::Gateway(\%args); - $tickets = RT::Tickets->new($RT::SystemUser); + $tickets = RT::Tickets->new(RT->SystemUser); $tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); $tick= $tickets->First(); @@ -503,9 +514,8 @@ like ($cc , qr/test3/, "Found test 3"); like ($cc , qr/test4/, "Found test 4"); like ($cc , qr/test5/, "Found test 5"); -# }}} -diag q{regression test for #5248 from rt3.fsck.com} if $ENV{TEST_VERBOSE}; +diag q{regression test for #5248 from rt3.fsck.com}; { my $subject_folding_email = RT::Test::get_relocatable_file( 'subject-with-folding-ws', (File::Spec->updir(), 'data', 'emails')); @@ -518,7 +528,7 @@ diag q{regression test for #5248 from rt3.fsck.com} if $ENV{TEST_VERBOSE}; is ($ticket->Subject, 'test', 'correct subject'); } -diag q{regression test for #5248 from rt3.fsck.com} if $ENV{TEST_VERBOSE}; +diag q{regression test for #5248 from rt3.fsck.com}; { my $long_subject_email = RT::Test::get_relocatable_file('very-long-subject', (File::Spec->updir(), 'data', 'emails')); @@ -535,4 +545,3 @@ diag q{regression test for #5248 from rt3.fsck.com} if $ENV{TEST_VERBOSE}; # Don't taint the environment $everyone->PrincipalObj->RevokeRight(Right =>'SuperUser'); -1; diff --git a/rt/t/mail/threading.t b/rt/t/mail/threading.t new file mode 100644 index 000000000..7112ecf07 --- /dev/null +++ b/rt/t/mail/threading.t @@ -0,0 +1,90 @@ +#!/usr/bin/perl +use strict; +use warnings; +use utf8; + +use RT::Test tests => 22; +RT->Config->Set( NotifyActor => 1 ); + +my $queue = RT::Test->load_or_create_queue( + Name => 'General', + CorrespondAddress => 'rt-recipient@example.com', + CommentAddress => 'rt-recipient@example.com', +); +ok $queue && $queue->id, 'loaded or created queue'; + +my $user = RT::Test->load_or_create_user( + Name => 'root', + EmailAddress => 'root@localhost', +); +ok $user && $user->id, 'loaded or created user'; + +{ + my $mail = <<EOF; +From: root\@localhost +Subject: a ticket +Message-ID: <some-message-id> + +Foob! +EOF + my ($status, $id) = RT::Test->send_via_mailgate($mail); + ok $id, "created a ticket"; + + my @mail = RT::Test->fetch_caught_mails; + is scalar @mail, 1, "autoreply"; + like $mail[0], qr{^In-Reply-To:\s*<some-message-id>$}mi; + like $mail[0], qr{^References:\s*<RT-Ticket-\Q$id\E\@example\.com>}mi; + + my $ticket = RT::Ticket->new( RT->SystemUser ); + $ticket->Load( $id ); + ok $ticket->id, "loaded ticket"; + + ($status, my ($msg)) = $ticket->Correspond( Content => 'boo' ); + ok $status, "replied to the ticket"; + + @mail = RT::Test->fetch_caught_mails; + is scalar @mail, 1, "reply"; + like $mail[0], qr{^References:\s*<RT-Ticket-\Q$id\E\@example\.com>$}mi, + "no context, so only pseudo header is referenced"; +} + +{ + my ($ticket) = RT::Test->create_ticket( + Queue => $queue->id, + Requestor => $user->EmailAddress + ); + my $id = $ticket->id; + ok $id, "created a ticket"; + + my @mail = RT::Test->fetch_caught_mails; + is scalar @mail, 1, "autoreply"; + like $mail[0], qr{^References:\s*<RT-Ticket-\Q$id\E\@example\.com>}mi; +} + +{ + my $scrip = RT::Scrip->new(RT->SystemUser); + my ($status, $msg) = $scrip->Create( + Description => "Notify requestor on status change", + ScripCondition => 'On Status Change', + ScripAction => 'Notify Requestors', + Template => 'Transaction', + Stage => 'TransactionCreate', + Queue => 0, + ); + ok($status, "Scrip created"); + + my ($ticket) = RT::Test->create_ticket( + Queue => $queue->id, + Requestor => $user->EmailAddress, + ); + my $id = $ticket->id; + ok $id, "created a ticket"; + + RT::Test->fetch_caught_mails; + ($status, $msg) = $ticket->SetStatus('open'); + ok $status, "changed status"; + + my @mail = RT::Test->fetch_caught_mails; + is scalar @mail, 1, "status change notification"; + like $mail[0], qr{^References:\s*<RT-Ticket-\Q$id\E\@example\.com>}mi; +} diff --git a/rt/t/mail/verp.t b/rt/t/mail/verp.t index 79ede90ab..ed3af6a7b 100644 --- a/rt/t/mail/verp.t +++ b/rt/t/mail/verp.t @@ -1,7 +1,7 @@ #!/usr/bin/perl -w use strict; -use RT::Test tests => 1; +use RT::Test nodb => 1, tests => 1; TODO: { todo_skip "No tests written for VERP yet", 1; ok(1,"a test to skip"); diff --git a/rt/t/mail/wrong_mime_charset.t b/rt/t/mail/wrong_mime_charset.t index 71a574f26..511a7e61d 100644 --- a/rt/t/mail/wrong_mime_charset.t +++ b/rt/t/mail/wrong_mime_charset.t @@ -1,7 +1,7 @@ #!/usr/bin/perl use strict; use warnings; -use RT::Test nodata => 1, tests => 3; +use RT::Test nodb => 1, tests => 6; use_ok('RT::I18N'); use utf8; @@ -16,12 +16,31 @@ my $mime = MIME::Entity->build( # set the wrong charset mime in purpose $mime->head->mime_attr( "Content-Type.charset" => 'utf8' ); +my @warnings; +local $SIG{__WARN__} = sub { + push @warnings, "@_"; +}; + RT::I18N::SetMIMEEntityToEncoding( $mime, 'iso-8859-1' ); TODO: { local $TODO = 'need a better approach of encoding converter, should be fixed in 4.2'; +# this is a weird behavior for different perl versions, 5.12 warns twice, +# which is correct since we do the encoding thing twice, for Subject +# and Data respectively. +# but 5.8 and 5.10 warns only once. +ok( @warnings == 1 || @warnings == 2, "1 or 2 warnings are ok" ); +ok( @warnings == 1 || ( @warnings == 2 && $warnings[1] eq $warnings[0] ), + 'if there are 2 warnings, they should be same' ); + +like( + $warnings[0], + qr/\QEncoding error: "\x{fffd}" does not map to iso-8859-1/, +"We can't encode something into the wrong encoding without Encode complaining" +); + my $subject = decode( 'iso-8859-1', $mime->head->get('Subject') ); chomp $subject; is( $subject, $test_string, 'subject is set to iso-8859-1' ); |