summaryrefslogtreecommitdiff
path: root/rt/lib/RT/Test
diff options
context:
space:
mode:
Diffstat (limited to 'rt/lib/RT/Test')
-rw-r--r--rt/lib/RT/Test/Apache.pm270
-rw-r--r--rt/lib/RT/Test/GnuPG.pm360
2 files changed, 630 insertions, 0 deletions
diff --git a/rt/lib/RT/Test/Apache.pm b/rt/lib/RT/Test/Apache.pm
new file mode 100644
index 000000000..b2733eadb
--- /dev/null
+++ b/rt/lib/RT/Test/Apache.pm
@@ -0,0 +1,270 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
+# <sales@bestpractical.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/licenses/old-licenses/gpl-2.0.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 }}}
+
+package RT::Test::Apache;
+use strict;
+use warnings;
+
+my %MODULES = (
+ '2.2' => {
+ "mod_perl" => [qw(authz_host env alias perl)],
+ "fastcgi" => [qw(authz_host env alias mime fastcgi)],
+ },
+);
+
+my $apache_module_prefix = $ENV{RT_TEST_APACHE_MODULES};
+my $apxs =
+ $ENV{RT_TEST_APXS}
+ || RT::Test->find_executable('apxs')
+ || RT::Test->find_executable('apxs2');
+
+if ($apxs and not $apache_module_prefix) {
+ $apache_module_prefix = `$apxs -q LIBEXECDIR`;
+ chomp $apache_module_prefix;
+}
+
+$apache_module_prefix ||= 'modules';
+
+sub basic_auth {
+ my $self = shift;
+ my $passwd = File::Spec->rel2abs( File::Spec->catfile(
+ 't', 'data', 'configs', 'passwords' ) );
+
+ return <<"EOT";
+ AuthType Basic
+ AuthName "restricted area"
+ AuthUserFile $passwd
+ Require user root
+EOT
+}
+
+sub start_server {
+ my ($self, %config) = @_;
+ my %tmp = %{$config{tmp}};
+ my %info = $self->apache_server_info( %config );
+
+ RT::Test::diag(do {
+ open( my $fh, '<', $tmp{'config'}{'RT'} ) or die $!;
+ local $/;
+ <$fh>
+ });
+
+ my $tmpl = File::Spec->rel2abs( File::Spec->catfile(
+ 't', 'data', 'configs',
+ 'apache'. $info{'version'} .'+'. $config{variant} .'.conf'
+ ) );
+ my %opt = (
+ listen => $config{port},
+ server_root => $info{'HTTPD_ROOT'} || $ENV{'HTTPD_ROOT'}
+ || Test::More::BAIL_OUT("Couldn't figure out server root"),
+ document_root => $RT::MasonComponentRoot,
+ tmp_dir => "$tmp{'directory'}",
+ rt_bin_path => $RT::BinPath,
+ rt_sbin_path => $RT::SbinPath,
+ rt_site_config => $ENV{'RT_SITE_CONFIG'},
+ load_modules => $info{load_modules},
+ basic_auth => $config{basic_auth} ? $self->basic_auth : "",
+ );
+ foreach (qw(log pid lock)) {
+ $opt{$_ .'_file'} = File::Spec->catfile(
+ "$tmp{'directory'}", "apache.$_"
+ );
+ }
+
+ $tmp{'config'}{'apache'} = File::Spec->catfile(
+ "$tmp{'directory'}", "apache.conf"
+ );
+ $self->process_in_file(
+ in => $tmpl,
+ out => $tmp{'config'}{'apache'},
+ options => \%opt,
+ );
+
+ $self->fork_exec($info{'executable'}, '-f', $tmp{'config'}{'apache'});
+ my $pid = do {
+ my $tries = 15;
+ while ( !-s $opt{'pid_file'} ) {
+ $tries--;
+ last unless $tries;
+ sleep 1;
+ }
+ my $pid_fh;
+ unless (-e $opt{'pid_file'} and open($pid_fh, '<', $opt{'pid_file'})) {
+ Test::More::BAIL_OUT("Couldn't start apache server, no pid file (unknown error)")
+ unless -e $opt{log_file};
+
+ open my $log, "<", $opt{log_file};
+ my $error = do {local $/; <$log>};
+ close $log;
+ $RT::Logger->error($error) if $error;
+ Test::More::BAIL_OUT("Couldn't start apache server!");
+ }
+
+ my $pid = <$pid_fh>;
+ chomp $pid;
+ $pid;
+ };
+
+ Test::More::ok($pid, "Started apache server #$pid");
+ return $pid;
+}
+
+sub apache_server_info {
+ my $self = shift;
+ my %res = @_;
+
+ my $bin = $res{'executable'} = $ENV{'RT_TEST_APACHE'}
+ || $self->find_apache_server
+ || Test::More::BAIL_OUT("Couldn't find apache server, use RT_TEST_APACHE");
+
+ Test::More::BAIL_OUT(
+ "Couldn't find apache modules directory (set APXS= or RT_TEST_APACHE_MODULES=)"
+ ) unless -d $apache_module_prefix;
+
+
+ RT::Test::diag("Using '$bin' apache executable for testing");
+
+ my $info = `$bin -V`;
+ ($res{'version'}) = ($info =~ m{Server\s+version:\s+Apache/(\d+\.\d+)\.});
+ Test::More::BAIL_OUT(
+ "Couldn't figure out version of the server"
+ ) unless $res{'version'};
+
+ my %opts = ($info =~ m/^\s*-D\s+([A-Z_]+?)(?:="(.*)")$/mg);
+ %res = (%res, %opts);
+
+ $res{'modules'} = [
+ map {s/^\s+//; s/\s+$//; $_}
+ grep $_ !~ /Compiled in modules/i,
+ split /\r*\n/, `$bin -l`
+ ];
+
+ Test::More::BAIL_OUT(
+ "Unsupported apache version $res{version}"
+ ) unless exists $MODULES{$res{version}};
+
+ Test::More::BAIL_OUT(
+ "Unsupported apache variant $res{variant}"
+ ) unless exists $MODULES{$res{version}}{$res{variant}};
+
+ my @mlist = @{$MODULES{$res{version}}{$res{variant}}};
+ push @mlist, "authn_file", "auth_basic", "authz_user" if $res{basic_auth};
+
+ $res{'load_modules'} = '';
+ foreach my $mod ( @mlist ) {
+ next if grep $_ =~ /^(mod_|)$mod\.c$/, @{ $res{'modules'} };
+
+ my $so_file = $apache_module_prefix."/mod_".$mod.".so";
+ Test::More::BAIL_OUT( "Couldn't load $mod module (expected in $so_file)" )
+ unless -f $so_file;
+ $res{'load_modules'} .=
+ "LoadModule ${mod}_module $so_file\n";
+ }
+ return %res;
+}
+
+sub find_apache_server {
+ my $self = shift;
+ return $_ foreach grep defined,
+ map RT::Test->find_executable($_),
+ qw(httpd apache apache2 apache1);
+ return undef;
+}
+
+sub apache_mpm_type {
+ my $self = shift;
+ my $apache = $self->find_apache_server;
+ my $out = `$apache -l`;
+ if ( $out =~ /^\s*(worker|prefork|event|itk)\.c\s*$/m ) {
+ return $1;
+ }
+}
+
+sub fork_exec {
+ my $self = shift;
+
+ RT::Test::__disconnect_rt();
+ my $pid = fork;
+ unless ( defined $pid ) {
+ die "cannot fork: $!";
+ } elsif ( !$pid ) {
+ exec @_;
+ die "can't exec `". join(' ', @_) ."` program: $!";
+ } else {
+ RT::Test::__reconnect_rt();
+ return $pid;
+ }
+}
+
+sub process_in_file {
+ my $self = shift;
+ my %args = ( in => undef, options => undef, @_ );
+
+ my $text = RT::Test->file_content( $args{'in'} );
+ while ( my ($opt) = ($text =~ /\%\%(.+?)\%\%/) ) {
+ my $value = $args{'options'}{ lc $opt };
+ die "no value for $opt" unless defined $value;
+
+ $text =~ s/\%\%\Q$opt\E\%\%/$value/g;
+ }
+
+ my ($out_fh, $out_conf);
+ unless ( $args{'out'} ) {
+ ($out_fh, $out_conf) = tempfile();
+ } else {
+ $out_conf = $args{'out'};
+ open( $out_fh, '>', $out_conf )
+ or die "couldn't open '$out_conf': $!";
+ }
+ print $out_fh $text;
+ seek $out_fh, 0, 0;
+
+ return ($out_fh, $out_conf);
+}
+
+1;
diff --git a/rt/lib/RT/Test/GnuPG.pm b/rt/lib/RT/Test/GnuPG.pm
new file mode 100644
index 000000000..6cebb775b
--- /dev/null
+++ b/rt/lib/RT/Test/GnuPG.pm
@@ -0,0 +1,360 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2012 Best Practical Solutions, LLC
+# <sales@bestpractical.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/licenses/old-licenses/gpl-2.0.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 }}}
+
+package RT::Test::GnuPG;
+use strict;
+use Test::More;
+use base qw(RT::Test);
+use File::Temp qw(tempdir);
+
+our @EXPORT =
+ qw(create_a_ticket update_ticket cleanup_headers set_queue_crypt_options
+ check_text_emails send_email_and_check_transaction
+ create_and_test_outgoing_emails
+ );
+
+sub import {
+ my $class = shift;
+ my %args = @_;
+ my $t = $class->builder;
+
+ $t->plan( skip_all => 'GnuPG required.' )
+ unless eval { require GnuPG::Interface; 1 };
+ $t->plan( skip_all => 'gpg executable is required.' )
+ unless RT::Test->find_executable('gpg');
+
+ require RT::Crypt::GnuPG;
+ $class->SUPER::import(%args);
+
+ RT::Test::diag "GnuPG --homedir " . RT->Config->Get('GnuPGOptions')->{'homedir'};
+
+ $class->set_rights(
+ Principal => 'Everyone',
+ Right => ['CreateTicket', 'ShowTicket', 'SeeQueue', 'ReplyToTicket', 'ModifyTicket'],
+ );
+
+ $class->export_to_level(1);
+}
+
+sub bootstrap_more_config {
+ my $self = shift;
+ my $handle = shift;
+ my $args = shift;
+
+ $self->SUPER::bootstrap_more_config($handle, $args, @_);
+
+ my %gnupg_options = (
+ 'no-permission-warning' => undef,
+ $args->{gnupg_options} ? %{ $args->{gnupg_options} } : (),
+ );
+ $gnupg_options{homedir} ||= scalar tempdir( CLEANUP => 1 );
+
+ use Data::Dumper;
+ local $Data::Dumper::Terse = 1; # "{...}" instead of "$VAR1 = {...};"
+ my $dumped_gnupg_options = Dumper(\%gnupg_options);
+
+ print $handle qq{
+Set(\%GnuPG, (
+ Enable => 1,
+ OutgoingMessagesFormat => 'RFC',
+));
+Set(\%GnuPGOptions => \%{ $dumped_gnupg_options });
+Set(\@MailPlugins => qw(Auth::MailFrom Auth::GnuPG));
+};
+
+}
+
+sub create_a_ticket {
+ my $queue = shift;
+ my $mail = shift;
+ my $m = shift;
+ my %args = (@_);
+
+ RT::Test->clean_caught_mails;
+
+ $m->goto_create_ticket( $queue );
+ $m->form_name('TicketCreate');
+ $m->field( Subject => 'test' );
+ $m->field( Requestors => 'rt-test@example.com' );
+ $m->field( Content => 'Some content' );
+
+ foreach ( qw(Sign Encrypt) ) {
+ if ( $args{ $_ } ) {
+ $m->tick( $_ => 1 );
+ } else {
+ $m->untick( $_ => 1 );
+ }
+ }
+
+ $m->submit;
+ is $m->status, 200, "request successful";
+
+ $m->content_lacks("unable to sign outgoing email messages");
+
+
+ my @mail = RT::Test->fetch_caught_mails;
+ check_text_emails(\%args, @mail );
+ categorize_emails($mail, \%args, @mail );
+}
+
+sub update_ticket {
+ my $tid = shift;
+ my $mail = shift;
+ my $m = shift;
+ my %args = (@_);
+
+ RT::Test->clean_caught_mails;
+
+ $m->get( $m->rt_base_url . "/Ticket/Update.html?Action=Respond&id=$tid" );
+ $m->form_number(3);
+ $m->field( UpdateContent => 'Some content' );
+
+ foreach ( qw(Sign Encrypt) ) {
+ if ( $args{ $_ } ) {
+ $m->tick( $_ => 1 );
+ } else {
+ $m->untick( $_ => 1 );
+ }
+ }
+
+ $m->click('SubmitTicket');
+ is $m->status, 200, "request successful";
+ $m->content_contains("Message recorded", 'Message recorded') or diag $m->content;
+
+
+ my @mail = RT::Test->fetch_caught_mails;
+ check_text_emails(\%args, @mail );
+ categorize_emails($mail, \%args, @mail );
+}
+
+sub categorize_emails {
+ my $mail = shift;
+ my $args = shift;
+ my @mail = @_;
+
+ if ( $args->{'Sign'} && $args->{'Encrypt'} ) {
+ push @{ $mail->{'signed_encrypted'} }, @mail;
+ }
+ elsif ( $args->{'Sign'} ) {
+ push @{ $mail->{'signed'} }, @mail;
+ }
+ elsif ( $args->{'Encrypt'} ) {
+ push @{ $mail->{'encrypted'} }, @mail;
+ }
+ else {
+ push @{ $mail->{'plain'} }, @mail;
+ }
+}
+
+sub check_text_emails {
+ my %args = %{ shift @_ };
+ my @mail = @_;
+
+ ok scalar @mail, "got some mail";
+ for my $mail (@mail) {
+ for my $type ('email', 'attachment') {
+ next if $type eq 'attachment' && !$args{'Attachment'};
+
+ my $content = $type eq 'email'
+ ? "Some content"
+ : "Attachment content";
+
+ if ( $args{'Encrypt'} ) {
+ unlike $mail, qr/$content/, "outgoing $type was encrypted";
+ } else {
+ like $mail, qr/$content/, "outgoing $type was not encrypted";
+ }
+
+ next unless $type eq 'email';
+
+ if ( $args{'Sign'} && $args{'Encrypt'} ) {
+ like $mail, qr/BEGIN PGP MESSAGE/, 'outgoing email was signed';
+ } elsif ( $args{'Sign'} ) {
+ like $mail, qr/SIGNATURE/, 'outgoing email was signed';
+ } else {
+ unlike $mail, qr/SIGNATURE/, 'outgoing email was not signed';
+ }
+ }
+ }
+}
+
+sub cleanup_headers {
+ my $mail = shift;
+ # strip id from subject to create new ticket
+ $mail =~ s/^(Subject:)\s*\[.*?\s+#\d+\]\s*/$1 /m;
+ # strip several headers
+ foreach my $field ( qw(Message-ID X-RT-Original-Encoding RT-Originator RT-Ticket X-RT-Loop-Prevention) ) {
+ $mail =~ s/^$field:.*?\n(?! |\t)//gmsi;
+ }
+ return $mail;
+}
+
+sub set_queue_crypt_options {
+ my $queue = shift;
+ my %args = @_;
+ $queue->SetEncrypt($args{'Encrypt'});
+ $queue->SetSign($args{'Sign'});
+}
+
+sub send_email_and_check_transaction {
+ my $mail = shift;
+ my $type = shift;
+
+ my ( $status, $id ) = RT::Test->send_via_mailgate($mail);
+ is( $status >> 8, 0, "The mail gateway exited normally" );
+ ok( $id, "got id of a newly created ticket - $id" );
+
+ my $tick = RT::Ticket->new( RT->SystemUser );
+ $tick->Load($id);
+ ok( $tick->id, "loaded ticket #$id" );
+
+ my $txn = $tick->Transactions->First;
+ my ( $msg, @attachments ) = @{ $txn->Attachments->ItemsArrayRef };
+
+ if ( $attachments[0] ) {
+ like $attachments[0]->Content, qr/Some content/,
+ "RT's mail includes copy of ticket text";
+ }
+ else {
+ like $msg->Content, qr/Some content/,
+ "RT's mail includes copy of ticket text";
+ }
+
+ if ( $type eq 'plain' ) {
+ ok !$msg->GetHeader('X-RT-Privacy'), "RT's outgoing mail has no crypto";
+ is $msg->GetHeader('X-RT-Incoming-Encryption'), 'Not encrypted',
+ "RT's outgoing mail looks not encrypted";
+ ok !$msg->GetHeader('X-RT-Incoming-Signature'),
+ "RT's outgoing mail looks not signed";
+ }
+ elsif ( $type eq 'signed' ) {
+ is $msg->GetHeader('X-RT-Privacy'), 'PGP',
+ "RT's outgoing mail has crypto";
+ is $msg->GetHeader('X-RT-Incoming-Encryption'), 'Not encrypted',
+ "RT's outgoing mail looks not encrypted";
+ like $msg->GetHeader('X-RT-Incoming-Signature'),
+ qr/<rt-recipient\@example.com>/,
+ "RT's outgoing mail looks signed";
+ }
+ elsif ( $type eq 'encrypted' ) {
+ is $msg->GetHeader('X-RT-Privacy'), 'PGP',
+ "RT's outgoing mail has crypto";
+ is $msg->GetHeader('X-RT-Incoming-Encryption'), 'Success',
+ "RT's outgoing mail looks encrypted";
+ ok !$msg->GetHeader('X-RT-Incoming-Signature'),
+ "RT's outgoing mail looks not signed";
+
+ }
+ elsif ( $type eq 'signed_encrypted' ) {
+ is $msg->GetHeader('X-RT-Privacy'), 'PGP',
+ "RT's outgoing mail has crypto";
+ is $msg->GetHeader('X-RT-Incoming-Encryption'), 'Success',
+ "RT's outgoing mail looks encrypted";
+ like $msg->GetHeader('X-RT-Incoming-Signature'),
+ qr/<rt-recipient\@example.com>/,
+ "RT's outgoing mail looks signed";
+ }
+ else {
+ die "unknown type: $type";
+ }
+}
+
+sub create_and_test_outgoing_emails {
+ my $queue = shift;
+ my $m = shift;
+ my @variants =
+ ( {}, { Sign => 1 }, { Encrypt => 1 }, { Sign => 1, Encrypt => 1 }, );
+
+ # collect emails
+ my %mail;
+
+ # create a ticket for each combination
+ foreach my $ticket_set (@variants) {
+ create_a_ticket( $queue, \%mail, $m, %$ticket_set );
+ }
+
+ my $tid;
+ {
+ my $ticket = RT::Ticket->new( RT->SystemUser );
+ ($tid) = $ticket->Create(
+ Subject => 'test',
+ Queue => $queue->id,
+ Requestor => 'rt-test@example.com',
+ );
+ ok $tid, 'ticket created';
+ }
+
+ # again for each combination add a reply message
+ foreach my $ticket_set (@variants) {
+ update_ticket( $tid, \%mail, $m, %$ticket_set );
+ }
+
+# ------------------------------------------------------------------------------
+# now delete all keys from the keyring and put back secret/pub pair for rt-test@
+# and only public key for rt-recipient@ so we can verify signatures and decrypt
+# like we are on another side recieve emails
+# ------------------------------------------------------------------------------
+
+ unlink $_
+ foreach glob( RT->Config->Get('GnuPGOptions')->{'homedir'} . "/*" );
+ RT::Test->import_gnupg_key( 'rt-recipient@example.com', 'public' );
+ RT::Test->import_gnupg_key('rt-test@example.com');
+
+ $queue = RT::Test->load_or_create_queue(
+ Name => 'Regression',
+ CorrespondAddress => 'rt-test@example.com',
+ CommentAddress => 'rt-test@example.com',
+ );
+ ok $queue && $queue->id, 'changed props of the queue';
+
+ for my $type ( keys %mail ) {
+ for my $mail ( map cleanup_headers($_), @{ $mail{$type} } ) {
+ send_email_and_check_transaction( $mail, $type );
+ }
+ }
+}
generated by cgit v1.2.1 (git 2.18.0) at 2025-06-14 18:24:35 +0000