diff options
Diffstat (limited to 'rt/t/mail')
-rw-r--r-- | rt/t/mail/charsets-outgoing.t | 306 | ||||
-rw-r--r-- | rt/t/mail/crypt-gnupg.t | 312 | ||||
-rw-r--r-- | rt/t/mail/extractsubjecttag.t | 98 | ||||
-rw-r--r-- | rt/t/mail/gateway.t | 802 | ||||
-rw-r--r-- | rt/t/mail/gnupg-bad.t | 58 | ||||
-rw-r--r-- | rt/t/mail/gnupg-incoming.t | 320 | ||||
-rw-r--r-- | rt/t/mail/gnupg-realmail.t | 184 | ||||
-rw-r--r-- | rt/t/mail/gnupg-reverification.t | 92 | ||||
-rw-r--r-- | rt/t/mail/mime_decoding.t | 59 | ||||
-rw-r--r-- | rt/t/mail/sendmail.t | 538 | ||||
-rw-r--r-- | rt/t/mail/verp.t | 8 |
11 files changed, 2777 insertions, 0 deletions
diff --git a/rt/t/mail/charsets-outgoing.t b/rt/t/mail/charsets-outgoing.t new file mode 100644 index 000000000..ca44bbd27 --- /dev/null +++ b/rt/t/mail/charsets-outgoing.t @@ -0,0 +1,306 @@ +#!/usr/bin/perl +use strict; +use warnings; +use utf8; + +use RT::Test tests => 30; + + +RT::Test->set_mail_catcher; + +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'; + +diag "make sure queue has no subject tag" if $ENV{'TEST_VERBOSE'}; +{ + 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'}; +{ + my $template = RT::Template->new( $RT::SystemUser ); + $template->Load('Autoreply'); + ok $template->id, "loaded autoreply tempalte"; + + my ($status, $msg) = $template->SetContent( + "Subject: Autreply { \$Ticket->Subject }\n" + ."\n" + ."hi there it's an autoreply.\n" + ."\n" + ); + ok $status, "changed content of the template" + or diag "error: $msg"; +} + +diag "basic test of autoreply" if $ENV{'TEST_VERBOSE'}; +{ + my $ticket = RT::Ticket->new( $RT::SystemUser ); + $ticket->Create( + Queue => $queue->id, + Subject => 'test', + Requestor => 'root@localhost', + ); + my @mails = RT::Test->fetch_caught_mails; + ok @mails, "got some outgoing emails"; +} + +my $str_ru_test = "\x{442}\x{435}\x{441}\x{442}"; +my $str_ru_autoreply = "\x{410}\x{432}\x{442}\x{43e}\x{43e}\x{442}\x{432}\x{435}\x{442}"; +my $str_ru_support = "\x{43f}\x{43e}\x{434}\x{434}\x{435}\x{440}\x{436}\x{43a}\x{430}"; + +diag "non-ascii Subject with ascii prefix set in the template" + if $ENV{'TEST_VERBOSE'}; +{ + my $ticket = RT::Ticket->new( $RT::SystemUser ); + $ticket->Create( + Queue => $queue->id, + Subject => $str_ru_test, + Requestor => 'root@localhost', + ); + my @mails = RT::Test->fetch_caught_mails; + ok @mails, "got some outgoing emails"; + + my $status = 1; + foreach my $mail ( @mails ) { + my $entity = parse_mail( $mail ); + my $subject = Encode::decode_utf8( $entity->head->get('Subject') ); + $subject =~ /$str_ru_test/ + or do { $status = 0; diag "wrong subject: $subject" }; + } + ok $status, "all mails have correct data"; +} + +diag "set non-ascii subject tag for the queue" if $ENV{'TEST_VERBOSE'}; +{ + my ($status, $msg) = $queue->SetSubjectTag( $str_ru_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'}; +{ + my $ticket = RT::Ticket->new( $RT::SystemUser ); + $ticket->Create( + Queue => $queue->id, + Subject => 'test', + Requestor => 'root@localhost', + ); + my @mails = RT::Test->fetch_caught_mails; + ok @mails, "got some outgoing emails"; + + my $status = 1; + foreach my $mail ( @mails ) { + my $entity = parse_mail( $mail ); + my $subject = Encode::decode_utf8( $entity->head->get('Subject') ); + $subject =~ /$str_ru_support/ + or do { $status = 0; diag "wrong subject: $subject" }; + } + ok $status, "all mails have correct data"; +} + +diag "non-ascii subject with non-ascii subject tag" if $ENV{'TEST_VERBOSE'}; +{ + my $ticket = RT::Ticket->new( $RT::SystemUser ); + $ticket->Create( + Queue => $queue->id, + Subject => $str_ru_test, + Requestor => 'root@localhost', + ); + my @mails = RT::Test->fetch_caught_mails; + ok @mails, "got some outgoing emails"; + + my $status = 1; + foreach my $mail ( @mails ) { + my $entity = parse_mail( $mail ); + my $subject = Encode::decode_utf8( $entity->head->get('Subject') ); + $subject =~ /$str_ru_support/ + or do { $status = 0; diag "wrong subject: $subject" }; + $subject =~ /$str_ru_test/ + or do { $status = 0; diag "wrong subject: $subject" }; + } + ok $status, "all mails have correct data"; +} + +diag "return back the empty subject tag" if $ENV{'TEST_VERBOSE'}; +{ + my ($status, $msg) = $queue->SetSubjectTag( undef ); + ok $status, "set subject tag for the queue" or diag "error: $msg"; +} + +diag "add non-ascii subject prefix in the autoreply template" if $ENV{'TEST_VERBOSE'}; +{ + my $template = RT::Template->new( $RT::SystemUser ); + $template->Load('Autoreply'); + ok $template->id, "loaded autoreply tempalte"; + + my ($status, $msg) = $template->SetContent( + "Subject: $str_ru_autoreply { \$Ticket->Subject }\n" + ."\n" + ."hi there it's an autoreply.\n" + ."\n" + ); + 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'}; +{ + my $ticket = RT::Ticket->new( $RT::SystemUser ); + $ticket->Create( + Queue => $queue->id, + Subject => 'test', + Requestor => 'root@localhost', + ); + my @mails = RT::Test->fetch_caught_mails; + ok @mails, "got some outgoing emails"; + + my $status = 1; + foreach my $mail ( @mails ) { + my $entity = parse_mail( $mail ); + my $subject = Encode::decode_utf8( $entity->head->get('Subject') ); + $subject =~ /$str_ru_autoreply/ + or do { $status = 0; diag "wrong subject: $subject" }; + } + ok $status, "all mails have correct data"; +} + +diag "non-ascii subject with non-ascii subject prefix in template" + if $ENV{'TEST_VERBOSE'}; +{ + my $ticket = RT::Ticket->new( $RT::SystemUser ); + $ticket->Create( + Queue => $queue->id, + Subject => $str_ru_test, + Requestor => 'root@localhost', + ); + my @mails = RT::Test->fetch_caught_mails; + ok @mails, "got some outgoing emails"; + + my $status = 1; + foreach my $mail ( @mails ) { + my $entity = parse_mail( $mail ); + my $subject = Encode::decode_utf8( $entity->head->get('Subject') ); + $subject =~ /$str_ru_autoreply/ + or do { $status = 0; diag "wrong subject: $subject" }; + $subject =~ /$str_ru_autoreply/ + or do { $status = 0; diag "wrong subject: $subject" }; + } + ok $status, "all mails have correct data"; +} + +diag "set non-ascii subject tag for the queue" if $ENV{'TEST_VERBOSE'}; +{ + my ($status, $msg) = $queue->SetSubjectTag( $str_ru_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'}; +{ + my $ticket = RT::Ticket->new( $RT::SystemUser ); + $ticket->Create( + Queue => $queue->id, + Subject => $str_ru_test, + Requestor => 'root@localhost', + ); + my @mails = RT::Test->fetch_caught_mails; + ok @mails, "got some outgoing emails"; + + my $status = 1; + foreach my $mail ( @mails ) { + my $entity = parse_mail( $mail ); + my $subject = Encode::decode_utf8( $entity->head->get('Subject') ); + $subject =~ /$str_ru_autoreply/ + or do { $status = 0; diag "wrong subject: $subject" }; + $subject =~ /$str_ru_autoreply/ + or do { $status = 0; diag "wrong subject: $subject" }; + $subject =~ /$str_ru_autoreply/ + or do { $status = 0; diag "wrong subject: $subject" }; + } + ok $status, "all mails have correct data"; +} + +diag "flush subject tag of the queue" if $ENV{'TEST_VERBOSE'}; +{ + my ($status, $msg) = $queue->SetSubjectTag( undef ); + ok $status, "set subject tag for the queue" or diag "error: $msg"; +} + + +diag "don't change subject via template" if $ENV{'TEST_VERBOSE'}; +{ + my $template = RT::Template->new( $RT::SystemUser ); + $template->Load('Autoreply'); + ok $template->id, "loaded autoreply tempalte"; + + my ($status, $msg) = $template->SetContent( + "\n" + ."\n" + ."hi there it's an autoreply.\n" + ."\n" + ); + ok $status, "changed content of the template" or diag "error: $msg"; +} + +diag "non-ascii Subject without changes in template" if $ENV{'TEST_VERBOSE'}; +{ + my $ticket = RT::Ticket->new( $RT::SystemUser ); + $ticket->Create( + Queue => $queue->id, + Subject => $str_ru_test, + Requestor => 'root@localhost', + ); + my @mails = RT::Test->fetch_caught_mails; + ok @mails, "got some outgoing emails"; + + my $status = 1; + foreach my $mail ( @mails ) { + my $entity = parse_mail( $mail ); + my $subject = Encode::decode_utf8( $entity->head->get('Subject') ); + $subject =~ /$str_ru_test/ + or do { $status = 0; diag "wrong subject: $subject" }; + } + ok $status, "all mails have correct data"; +} + +diag "set non-ascii subject tag for the queue" if $ENV{'TEST_VERBOSE'}; +{ + my ($status, $msg) = $queue->SetSubjectTag( $str_ru_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'}; +{ + my $ticket = RT::Ticket->new( $RT::SystemUser ); + $ticket->Create( + Queue => $queue->id, + Subject => $str_ru_test, + Requestor => 'root@localhost', + ); + my @mails = RT::Test->fetch_caught_mails; + ok @mails, "got some outgoing emails"; + + my $status = 1; + foreach my $mail ( @mails ) { + my $entity = parse_mail( $mail ); + my $subject = Encode::decode_utf8( $entity->head->get('Subject') ); + $subject =~ /$str_ru_test/ + or do { $status = 0; diag "wrong subject: $subject" }; + $subject =~ /$str_ru_support/ + or do { $status = 0; diag "wrong subject: $subject" }; + } + ok $status, "all mails have correct data"; +} + +sub parse_mail { + my $mail = shift; + require RT::EmailParser; + my $parser = new RT::EmailParser; + $parser->ParseMIMEEntityFromScalar( $mail ); + return $parser->Entity; +} + diff --git a/rt/t/mail/crypt-gnupg.t b/rt/t/mail/crypt-gnupg.t new file mode 100644 index 000000000..f33fbab1c --- /dev/null +++ b/rt/t/mail/crypt-gnupg.t @@ -0,0 +1,312 @@ +#!/usr/bin/perl + +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) ); + +mkdir $homedir; + +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'}; +{ + my $entity = MIME::Entity->build( + From => 'rt@example.com', + Subject => 'test', + Data => ['test'], + ); + my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Encrypt => 0, Passphrase => 'test' ); + ok( $entity, 'signed entity'); + ok( !$res{'logger'}, "log is here as well" ) or diag $res{'logger'}; + my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} ); + is( scalar @status, 2, 'two records: passphrase, signing'); + is( $status[0]->{'Operation'}, 'PassphraseCheck', 'operation is correct'); + is( $status[0]->{'Status'}, 'DONE', 'good passphrase'); + is( $status[1]->{'Operation'}, 'Sign', 'operation is correct'); + is( $status[1]->{'Status'}, 'DONE', 'done'); + is( $status[1]->{'User'}->{'EmailAddress'}, 'rt@example.com', 'correct email'); + + ok( $entity->is_multipart, 'signed message is multipart' ); + is( $entity->parts, 2, 'two parts' ); + + my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity ); + is( scalar @parts, 1, 'one protected part' ); + is( $parts[0]->{'Type'}, 'signed', "have signed part" ); + is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" ); + is( $parts[0]->{'Top'}, $entity, "it's the same entity" ); + + my @res = RT::Crypt::GnuPG::VerifyDecrypt( Entity => $entity ); + is scalar @res, 1, 'one operation'; + @status = RT::Crypt::GnuPG::ParseStatus( $res[0]{'status'} ); + is( scalar @status, 1, 'one record'); + is( $status[0]->{'Operation'}, 'Verify', 'operation is correct'); + is( $status[0]->{'Status'}, 'DONE', 'good passphrase'); + is( $status[0]->{'Trust'}, 'ULTIMATE', 'have trust value'); +} + +diag 'only signing. missing passphrase' if $ENV{'TEST_VERBOSE'}; +{ + my $entity = MIME::Entity->build( + From => 'rt@example.com', + Subject => 'test', + Data => ['test'], + ); + my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Encrypt => 0, Passphrase => '' ); + ok( $res{'exit_code'}, "couldn't sign without passphrase"); + ok( $res{'error'} || $res{'logger'}, "error is here" ); + + my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} ); + is( scalar @status, 1, 'one record'); + is( $status[0]->{'Operation'}, 'PassphraseCheck', 'operation is correct'); + is( $status[0]->{'Status'}, 'MISSING', 'missing passphrase'); +} + +diag 'only signing. wrong passphrase' if $ENV{'TEST_VERBOSE'}; +{ + 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' ); + ok( $res{'exit_code'}, "couldn't sign with bad passphrase"); + ok( $res{'error'} || $res{'logger'}, "error is here" ); + + my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} ); + is( scalar @status, 1, 'one record'); + is( $status[0]->{'Operation'}, 'PassphraseCheck', 'operation is correct'); + is( $status[0]->{'Status'}, 'BAD', 'wrong passphrase'); +} + +diag 'encryption only' if $ENV{'TEST_VERBOSE'}; +{ + my $entity = MIME::Entity->build( + From => 'rt@example.com', + To => 'rt@example.com', + Subject => 'test', + Data => ['test'], + ); + my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 ); + ok( !$res{'exit_code'}, "successful encryption" ); + ok( !$res{'logger'}, "no records in logger" ); + + my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} ); + is( scalar @status, 1, 'one record'); + is( $status[0]->{'Operation'}, 'Encrypt', 'operation is correct'); + is( $status[0]->{'Status'}, 'DONE', 'done'); + + ok($entity, 'get an encrypted part'); + + my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity ); + is( scalar @parts, 1, 'one protected part' ); + is( $parts[0]->{'Type'}, 'encrypted', "have encrypted part" ); + is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" ); + is( $parts[0]->{'Top'}, $entity, "it's the same entity" ); +} + +diag 'encryption only, bad recipient' if $ENV{'TEST_VERBOSE'}; +{ + my $entity = MIME::Entity->build( + From => 'rt@example.com', + To => 'keyless@example.com', + Subject => 'test', + Data => ['test'], + ); + my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 ); + ok( $res{'exit_code'}, 'no way to encrypt without keys of recipients'); + ok( $res{'logger'}, "errors are in logger" ); + + my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} ); + is( scalar @status, 1, 'one record'); + is( $status[0]->{'Keyword'}, 'INV_RECP', 'invalid recipient'); +} + +diag 'encryption and signing with combined method' if $ENV{'TEST_VERBOSE'}; +{ + my $entity = MIME::Entity->build( + From => 'rt@example.com', + To => 'rt@example.com', + Subject => 'test', + Data => ['test'], + ); + my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Passphrase => 'test' ); + ok( !$res{'exit_code'}, "successful encryption with signing" ); + ok( !$res{'logger'}, "no records in logger" ); + + my @status = RT::Crypt::GnuPG::ParseStatus( $res{'status'} ); + is( scalar @status, 3, 'three records: passphrase, sign and encrypt'); + is( $status[0]->{'Operation'}, 'PassphraseCheck', 'operation is correct'); + is( $status[0]->{'Status'}, 'DONE', 'done'); + is( $status[1]->{'Operation'}, 'Sign', 'operation is correct'); + is( $status[1]->{'Status'}, 'DONE', 'done'); + is( $status[2]->{'Operation'}, 'Encrypt', 'operation is correct'); + is( $status[2]->{'Status'}, 'DONE', 'done'); + + ok($entity, 'get an encrypted and signed part'); + + my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity ); + is( scalar @parts, 1, 'one protected part' ); + is( $parts[0]->{'Type'}, 'encrypted', "have encrypted part" ); + is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" ); + is( $parts[0]->{'Top'}, $entity, "it's the same entity" ); +} + +diag 'encryption and signing with cascading, sign on encrypted' if $ENV{'TEST_VERBOSE'}; +{ + my $entity = MIME::Entity->build( + From => 'rt@example.com', + To => 'rt@example.com', + Subject => 'test', + Data => ['test'], + ); + my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 ); + ok( !$res{'exit_code'}, 'successful encryption' ); + ok( !$res{'logger'}, "no records in logger" ); + %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Encrypt => 0, Passphrase => 'test' ); + ok( !$res{'exit_code'}, 'successful signing' ); + ok( !$res{'logger'}, "no records in logger" ); + + my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity ); + is( scalar @parts, 1, 'one protected part, top most' ); + is( $parts[0]->{'Type'}, 'signed', "have signed part" ); + is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" ); + is( $parts[0]->{'Top'}, $entity, "it's the same entity" ); +} + +diag 'find signed/encrypted part deep inside' if $ENV{'TEST_VERBOSE'}; +{ + my $entity = MIME::Entity->build( + From => 'rt@example.com', + To => 'rt@example.com', + Subject => 'test', + Data => ['test'], + ); + my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 ); + ok( !$res{'exit_code'}, "success" ); + $entity->make_multipart( 'mixed', Force => 1 ); + $entity->attach( + Type => 'text/plain', + Data => ['-'x76, 'this is mailing list'], + ); + + my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity ); + is( scalar @parts, 1, 'one protected part' ); + is( $parts[0]->{'Type'}, 'encrypted', "have encrypted part" ); + is( $parts[0]->{'Format'}, 'RFC3156', "RFC3156 format" ); + is( $parts[0]->{'Top'}, $entity->parts(0), "it's the same entity" ); +} + +diag 'wrong signed/encrypted parts: no protocol' if $ENV{'TEST_VERBOSE'}; +{ + my $entity = MIME::Entity->build( + From => 'rt@example.com', + To => 'rt@example.com', + Subject => 'test', + Data => ['test'], + ); + 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 ); + is( scalar @parts, 0, 'no protected parts' ); +} + +diag 'wrong signed/encrypted parts: not enought parts' if $ENV{'TEST_VERBOSE'}; +{ + my $entity = MIME::Entity->build( + From => 'rt@example.com', + To => 'rt@example.com', + Subject => 'test', + Data => ['test'], + ); + 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 ); + is( scalar @parts, 0, 'no protected parts' ); +} + +diag 'wrong signed/encrypted parts: wrong proto' if $ENV{'TEST_VERBOSE'}; +{ + my $entity = MIME::Entity->build( + From => 'rt@example.com', + To => 'rt@example.com', + Subject => 'test', + Data => ['test'], + ); + my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Sign => 0 ); + ok( !$res{'exit_code'}, 'success' ); + $entity->head->mime_attr( 'Content-Type.protocol' => 'application/bad-proto' ); + + my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity ); + is( scalar @parts, 0, 'no protected parts' ); +} + +diag 'wrong signed/encrypted parts: wrong proto' if $ENV{'TEST_VERBOSE'}; +{ + my $entity = MIME::Entity->build( + From => 'rt@example.com', + To => 'rt@example.com', + Subject => 'test', + Data => ['test'], + ); + my %res = RT::Crypt::GnuPG::SignEncrypt( Entity => $entity, Encrypt => 0, Passphrase => 'test' ); + ok( !$res{'exit_code'}, 'success' ); + $entity->head->mime_attr( 'Content-Type.protocol' => 'application/bad-proto' ); + + my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity ); + is( scalar @parts, 0, 'no protected parts' ); +} + +diag 'verify inline and in attachment signatures' if $ENV{'TEST_VERBOSE'}; +{ + open my $fh, "$homedir/signed_old_style_with_attachment.eml"; + my $parser = new MIME::Parser; + my $entity = $parser->parse( $fh ); + + my @parts = RT::Crypt::GnuPG::FindProtectedParts( Entity => $entity ); + is( scalar @parts, 2, 'two protected parts' ); + is( $parts[1]->{'Type'}, 'signed', "have signed part" ); + is( $parts[1]->{'Format'}, 'Inline', "inline format" ); + is( $parts[1]->{'Data'}, $entity->parts(0), "it's first part" ); + + is( $parts[0]->{'Type'}, 'signed', "have signed part" ); + is( $parts[0]->{'Format'}, 'Attachment', "attachment format" ); + is( $parts[0]->{'Data'}, $entity->parts(1), "data in second part" ); + is( $parts[0]->{'Signature'}, $entity->parts(2), "file's signature in third part" ); + + my @res = RT::Crypt::GnuPG::VerifyDecrypt( Entity => $entity ); + my @status = RT::Crypt::GnuPG::ParseStatus( $res[0]->{'status'} ); + is( scalar @status, 1, 'one record'); + is( $status[0]->{'Operation'}, 'Verify', 'operation is correct'); + is( $status[0]->{'Status'}, 'DONE', 'good passphrase'); + is( $status[0]->{'Trust'}, 'ULTIMATE', 'have trust value'); + + $parser->filer->purge(); +} + diff --git a/rt/t/mail/extractsubjecttag.t b/rt/t/mail/extractsubjecttag.t new file mode 100644 index 000000000..5a2548883 --- /dev/null +++ b/rt/t/mail/extractsubjecttag.t @@ -0,0 +1,98 @@ +#!/usr/bin/perl +use strict; +use warnings; +use utf8; + +use RT::Test tests => 14; + + +my ($baseurl, $m) = RT::Test->started_ok; +RT::Test->set_mail_catcher; + +my $queue = RT::Test->load_or_create_queue( + Name => 'Regression', + CorrespondAddress => 'rt-recipient@example.com', + CommentAddress => 'rt-recipient@example.com', +); +my $subject_tag = 'Windows/Servers-Desktops'; +ok $queue && $queue->id, 'loaded or created queue'; + +diag "Set Subject Tag" if $ENV{'TEST_VERBOSE'}; +{ + is(RT->System->SubjectTag($queue), undef, 'No Subject Tag yet'); + my ($status, $msg) = $queue->SetSubjectTag( $subject_tag ); + ok $status, "set subject tag for the queue" or diag "error: $msg"; + 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'}; +{ + $original_ticket->Create( + Queue => $queue->id, + Subject => 'test', + Requestor => 'root@localhost' + ); + my @mails = RT::Test->fetch_caught_mails; + ok @mails, "got some outgoing emails"; + + my $status = 1; + foreach my $mail ( @mails ) { + my $entity = parse_mail( $mail ); + my $subject = $entity->head->get('Subject'); + $subject =~ /\[\Q$subject_tag\E #\d+\]/ + or do { $status = 0; diag "wrong subject: $subject" }; + } + ok $status, "Correctly added subject tag to ticket"; +} + + +diag "Test that a reply with a Subject Tag doesn't change the subject" if $ENV{'TEST_VERBOSE'}; +{ + my $ticketid = $original_ticket->Id; + my $text = <<EOF; +From: root\@localhost +To: general\@$RT::rtname +Subject: [$subject_tag #$ticketid] test + +reply with subject tag +EOF + 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 ); + $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'}; +{ + my $ticketid = $original_ticket->Id; + my $text = <<EOF; +From: root\@localhost +To: general\@$RT::rtname +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 ); + $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'); + +} + +sub parse_mail { + my $mail = shift; + require RT::EmailParser; + my $parser = new RT::EmailParser; + $parser->ParseMIMEEntityFromScalar( $mail ); + return $parser->Entity; +} diff --git a/rt/t/mail/gateway.t b/rt/t/mail/gateway.t new file mode 100644 index 000000000..00de1ec7f --- /dev/null +++ b/rt/t/mail/gateway.t @@ -0,0 +1,802 @@ +#!/usr/bin/perl -w +# BEGIN BPS TAGGED BLOCK {{{ +# +# COPYRIGHT: +# +# This software is Copyright (c) 1996-2004 Best Practical Solutions, LLC +# <jesse.com> +# +# (Except where explicitly superseded by other copyright notices) +# +# +# LICENSE: +# +# This work is made available to you under the terms of Version 2 of +# the GNU General Public License. A copy of that license should have +# been provided with this software, but in any event can be snarfed +# from www.gnu.org. +# +# This work is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA +# 02110-1301 or visit their web page on the internet at +# http://www.gnu.org/copyleft/gpl.html. +# +# +# CONTRIBUTION SUBMISSION POLICY: +# +# (The following paragraph is not intended to limit the rights granted +# to you to modify and distribute this software under the terms of +# the GNU General Public License and is only of importance to you if +# you choose to contribute your changes and enhancements to the +# community by submitting them to Best Practical Solutions, LLC.) +# +# By intentionally submitting any modifications, corrections or +# derivatives to this work, or any other work intended for use with +# Request Tracker, to Best Practical Solutions, LLC, you confirm that +# you are the copyright holder for those contributions and you grant +# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, +# royalty-free, perpetual, license to use, copy, create derivative +# works based on those contributions, and sublicense and distribute +# 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 config => 'Set( $UnsafeEmailCommands, 1);', tests => 159; +my ($baseurl, $m) = RT::Test->started_ok; + +use RT::Tickets; + +use MIME::Entity; +use Digest::MD5 qw(md5_base64); +use LWP::UserAgent; + +# TODO: --extension queue + +my $url = $m->rt_base_url; + +diag "Make sure that when we call the mailgate without URL, it fails" if $ENV{'TEST_VERBOSE'}; +{ + my $text = <<EOF; +From: root\@localhost +To: rt\@@{[RT->Config->Get('rtname')]} +Subject: This is a test of new ticket creation + +Foob! +EOF + my ($status, $id) = RT::Test->send_via_mailgate($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"; +} + +diag "Make sure that when we call the mailgate with wrong URL, it tempfails" if $ENV{'TEST_VERBOSE'}; +{ + my $text = <<EOF; +From: root\@localhost +To: rt\@@{[RT->Config->Get('rtname')]} +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'); + is ($status >> 8, 75, "The mail gateway exited with a failure"); + ok (!$id, "No ticket id"); +} + +my $everyone_group; +diag "revoke rights tests depend on" if $ENV{'TEST_VERBOSE'}; +{ + $everyone_group = RT::Group->new( $RT::SystemUser ); + $everyone_group->LoadSystemInternalGroup( 'Everyone' ); + ok ($everyone_group->Id, "Found group 'everyone'"); + + foreach( qw(CreateTicket ReplyToTicket CommentOnTicket) ) { + $everyone_group->PrincipalObj->RevokeRight(Right => $_); + } +} + +diag "Test new ticket creation by root who is privileged and superuser" if $ENV{'TEST_VERBOSE'}; +{ + my $text = <<EOF; +From: root\@localhost +To: rt\@@{[RT->Config->Get('rtname')]} +Subject: This is a test of new ticket creation + +Blah! +Foob! +EOF + + my ($status, $id) = RT::Test->send_via_mailgate($text); + is ($status >> 8, 0, "The mail gateway exited normally"); + ok ($id, "Created ticket"); + + my $tick = RT::Test->last_ticket; + 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"); +} + +diag "Test the 'X-RT-Mail-Extension' field in the header of a ticket" if $ENV{'TEST_VERBOSE'}; +{ + my $text = <<EOF; +From: root\@localhost +To: rt\@@{[RT->Config->Get('rtname')]} +Subject: This is a test of the X-RT-Mail-Extension field +Blah! +Foob! +EOF + local $ENV{'EXTENSION'} = "bad value with\nnewlines\n"; + my ($status, $id) = RT::Test->send_via_mailgate($text); + is ($status >> 8, 0, "The mail gateway exited normally"); + ok ($id, "Created ticket #$id"); + + my $tick = RT::Test->last_ticket; + isa_ok ($tick, 'RT::Ticket'); + is ($tick->Id, $id, "correct ticket id"); + is ($tick->Subject, 'This is a test of the X-RT-Mail-Extension field', "Created the ticket"); + + my $transactions = $tick->Transactions; + $transactions->OrderByCols({ FIELD => 'id', ORDER => 'DESC' }); + $transactions->Limit( FIELD => 'Type', OPERATOR => '!=', VALUE => 'EmailRecord'); + my $txn = $transactions->First; + isa_ok ($txn, 'RT::Transaction'); + is ($txn->Type, 'Create', "correct type"); + + my $attachment = $txn->Attachments->First; + isa_ok ($attachment, 'RT::Attachment'); + # XXX: We eat all newlines in header, that's not what RFC's suggesting + is ( + $attachment->GetHeader('X-RT-Mail-Extension'), + "bad value with newlines", + 'header is in place, without trailing newline char' + ); +} + +diag "Make sure that not standard --extension is passed" if $ENV{'TEST_VERBOSE'}; +{ + my $text = <<EOF; +From: root\@localhost +To: rt\@@{[RT->Config->Get('rtname')]} +Subject: This is a test of new ticket creation + +Foob! +EOF + my ($status, $id) = RT::Test->send_via_mailgate($text, extension => 'some-extension-arg' ); + is ($status >> 8, 0, "The mail gateway exited normally"); + ok ($id, "Created ticket #$id"); + + my $tick = RT::Test->last_ticket; + isa_ok ($tick, 'RT::Ticket'); + is ($tick->Id, $id, "correct ticket id"); + + my $transactions = $tick->Transactions; + $transactions->OrderByCols({ FIELD => 'id', ORDER => 'DESC' }); + $transactions->Limit( FIELD => 'Type', OPERATOR => '!=', VALUE => 'EmailRecord'); + my $txn = $transactions->First; + isa_ok ($txn, 'RT::Transaction'); + is ($txn->Type, 'Create', "correct type"); + + my $attachment = $txn->Attachments->First; + isa_ok ($attachment, 'RT::Attachment'); + is ( + $attachment->GetHeader('X-RT-Mail-Extension'), + 'some-extension-arg', + 'header is in place' + ); +} + +diag "Test new ticket creation without --action argument" if $ENV{'TEST_VERBOSE'}; +{ + my $text = <<EOF; +From: root\@localhost +To: rt\@$RT::rtname +Subject: using mailgate without --action arg + +Blah! +Foob! +EOF + my ($status, $id) = RT::Test->send_via_mailgate($text, extension => 'some-extension-arg' ); + is ($status >> 8, 0, "The mail gateway exited normally"); + ok ($id, "Created ticket #$id"); + + my $tick = RT::Test->last_ticket; + 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"); +} + +diag "This is a test of new ticket creation as an unknown user" if $ENV{'TEST_VERBOSE'}; +{ + my $text = <<EOF; +From: doesnotexist\@@{[RT->Config->Get('rtname')]} +To: rt\@@{[RT->Config->Get('rtname')]} +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); + is ($status >> 8, 0, "The mail gateway exited normally"); + ok (!$id, "no ticket created"); + + my $tick = RT::Test->last_ticket; + isa_ok ($tick, 'RT::Ticket'); + 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); + $u->Load("doesnotexist\@@{[RT->Config->Get('rtname')]}"); + ok( !$u->Id, "user does not exist and was not created by failed ticket submission"); +} + +diag "grant everybody with CreateTicket right" if $ENV{'TEST_VERBOSE'}; +{ + ok( RT::Test->set_rights( + { Principal => $everyone_group->PrincipalObj, + Right => [qw(CreateTicket)], + }, + ), "Granted everybody the right to create tickets"); +} + +my $ticket_id; +diag "now everybody can create tickets. can a random unkown user create tickets?" if $ENV{'TEST_VERBOSE'}; +{ + my $text = <<EOF; +From: doesnotexist\@@{[RT->Config->Get('rtname')]} +To: rt\@@{[RT->Config->Get('rtname')]} +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); + is ($status >> 8, 0, "The mail gateway exited normally"); + ok ($id, "ticket created"); + + my $tick = RT::Test->last_ticket; + isa_ok ($tick, 'RT::Ticket'); + ok ($tick->Id, "found ticket ".$tick->Id); + 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 ); + $u->Load( "doesnotexist\@@{[RT->Config->Get('rtname')]}" ); + ok ($u->Id, "user does not exist and was created by ticket submission"); + $ticket_id = $id; +} + +diag "can another random reply to a ticket without being granted privs? answer should be no." if $ENV{'TEST_VERBOSE'}; +{ + my $text = <<EOF; +From: doesnotexist-2\@@{[RT->Config->Get('rtname')]} +To: rt\@@{[RT->Config->Get('rtname')]} +Subject: [@{[RT->Config->Get('rtname')]} #$ticket_id] This is a test of a reply as an unknown user + +Blah! (Should not work.) +Foob! +EOF + my ($status, $id) = RT::Test->send_via_mailgate($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); + $u->Load('doesnotexist-2@'.RT->Config->Get('rtname')); + ok( !$u->Id, " user does not exist and was not created by ticket correspondence submission"); +} + +diag "grant everyone 'ReplyToTicket' right" if $ENV{'TEST_VERBOSE'}; +{ + ok( RT::Test->set_rights( + { Principal => $everyone_group->PrincipalObj, + Right => [qw(CreateTicket ReplyToTicket)], + }, + ), "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'}; +{ + my $text = <<EOF; +From: doesnotexist-2\@@{[RT->Config->Get('rtname')]} +To: rt\@@{[RT->Config->Get('rtname')]} +Subject: [@{[RT->Config->Get('rtname')]} #$ticket_id] This is a test of a reply as an unknown user + +Blah! +Foob! +EOF + my ($status, $id) = RT::Test->send_via_mailgate($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); + $u->Load('doesnotexist-2@'.RT->Config->Get('rtname')); + ok ($u->Id, "user exists and was created by ticket correspondence submission"); +} + +diag "add a reply to the ticket using '--extension ticket' feature" if $ENV{'TEST_VERBOSE'}; +{ + my $text = <<EOF; +From: doesnotexist-2\@@{[RT->Config->Get('rtname')]} +To: rt\@@{[RT->Config->Get('rtname')]} +Subject: This is a test of a reply as an unknown user + +Blah! +Foob! +EOF + local $ENV{'EXTENSION'} = $ticket_id; + my ($status, $id) = RT::Test->send_via_mailgate($text, extension => 'ticket'); + is ($status >> 8, 0, "The mail gateway exited normally"); + is ($id, $ticket_id, "replied to the ticket"); + + my $tick = RT::Test->last_ticket; + isa_ok ($tick, 'RT::Ticket'); + ok ($tick->Id, "found ticket ".$tick->Id); + is ($tick->Id, $id, "correct ticket id"); + + my $transactions = $tick->Transactions; + $transactions->OrderByCols({ FIELD => 'id', ORDER => 'DESC' }); + $transactions->Limit( FIELD => 'Type', OPERATOR => '!=', VALUE => 'EmailRecord'); + my $txn = $transactions->First; + isa_ok ($txn, 'RT::Transaction'); + is ($txn->Type, 'Correspond', "correct type"); + + my $attachment = $txn->Attachments->First; + isa_ok ($attachment, 'RT::Attachment'); + is ($attachment->GetHeader('X-RT-Mail-Extension'), $id, 'header is in place'); +} + +diag "can another random comment on a ticket without being granted privs? answer should be no" if $ENV{'TEST_VERBOSE'}; +{ + my $text = <<EOF; +From: doesnotexist-3\@@{[RT->Config->Get('rtname')]} +To: rt\@@{[RT->Config->Get('rtname')]} +Subject: [@{[RT->Config->Get('rtname')]} #$ticket_id] This is a test of a comment as an unknown user + +Blah! (Should not work.) +Foob! +EOF + my ($status, $id) = RT::Test->send_via_mailgate($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); + $u->Load('doesnotexist-3@'.RT->Config->Get('rtname')); + ok( !$u->Id, " user does not exist and was not created by ticket comment submission"); +} + + +diag "grant everyone 'CommentOnTicket' right" if $ENV{'TEST_VERBOSE'}; +{ + ok( RT::Test->set_rights( + { Principal => $everyone_group->PrincipalObj, + Right => [qw(CreateTicket ReplyToTicket CommentOnTicket)], + }, + ), "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'}; +{ + my $text = <<EOF; +From: doesnotexist-3\@@{[RT->Config->Get('rtname')]} +To: rt\@@{[RT->Config->Get('rtname')]} +Subject: [@{[RT->Config->Get('rtname')]} #$ticket_id] This is a test of a comment as an unknown user + +Blah! +Foob! +EOF + my ($status, $id) = RT::Test->send_via_mailgate($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); + $u->Load('doesnotexist-3@'.RT->Config->Get('rtname')); + ok ($u->Id, " user exists and was created by ticket comment submission"); +} + +diag "add comment to the ticket using '--extension action' feature" if $ENV{'TEST_VERBOSE'}; +{ + my $text = <<EOF; +From: doesnotexist-3\@@{[RT->Config->Get('rtname')]} +To: rt\@@{[RT->Config->Get('rtname')]} +Subject: [@{[RT->Config->Get('rtname')]} #$ticket_id] This is a test of a comment via '--extension action' + +Blah! +Foob! +EOF + local $ENV{'EXTENSION'} = 'comment'; + my ($status, $id) = RT::Test->send_via_mailgate($text, extension => 'action'); + is ($status >> 8, 0, "The mail gateway exited normally"); + is ($id, $ticket_id, "added comment to the ticket"); + + my $tick = RT::Test->last_ticket; + isa_ok ($tick, 'RT::Ticket'); + ok ($tick->Id, "found ticket ".$tick->Id); + is ($tick->Id, $id, "correct ticket id"); + + my $transactions = $tick->Transactions; + $transactions->OrderByCols({ FIELD => 'id', ORDER => 'DESC' }); + $transactions->Limit( + FIELD => 'Type', + OPERATOR => 'NOT ENDSWITH', + VALUE => 'EmailRecord', + ENTRYAGGREGATOR => 'AND', + ); + my $txn = $transactions->First; + isa_ok ($txn, 'RT::Transaction'); + is ($txn->Type, 'Comment', "correct type"); + + my $attachment = $txn->Attachments->First; + isa_ok ($attachment, 'RT::Attachment'); + is ($attachment->GetHeader('X-RT-Mail-Extension'), 'comment', 'header is in place'); +} + +diag "Testing preservation of binary attachments" if $ENV{'TEST_VERBOSE'}; +{ + # Get a binary blob (Best Practical logo) + my $LOGO_FILE = $RT::MasonComponentRoot .'/NoAuth/images/bplogo.gif'; + + # Create a mime entity with an attachment + my $entity = MIME::Entity->build( + From => 'root@localhost', + To => 'rt@localhost', + Subject => 'binary attachment test', + Data => ['This is a test of a binary attachment'], + ); + + $entity->attach( + Path => $LOGO_FILE, + Type => 'image/gif', + Encoding => 'base64', + ); + # Create a ticket with a binary attachment + my ($status, $id) = RT::Test->send_via_mailgate($entity); + is ($status >> 8, 0, "The mail gateway exited normally"); + ok ($id, "created ticket"); + + my $tick = RT::Test->last_ticket; + isa_ok ($tick, 'RT::Ticket'); + ok ($tick->Id, "found ticket ".$tick->Id); + is ($tick->Id, $id, "correct ticket id"); + is ($tick->Subject , 'binary attachment test', "Created the ticket - ".$tick->Id); + + 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'}; + + # 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 $txn_alias = $attachments->Join( + ALIAS1 => 'main', + FIELD1 => 'TransactionId', + TABLE2 => 'Transactions', + FIELD2 => 'id', + ); + $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'); + 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'}; + 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"; + 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'); +} + +diag "Simple I18N testing" if $ENV{'TEST_VERBOSE'}; +{ + my $text = <<EOF; +From: root\@localhost +To: rtemail\@@{[RT->Config->Get('rtname')]} +Subject: This is a test of I18N ticket creation +Content-Type: text/plain; charset="utf-8" + +2 accented lines +\303\242\303\252\303\256\303\264\303\273 +\303\241\303\251\303\255\303\263\303\272 +bye +EOF + my ($status, $id) = RT::Test->send_via_mailgate($text); + is ($status >> 8, 0, "The mail gateway exited normally"); + ok ($id, "created ticket"); + + my $tick = RT::Test->last_ticket; + isa_ok ($tick, 'RT::Ticket'); + ok ($tick->Id, "found ticket ". $tick->Id); + is ($tick->Id, $id, "correct ticket"); + is ($tick->Subject , 'This is a test of I18N ticket creation', "Created the ticket - ". $tick->Subject); + + my $unistring = "\303\241\303\251\303\255\303\263\303\272"; + Encode::_utf8_on($unistring); + is ( + $tick->Transactions->First->Content, + $tick->Transactions->First->Attachments->First->Content, + "Content is ". $tick->Transactions->First->Attachments->First->Content + ); + ok ( + $tick->Transactions->First->Content =~ /$unistring/i, + $tick->Id." appears to be unicode ". $tick->Transactions->First->Attachments->First->Id + ); +} + +diag "supposedly I18N fails on the second message sent in." if $ENV{'TEST_VERBOSE'}; +{ + my $text = <<EOF; +From: root\@localhost +To: rtemail\@@{[RT->Config->Get('rtname')]} +Subject: This is a test of I18N ticket creation +Content-Type: text/plain; charset="utf-8" + +2 accented lines +\303\242\303\252\303\256\303\264\303\273 +\303\241\303\251\303\255\303\263\303\272 +bye +EOF + my ($status, $id) = RT::Test->send_via_mailgate($text); + is ($status >> 8, 0, "The mail gateway exited normally"); + ok ($id, "created ticket"); + + my $tick = RT::Test->last_ticket; + isa_ok ($tick, 'RT::Ticket'); + ok ($tick->Id, "found ticket ". $tick->Id); + is ($tick->Id, $id, "correct ticket"); + is ($tick->Subject , 'This is a test of I18N ticket creation', "Created the ticket"); + + my $unistring = "\303\241\303\251\303\255\303\263\303\272"; + Encode::_utf8_on($unistring); + + ok ( + $tick->Transactions->First->Content =~ $unistring, + "It appears to be unicode - ". $tick->Transactions->First->Content + ); +} + +diag "check that mailgate doesn't suffer from empty Reply-To:" if $ENV{'TEST_VERBOSE'}; +{ + my $text = <<EOF; +From: root\@localhost +Reply-To: +To: rtemail\@@{[RT->Config->Get('rtname')]} +Subject: test +Content-Type: text/plain; charset="utf-8" + +test +EOF + my ($status, $id) = RT::Test->send_via_mailgate($text); + is ($status >> 8, 0, "The mail gateway exited normally"); + ok ($id, "created ticket"); + + my $tick = RT::Test->last_ticket; + isa_ok ($tick, 'RT::Ticket'); + ok ($tick->Id, "found ticket ". $tick->Id); + is ($tick->Id, $id, "correct ticket"); + + like $tick->RequestorAddresses, qr/root\@localhost/, 'correct requestor'; +} + + +my ($val,$msg) = $everyone_group->PrincipalObj->RevokeRight(Right => 'CreateTicket'); +ok ($val, $msg); + +SKIP: { +skip "Advanced mailgate actions require an unsafe configuration", 47 + unless RT->Config->Get('UnsafeEmailCommands'); + +# create new queue to be shure we don't mess with rights +use RT::Queue; +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 ($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' ); + +$! = 0; +ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $url --queue ext-mailgate --action take"), "Opened the mailgate - $!"); +print MAIL <<EOF; +From: root\@localhost +Subject: [@{[RT->Config->Get('rtname')]} \#$id] test + +EOF +close (MAIL); +is ($? >> 8, 0, "The mail gateway exited normally"); + +$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'); + +# check that there is no text transactions writen +is( $tick->Transactions->Count, 2, 'no superfluous transactions'); + +my $status; +($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'); + + +$! = 0; +ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $url --queue ext-mailgate --action take-correspond"), "Opened the mailgate - $@"); +print MAIL <<EOF; +From: root\@localhost +Subject: [@{[RT->Config->Get('rtname')]} \#$id] correspondence + +test +EOF +close (MAIL); +is ($? >> 8, 0, "The mail gateway exited normally"); + +DBIx::SearchBuilder::Record::Cachable->FlushCache; + +$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'); +my $txns = $tick->Transactions; +$txns->Limit( FIELD => 'Type', VALUE => 'Correspond'); +$txns->OrderBy( FIELD => 'id', ORDER => 'DESC' ); +# +1 because of auto open +is( $tick->Transactions->Count, 6, 'no superfluous transactions'); +is( $txns->First->Subject, "[$RT::rtname \#$id] correspondence", 'successfuly add correspond within take via email' ); + +$! = 0; +ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $url --queue ext-mailgate --action resolve"), "Opened the mailgate - $!"); +print MAIL <<EOF; +From: root\@localhost +Subject: [@{[RT->Config->Get('rtname')]} \#$id] test + +EOF +close (MAIL); +is ($? >> 8, 0, "The mail gateway exited normally"); + +DBIx::SearchBuilder::Record::Cachable->FlushCache; + +$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 ($uid) = $user->Create( Name => 'ext-mailgate', + EmailAddress => 'ext-mailgate@localhost', + Privileged => 1, + Password => 'qwe123', + ); +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); +($id) = $tick->Create( Queue => $qid, Subject => 'test' ); +ok( $id, 'create new ticket' ); + +my $rtname = RT->Config->Get('rtname'); + +$! = 0; +ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $url --queue ext-mailgate --action take"), "Opened the mailgate - $!"); +print MAIL <<EOF; +From: ext-mailgate\@localhost +Subject: [$rtname \#$id] test + +EOF +close (MAIL); +is ( $? >> 8, 0, "mailgate exited normally" ); +DBIx::SearchBuilder::Record::Cachable->FlushCache; + +cmp_ok( $tick->Owner, '!=', $user->id, "we didn't change owner" ); + +($status, $msg) = $user->PrincipalObj->GrantRight( Object => $queue, Right => 'ReplyToTicket' ); +ok( $status, "successfuly granted right: $msg" ); +my $ace_id = $status; +ok( $user->HasRight( Right => 'ReplyToTicket', Object => $tick ), "User can reply to ticket" ); + +$! = 0; +ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $url --queue ext-mailgate --action correspond-take"), "Opened the mailgate - $!"); +print MAIL <<EOF; +From: ext-mailgate\@localhost +Subject: [$rtname \#$id] test + +correspond-take +EOF +close (MAIL); +is ( $? >> 8, 0, "mailgate exited normally" ); +DBIx::SearchBuilder::Record::Cachable->FlushCache; + +cmp_ok( $tick->Owner, '!=', $user->id, "we didn't change owner" ); +is( $tick->Transactions->Count, 3, "one transactions added" ); + +$! = 0; +ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $url --queue ext-mailgate --action take-correspond"), "Opened the mailgate - $!"); +print MAIL <<EOF; +From: ext-mailgate\@localhost +Subject: [$rtname \#$id] test + +correspond-take +EOF +close (MAIL); +is ( $? >> 8, 0, "mailgate exited normally" ); +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" ); + +# revoke ReplyToTicket right +use RT::ACE; +my $ace = RT::ACE->new($RT::SystemUser); +$ace->Load( $ace_id ); +$ace->Delete; +my $acl = RT::ACL->new($RT::SystemUser); +$acl->Limit( FIELD => 'RightName', VALUE => 'ReplyToTicket' ); +$acl->LimitToObject( $RT::System ); +while( my $ace = $acl->Next ) { + $ace->Delete; +} + +ok( !$user->HasRight( Right => 'ReplyToTicket', Object => $tick ), "User can't reply to ticket any more" ); + + +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_id, $msg) = $group->PrincipalObj->GrantRight( Right => 'ReplyToTicket', Object => $queue ); +ok( $ace_id, "Granted queue owners role group with ReplyToTicket right" ); + +($status, $msg) = $user->PrincipalObj->GrantRight( Object => $queue, Right => 'OwnTicket' ); +ok( $status, "successfuly granted right: $msg" ); +($status, $msg) = $user->PrincipalObj->GrantRight( Object => $queue, Right => 'TakeTicket' ); +ok( $status, "successfuly granted right: $msg" ); + +$! = 0; +ok(open(MAIL, "|$RT::BinPath/rt-mailgate --url $url --queue ext-mailgate --action take-correspond"), "Opened the mailgate - $!"); +print MAIL <<EOF; +From: ext-mailgate\@localhost +Subject: [$rtname \#$id] test + +take-correspond with reply right granted to owner role +EOF +close (MAIL); +is ( $? >> 8, 0, "mailgate exited normally" ); +DBIx::SearchBuilder::Record::Cachable->FlushCache; + +$tick->Load( $id ); +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" ); + + +# }}} +}; + + +1; + diff --git a/rt/t/mail/gnupg-bad.t b/rt/t/mail/gnupg-bad.t new file mode 100644 index 000000000..2d8e03575 --- /dev/null +++ b/rt/t/mail/gnupg-bad.t @@ -0,0 +1,58 @@ +#!/usr/bin/perl +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); + +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->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($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}; +} + diff --git a/rt/t/mail/gnupg-incoming.t b/rt/t/mail/gnupg-incoming.t new file mode 100644 index 000000000..ec313330a --- /dev/null +++ b/rt/t/mail/gnupg-incoming.t @@ -0,0 +1,320 @@ +#!/usr/bin/perl +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'); + + +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 +$m->get( $baseurl."?user=root;pass=password" ); +$m->content_like(qr/Logout/, 'we did log in'); +$m->get( $baseurl.'/Admin/Queues/'); +$m->follow_link_ok( {text => 'General'} ); +$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($user->Load('root'), "Loaded user 'root'"); +$user->SetEmailAddress('recipient@example.com'); + +# test simple mail. supposedly this should fail when +# 1. the queue requires signature +# 2. the from is not what the key is associated with +my $mail = RT::Test->open_mailgate_ok($baseurl); +print $mail <<EOF; +From: recipient\@example.com +To: general\@$RT::rtname +Subject: This is a test of new ticket creation as root + +Blah! +Foob! +EOF +RT::Test->close_mailgate_ok($mail); + +{ + my $tick = RT::Test->last_ticket; + is( $tick->Subject, + 'This is a test of new ticket creation as root', + "Created the ticket" + ); + my $txn = $tick->Transactions->First; + like( + $txn->Attachments->First->Headers, + qr/^X-RT-Incoming-Encryption: Not encrypted/m, + 'recorded incoming mail that is not encrypted' + ); + like( $txn->Attachments->First->Content, qr'Blah'); +} + +# test for signed mail +my $buf = ''; + +run3( + shell_quote( + qw(gpg --armor --sign), + '--default-key' => 'recipient@example.com', + '--homedir' => $homedir, + '--passphrase' => 'recipient', + ), + \"fnord\r\n", + \$buf, + \*STDOUT +); + +$mail = RT::Test->open_mailgate_ok($baseurl); +print $mail <<"EOF"; +From: recipient\@example.com +To: general\@$RT::rtname +Subject: signed message for queue + +$buf +EOF +RT::Test->close_mailgate_ok($mail); + +{ + my $tick = RT::Test->last_ticket; + is( $tick->Subject, 'signed message for queue', + "Created the ticket" + ); + + my $txn = $tick->Transactions->First; + my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef}; + + is( $msg->GetHeader('X-RT-Incoming-Encryption'), + 'Not encrypted', + 'recorded incoming mail that is encrypted' + ); + # test for some kind of PGP-Signed-By: Header + like( $attach->Content, qr'fnord'); +} + +# test for clear-signed mail +$buf = ''; + +run3( + shell_quote( + qw(gpg --armor --sign --clearsign), + '--default-key' => 'recipient@example.com', + '--homedir' => $homedir, + '--passphrase' => 'recipient', + ), + \"clearfnord\r\n", + \$buf, + \*STDOUT +); + +$mail = RT::Test->open_mailgate_ok($baseurl); +print $mail <<"EOF"; +From: recipient\@example.com +To: general\@$RT::rtname +Subject: signed message for queue + +$buf +EOF +RT::Test->close_mailgate_ok($mail); + +{ + my $tick = RT::Test->last_ticket; + is( $tick->Subject, 'signed message for queue', + "Created the ticket" + ); + + my $txn = $tick->Transactions->First; + my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef}; + is( $msg->GetHeader('X-RT-Incoming-Encryption'), + 'Not encrypted', + 'recorded incoming mail that is encrypted' + ); + # test for some kind of PGP-Signed-By: Header + like( $attach->Content, qr'clearfnord'); +} + +# test for signed and encrypted mail +$buf = ''; + +run3( + shell_quote( + qw(gpg --encrypt --armor --sign), + '--recipient' => 'general@example.com', + '--default-key' => 'recipient@example.com', + '--homedir' => $homedir, + '--passphrase' => 'recipient', + ), + \"orzzzzzz\r\n", + \$buf, + \*STDOUT +); + +$mail = RT::Test->open_mailgate_ok($baseurl); +print $mail <<"EOF"; +From: recipient\@example.com +To: general\@$RT::rtname +Subject: Encrypted message for queue + +$buf +EOF +RT::Test->close_mailgate_ok($mail); + +{ + my $tick = RT::Test->last_ticket; + is( $tick->Subject, 'Encrypted message for queue', + "Created the ticket" + ); + + my $txn = $tick->Transactions->First; + my ($msg, $attach, $orig) = @{$txn->Attachments->ItemsArrayRef}; + + is( $msg->GetHeader('X-RT-Incoming-Encryption'), + 'Success', + 'recorded incoming mail that is encrypted' + ); + is( $msg->GetHeader('X-RT-Privacy'), + 'PGP', + 'recorded incoming mail that is encrypted' + ); + like( $attach->Content, qr'orz'); + + is( $orig->GetHeader('Content-Type'), 'application/x-rt-original-message'); + ok(index($orig->Content, $buf) != -1, 'found original msg'); +} + +# test for signed mail by other key +$buf = ''; + +run3( + shell_quote( + qw(gpg --armor --sign), + '--default-key' => 'rt@example.com', + '--homedir' => $homedir, + '--passphrase' => 'test', + ), + \"alright\r\n", + \$buf, + \*STDOUT +); + +$mail = RT::Test->open_mailgate_ok($baseurl); +print $mail <<"EOF"; +From: recipient\@example.com +To: general\@$RT::rtname +Subject: signed message for queue + +$buf +EOF +RT::Test->close_mailgate_ok($mail); + +{ + my $tick = RT::Test->last_ticket; + my $txn = $tick->Transactions->First; + my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef}; + # XXX: in this case, which credential should we be using? + is( $msg->GetHeader('X-RT-Incoming-Signature'), + 'Test User <rt@example.com>', + 'recorded incoming mail signed by others' + ); +} + +# test for encrypted mail with key not associated to the queue +$buf = ''; + +run3( + shell_quote( + qw(gpg --armor --encrypt), + '--recipient' => 'random@localhost', + '--homedir' => $homedir, + ), + \"should not be there either\r\n", + \$buf, + \*STDOUT +); + +$mail = RT::Test->open_mailgate_ok($baseurl); +print $mail <<"EOF"; +From: recipient\@example.com +To: general\@$RT::rtname +Subject: encrypted message for queue + +$buf +EOF +RT::Test->close_mailgate_ok($mail); + +{ + my $tick = RT::Test->last_ticket; + my $txn = $tick->Transactions->First; + my ($msg, $attach) = @{$txn->Attachments->ItemsArrayRef}; + + TODO: + { + local $TODO = "this test requires keys associated with queues"; + unlike( $attach->Content, qr'should not be there either'); + } +} + +# test for badly encrypted mail +{ +$buf = ''; + +run3( + shell_quote( + qw(gpg --armor --encrypt), + '--recipient' => 'rt@example.com', + '--homedir' => $homedir, + ), + \"really should not be there either\r\n", + \$buf, + \*STDOUT +); + +$buf =~ s/PGP MESSAGE/SCREWED UP/g; + +RT::Test->fetch_caught_mails; + +$mail = RT::Test->open_mailgate_ok($baseurl); +print $mail <<"EOF"; +From: recipient\@example.com +To: general\@$RT::rtname +Subject: encrypted message for queue + +$buf +EOF +RT::Test->close_mailgate_ok($mail); +my @mail = RT::Test->fetch_caught_mails; +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'); +} + diff --git a/rt/t/mail/gnupg-realmail.t b/rt/t/mail/gnupg-realmail.t new file mode 100644 index 000000000..de1d95815 --- /dev/null +++ b/rt/t/mail/gnupg-realmail.t @@ -0,0 +1,184 @@ +#!/usr/bin/perl +use strict; +use warnings; + +use RT::Test tests => 197; + +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 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'); + +my ($baseurl, $m) = RT::Test->started_ok; +ok $m->login, 'we did log in'; +$m->get_ok( '/Admin/Queues/'); +$m->follow_link_ok( {text => 'General'} ); +$m->submit_form( form_number => 3, + fields => { CorrespondAddress => 'rt-recipient@example.com' } ); +$m->content_like(qr/rt-recipient\@example.com.* - never/, 'has key info.'); + +diag "load Everyone group" if $ENV{'TEST_VERBOSE'}; +my $everyone; +{ + $everyone = RT::Group->new( $RT::SystemUser ); + $everyone->LoadSystemInternalGroup('Everyone'); + ok $everyone->id, "loaded 'everyone' group"; +} + +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}; + eval { email_ok($eid, $usage, $format, $attachment) }; + } + } +} + +$eid = 18; +{ + my ($usage, $format, $attachment) = ('signed', 'inline', 'plain'); + ++$eid; + diag "Email $eid: $usage, $attachment email with $format format" if $ENV{TEST_VERBOSE}; + 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'}; + + my $emaildatadir = RT::Test::get_relocatable_dir(File::Spec->updir(), + qw(data gnupg emails)); + my ($file) = glob("$emaildatadir/$eid-*"); + my $mail = RT::Test->file_content($file); + + my ($status, $id) = RT::Test->send_via_mailgate($mail); + 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 ); + $tick->Load( $id ); + ok ($tick->id, "$eid: loaded ticket #$id"); + + is ($tick->Subject, + "Test Email ID:$eid", + "$eid: Created the ticket" + ); + + my $txn = $tick->Transactions->First; + my ($msg, @attachments) = @{$txn->Attachments->ItemsArrayRef}; + + is( $msg->GetHeader('X-RT-Privacy'), + 'PGP', + "$eid: recorded incoming mail that is encrypted" + ); + + if ($usage =~ /encrypted/) { + if ( $format eq 'MIME' || $attachment eq 'plain' ) { + is( $msg->GetHeader('X-RT-Incoming-Encryption'), + 'Success', + "$eid: recorded incoming mail that is encrypted" + ); + } else { + is( $attachments[0]->GetHeader('X-RT-Incoming-Encryption'), + 'Success', + "$eid: recorded incoming mail that is encrypted" + ); + is( $attachments[1]->GetHeader('X-RT-Incoming-Encryption'), + 'Success', + "$eid: recorded incoming mail that is encrypted" + ); + } + like( $attachments[0]->Content, qr/ID:$eid/, + "$eid: incoming mail did NOT have original body" + ); + } + else { + is( $msg->GetHeader('X-RT-Incoming-Encryption'), + 'Not encrypted', + "$eid: recorded incoming mail that is not encrypted" + ); + like( $msg->Content || $attachments[0]->Content, qr/ID:$eid/, + "$eid: got original content" + ); + } + + if ($usage =~ /signed/) { +# XXX: FIXME: TODO: 6-signed-inline-with-attachment should be re-generated as it's actually RFC format + if ( $format eq 'MIME' || $attachment eq 'plain' || ($format eq 'inline' && $attachment =~ /binary/ && $usage !~ /encrypted/) ) { + is( $msg->GetHeader('X-RT-Incoming-Signature'), + 'RT Test <rt-test@example.com>', + "$eid: recorded incoming mail that is signed" + ); + } + else { + is( $attachments[0]->GetHeader('X-RT-Incoming-Signature'), + 'RT Test <rt-test@example.com>', + "$eid: recorded incoming mail that is signed" + ); + is( $attachments[1]->GetHeader('X-RT-Incoming-Signature'), + 'RT Test <rt-test@example.com>', + "$eid: recorded incoming mail that is signed" + ); + } + } + else { + is( $msg->GetHeader('X-RT-Incoming-Signature'), + undef, + "$eid: recorded incoming mail that is not signed" + ); + } + + if ($attachment =~ /attachment/) { + # signed messages should sign each attachment too + if ($usage =~ /signed/) { + my $sig = pop @attachments; + ok ($sig->Id, "$eid: loaded attachment.sig object"); + my $acontent = $sig->Content; + } + + my ($a) = grep $_->Filename, @attachments; + ok ($a && $a->Id, "$eid: found attachment with filename"); + + my $acontent = $a->Content; + if ($attachment =~ /binary/) + { + is(md5_hex($acontent), '1e35f1aa90c98ca2bab85c26ae3e1ba7', "$eid: The binary attachment's md5sum matches"); + } + else + { + like($acontent, qr/zanzibar/, "$eid: The attachment isn't screwed up in the database."); + } + + } + + return 0; +} + diff --git a/rt/t/mail/gnupg-reverification.t b/rt/t/mail/gnupg-reverification.t new file mode 100644 index 000000000..f116d9380 --- /dev/null +++ b/rt/t/mail/gnupg-reverification.t @@ -0,0 +1,92 @@ +#!/usr/bin/perl +use strict; +use warnings; + +use RT::Test tests => 120; + +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'}; +my $everyone; +{ + $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'; + +RT::Test->import_gnupg_key('rt-recipient@example.com'); + +my @ticket_ids; + +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'}; + + my ($eid) = ($file =~ m{(\d+)[^/\\]+$}); + ok $eid, 'figured id of a file'; + + 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 ); + 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 ); + $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, + "$eid: signature is not verified", + ); + $m->content_like(qr/This is .*ID:$eid/ims, "$eid: content is there and message is decrypted"); + + push @ticket_ids, $id; +} + +diag "import key into keyring" if $ENV{'TEST_VERBOSE'}; +RT::Test->import_gnupg_key('rt-test@example.com', 'public'); + +foreach my $id ( @ticket_ids ) { + diag "testing ticket #$id" if $ENV{'TEST_VERBOSE'}; + + $m->goto_ticket( $id ); + $m->content_like( + qr/The signature is good/is, + "signature is re-verified and now good", + ); +} + diff --git a/rt/t/mail/mime_decoding.t b/rt/t/mail/mime_decoding.t new file mode 100644 index 000000000..8257aee80 --- /dev/null +++ b/rt/t/mail/mime_decoding.t @@ -0,0 +1,59 @@ +#!/usr/bin/perl +use strict; +use warnings; +use RT::Test nodata => 1, tests => 6; + +use_ok('RT::I18N'); + +diag q{'=' char in a leading part before an encoded part} if $ENV{TEST_VERBOSE}; +{ + my $str = 'key="plain"; key="=?UTF-8?B?0LzQvtC5X9GE0LDQudC7LmJpbg==?="'; + is( + RT::I18N::DecodeMIMEWordsToUTF8($str), + 'key="plain"; key="мой_файл.bin"', + "right decoding" + ); +} + +diag q{not compliant with standards, but MUAs send such field when attachment has non-ascii in name} + if $ENV{TEST_VERBOSE}; +{ + my $str = 'attachment; filename="=?UTF-8?B?0LzQvtC5X9GE0LDQudC7LmJpbg==?="'; + is( + RT::I18N::DecodeMIMEWordsToUTF8($str), + 'attachment; filename="мой_файл.bin"', + "right decoding" + ); +} + +diag q{'=' char in a trailing part after an encoded part} if $ENV{TEST_VERBOSE}; +{ + my $str = 'attachment; filename="=?UTF-8?B?0LzQvtC5X9GE0LDQudC7LmJpbg==?="; some_prop="value"'; + is( + RT::I18N::DecodeMIMEWordsToUTF8($str), + 'attachment; filename="мой_файл.bin"; some_prop="value"', + "right decoding" + ); +} + +diag q{regression test for #5248 from rt3.fsck.com} if $ENV{TEST_VERBOSE}; +{ + 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?=}; + is( + RT::I18N::DecodeMIMEWordsToUTF8($str), + qq{Subject: Re: [XXXXXX#269] [Comment] Frage zu XXXXXX--xxxxxx / Xxxxxüxxxxxxxxxx}, + "right decoding" + ); +} + +diag q{newline and encoded file name} if $ENV{TEST_VERBOSE}; +{ + my $str = qq{application/vnd.ms-powerpoint;\n\tname="=?ISO-8859-1?Q?Main_presentation.ppt?="}; + is( + RT::I18N::DecodeMIMEWordsToUTF8($str), + qq{application/vnd.ms-powerpoint;\tname="Main presentation.ppt"}, + "right decoding" + ); +} + diff --git a/rt/t/mail/sendmail.t b/rt/t/mail/sendmail.t new file mode 100644 index 000000000..1f97bbb9f --- /dev/null +++ b/rt/t/mail/sendmail.t @@ -0,0 +1,538 @@ +#!/usr/bin/perl -w + +use strict; +use File::Spec (); + +use RT::Test tests => 137; + +use RT::EmailParser; +use RT::Tickets; +use RT::Action::SendEmail; + +my @_outgoing_messages; +my @scrips_fired; + +#We're not testing acls here. +my $everyone = RT::Group->new($RT::SystemUser); +$everyone->LoadSystemInternalGroup('Everyone'); +$everyone->PrincipalObj->GrantRight( Right =>'SuperUser' ); + + +is (__PACKAGE__, 'main', "We're operating in the main package"); + +{ + no warnings qw/redefine/; + sub RT::Action::SendEmail::SendMessage { + 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 +sub first_txn { return $_[0]->Transactions->First } +sub first_attach { return first_txn($_[0])->Attachments->First } + +sub count_txns { return $_[0]->Transactions->Count } +sub count_attachs { return first_txn($_[0])->Attachments->Count } + +# instrument SendEmail to pass us what it's about to send. +# create a regular ticket + +my $parser = RT::EmailParser->new(); + +# Let's test to make sure a multipart/report is processed correctly +my $multipart_report_email = RT::Test::get_relocatable_file('multipart-report', + (File::Spec->updir(), 'data', 'emails')); +my $content = RT::Test->file_content($multipart_report_email); +# be as much like the mail gateway as possible. +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); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); +my $tick= $tickets->First(); +isa_ok($tick, "RT::Ticket", "got a ticket object"); +ok ($tick->Id, "found ticket ".$tick->Id); +like (first_txn($tick)->Content , qr/The original message was received/, "It's the bounce"); + + +# make sure it fires scrips. +is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation"); + +undef @scrips_fired; + + + + +$parser->ParseMIMEEntityFromScalar('From: root@localhost +To: rt@example.com +Subject: This is a test of new ticket creation as an unknown user + +Blah! +Foob!'); + + +use Data::Dumper; + +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->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); + $tick = $tickets->First(); +ok ($tick->Id, "found ticket ".$tick->Id); +is ($tick->Subject , 'I18NTest', "failed to create the new ticket from an unprivileged account"); + +# make sure it fires scrips. +is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation"); +# make sure it sends an autoreply +# make sure it sends a notification to adminccs + + +# we need to swap out SendMessage to test the new things we care about; +&utf8_redef_sendmessage; + +# create an iso 8859-1 ticket +@scrips_fired = (); + +my $iso_8859_1_ticket_email = RT::Test::get_relocatable_file( + 'new-ticket-from-iso-8859-1', (File::Spec->updir(), 'data', 'emails')); +$content = RT::Test->file_content($iso_8859_1_ticket_email); + + + +$parser->ParseMIMEEntityFromScalar($content); + + +# be as much like the mail gateway as possible. +use RT::Interface::Email; + + %args = (message => $content, queue => 1, action => 'correspond'); + RT::Interface::Email::Gateway(\%args); + $tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); + $tick = $tickets->First(); +ok ($tick->Id, "found ticket ".$tick->Id); + +like (first_txn($tick)->Content , qr/H\x{e5}vard/, "It's signed by havard. yay"); + + +# make sure it fires scrips. +is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation"); +# make sure it sends an autoreply + + +# make sure it sends a notification to adminccs + +# If we correspond, does it do the right thing to the outbound messages? + +$parser->ParseMIMEEntityFromScalar($content); + ($id, $msg) = $tick->Comment(MIMEObj => $parser->Entity); +ok ($id, $msg); + +$parser->ParseMIMEEntityFromScalar($content); +($id, $msg) = $tick->Correspond(MIMEObj => $parser->Entity); +ok ($id, $msg); + + + + + +# we need to swap out SendMessage to test the new things we care about; +&iso8859_redef_sendmessage; +RT->Config->Set( EmailOutputEncoding => 'iso-8859-1' ); +# create an iso 8859-1 ticket +@scrips_fired = (); + + $content = RT::Test->file_content($iso_8859_1_ticket_email); +# be as much like the mail gateway as possible. +use RT::Interface::Email; + + %args = (message => $content, queue => 1, action => 'correspond'); + RT::Interface::Email::Gateway(\%args); +$tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); + $tick = $tickets->First(); +ok ($tick->Id, "found ticket ".$tick->Id); + +like (first_txn($tick)->Content , qr/H\x{e5}vard/, "It's signed by havard. yay"); + + +# make sure it fires scrips. +is ($#scrips_fired, 1, "Fired 2 scrips on ticket creation"); +# make sure it sends an autoreply + + +# make sure it sends a notification to adminccs + + +# If we correspond, does it do the right thing to the outbound messages? + +$parser->ParseMIMEEntityFromScalar($content); + ($id, $msg) = $tick->Comment(MIMEObj => $parser->Entity); +ok ($id, $msg); + +$parser->ParseMIMEEntityFromScalar($content); +($id, $msg) = $tick->Correspond(MIMEObj => $parser->Entity); +ok ($id, $msg); + + +sub _fired_scrip { + my $scrip = shift; + push @scrips_fired, $scrip; +} + +sub utf8_redef_sendmessage { + no warnings qw/redefine/; + eval ' + sub RT::Action::SendEmail::SendMessage { + my $self = shift; + my $MIME = shift; + + my $scrip = $self->ScripObj->id; + 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\', + "its mime header is a mime header. yay" ); + 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"); + + }'; +} + +sub iso8859_redef_sendmessage { + no warnings qw/redefine/; + eval ' + sub RT::Action::SendEmail::SendMessage { + my $self = shift; + my $MIME = shift; + + my $scrip = $self->ScripObj->id; + 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\', + "its mime header is a mime header. yay" ); + 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"); + + }'; +} + +# {{{ 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')); + $content = RT::Test->file_content($alt_umlaut_email); + +$parser->ParseMIMEEntityFromScalar($content); + + +# be as much like the mail gateway as possible. +{ + no warnings qw/redefine/; + local *RT::Action::SendEmail::SendMessage = sub { return 1}; + + %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->OrderBy(FIELD => 'id', ORDER => 'DESC'); + $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); + $tick = $tickets->First(); + + ok ($tick->Id, "found ticket ".$tick->Id); + + like (first_txn($tick)->Content , qr/causes Error/, "We recorded the content right as text-plain"); + is (count_attachs($tick) , 3 , "Has three attachments, presumably a text-plain, a text-html and a multipart alternative"); + +} + +# }}} + +# {{{ 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); + +$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); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); + $tick = $tickets->First(); +ok ($tick->Id, "found ticket ".$tick->Id); + +like (first_attach($tick)->Content , qr/causes Error/, "We recorded the content as containing 'causes error'") or diag( first_attach($tick)->Content ); +like (first_attach($tick)->ContentType , qr/text\/html/, "We recorded the content as text/html"); +is (count_attachs($tick), 1 , "Has one attachment, presumably a text-html and a multipart alternative"); + +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"); + }'; +} + +# }}} + +# {{{ 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); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); + $tick = $tickets->First(); +ok ($tick->Id, "found ticket ".$tick->Id); + +like (first_attach($tick)->ContentType , qr/text\/html/, "We recorded the content right as text-html"); + +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' ); +my $russian_subject_email = RT::Test::get_relocatable_file( + 'russian-subject-no-content-type', (File::Spec->updir(), 'data', 'emails')); +$content = RT::Test->file_content($russian_subject_email); + +$parser->ParseMIMEEntityFromScalar($content); + + +# be as much like the mail gateway as possible. +&text_plain_russian_redef_sendmessage; + %args = (message => $content, queue => 1, action => 'correspond'); + RT::Interface::Email::Gateway(\%args); + $tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); +$tick= $tickets->First(); +ok ($tick->Id, "found ticket ".$tick->Id); + +like (first_attach($tick)->ContentType , qr/text\/plain/, "We recorded the content type right"); +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"); + }; + '; +} + +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')); +$content = RT::Test->file_content($nested_rfc822_email); +ok ($content, "Loaded nested-rfc-822 to test"); + +$parser->ParseMIMEEntityFromScalar($content); + + +# be as much like the mail gateway as possible. +&text_plain_nested_redef_sendmessage; + %args = (message => $content, queue => 1, action => 'correspond'); + RT::Interface::Email::Gateway(\%args); + $tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); +$tick= $tickets->First(); +ok ($tick->Id, "found ticket ".$tick->Id); +is ($tick->Subject, "[Jonas Liljegren] Re: [Para] Niv\x{e5}er?"); +like (first_attach($tick)->ContentType , qr/multipart\/mixed/, "We recorded the content type right"); +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; + }'; +} + +# }}} + + +# {{{ 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')); + $content = RT::Test->file_content($uuencoded_email); + +$parser->ParseMIMEEntityFromScalar($content); + + +# be as much like the mail gateway as possible. +{ + 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->OrderBy(FIELD => 'id', ORDER => 'DESC'); + $tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); + $tick= $tickets->First(); + ok ($tick->Id, "found ticket ".$tick->Id); + + like (first_txn($tick)->Content , qr/from Lotus Notes/, "We recorded the content right"); + 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')); + $content = RT::Test->file_content($crashes_file_based_parser_email); + +$parser->ParseMIMEEntityFromScalar($content); + + +# be as much like the mail gateway as possible. + +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->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); +$tick= $tickets->First(); +ok ($tick->Id, "found ticket ".$tick->Id); + +like (first_txn($tick)->Content , qr/FYI/, "We recorded the content right"); +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')); + $content = RT::Test->file_content($rt_send_cc_email); + +$parser->ParseMIMEEntityFromScalar($content); + + + + %args = (message => $content, queue => 1, action => 'correspond'); + RT::Interface::Email::Gateway(\%args); + $tickets = RT::Tickets->new($RT::SystemUser); +$tickets->OrderBy(FIELD => 'id', ORDER => 'DESC'); +$tickets->Limit(FIELD => 'id' ,OPERATOR => '>', VALUE => '0'); +$tick= $tickets->First(); +ok ($tick->Id, "found ticket ".$tick->Id); + +my $cc = first_attach($tick)->GetHeader('RT-Send-Cc'); +like ($cc , qr/test1/, "Found test 1"); +like ($cc , qr/test2/, "Found test 2"); +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}; +{ + my $subject_folding_email = RT::Test::get_relocatable_file( + 'subject-with-folding-ws', (File::Spec->updir(), 'data', 'emails')); + my $content = RT::Test->file_content($subject_folding_email); + my ($status, $msg, $ticket) = RT::Interface::Email::Gateway( + { message => $content, queue => 1, action => 'correspond' } + ); + ok ($status, 'created ticket') or diag "error: $msg"; + ok ($ticket->id, "found ticket ". $ticket->id); + is ($ticket->Subject, 'test', 'correct subject'); +} + +diag q{regression test for #5248 from rt3.fsck.com} if $ENV{TEST_VERBOSE}; +{ + my $long_subject_email = RT::Test::get_relocatable_file('very-long-subject', + (File::Spec->updir(), 'data', 'emails')); + my $content = RT::Test->file_content($long_subject_email); + my ($status, $msg, $ticket) = RT::Interface::Email::Gateway( + { message => $content, queue => 1, action => 'correspond' } + ); + ok ($status, 'created ticket') or diag "error: $msg"; + ok ($ticket->id, "found ticket ". $ticket->id); + is ($ticket->Subject, '0123456789'x20, 'correct subject'); +} + + + +# Don't taint the environment +$everyone->PrincipalObj->RevokeRight(Right =>'SuperUser'); +1; diff --git a/rt/t/mail/verp.t b/rt/t/mail/verp.t new file mode 100644 index 000000000..79ede90ab --- /dev/null +++ b/rt/t/mail/verp.t @@ -0,0 +1,8 @@ +#!/usr/bin/perl -w + +use strict; +use RT::Test tests => 1; +TODO: { + todo_skip "No tests written for VERP yet", 1; + ok(1,"a test to skip"); +} |