From dda9db0017aa094ade78c9533ed3c2a74f9745c6 Mon Sep 17 00:00:00 2001 From: Don Armstrong Date: Sat, 3 Feb 2007 00:05:45 -0800 Subject: [PATCH] * Modularize some of the test calls used in the mail_handling test script * Test more of the control commands --- t/06_mail_handling.t | 210 +++++++++++++++++++++---------------------- t/lib/DebbugsTest.pm | 163 +++++++++++++++++++++++++++++++++ 2 files changed, 266 insertions(+), 107 deletions(-) create mode 100644 t/lib/DebbugsTest.pm diff --git a/t/06_mail_handling.t b/t/06_mail_handling.t index 7d71fcb..c254d23 100644 --- a/t/06_mail_handling.t +++ b/t/06_mail_handling.t @@ -1,7 +1,7 @@ # -*- mode: cperl;-*- # $Id: 05_mail.t,v 1.1 2005/08/17 21:46:17 don Exp $ -use Test::More tests => 20; +use Test::More tests => 31; use warnings; use strict; @@ -18,92 +18,46 @@ use File::Temp qw(tempdir); use Cwd qw(getcwd); use Debbugs::MIME qw(create_mime_message); use File::Basename qw(dirname basename); +# The test functions are placed here to make things easier +use lib qw(t/lib); +use DebbugsTest qw(:all); +use Data::Dumper; + +my %config; +eval { + %config = create_debbugs_configuration(debug => exists $ENV{DEBUG}?$ENV{DEBUG}:0); +}; +if ($@) { + BAIL_OUT($@); +} - -my $sendmail_dir = tempdir(CLEANUP => $ENV{DEBUG}?0:1); -my $spool_dir = tempdir(CLEANUP => $ENV{DEBUG}?0:1); -my $config_dir = tempdir(CLEANUP => $ENV{DEBUG}?0:1); +my $sendmail_dir = $config{sendmail_dir}; +my $spool_dir = $config{spool_dir}; +my $config_dir = $config{config_dir}; END{ if ($ENV{DEBUG}) { - print STDERR "\nspool_dir: $spool_dir\n"; - print STDERR "config_dir: $config_dir\n"; - print STDERR "sendmail_dir: $sendmail_dir\n"; + diag("spool_dir: $spool_dir\n"); + diag("config_dir: $config_dir\n"); + diag("sendmail_dir: $sendmail_dir\n"); } } -$ENV{DEBBUGS_CONFIG_FILE} ="$config_dir/debbugs_config"; -$ENV{PERL5LIB} = getcwd(); -$ENV{SENDMAIL_TESTDIR} = $sendmail_dir; -my $sendmail_tester = getcwd().'/t/sendmail_tester'; - - -unless (-x $sendmail_tester) { - BAIL_OUT(q(t/sendmail_tester doesn't exist or isn't executable. You may be in the wrong directory.)); -} - -my %files_to_create = ("$config_dir/debbugs_config" => < qq(1\n), - "$config_dir/Maintainers" => qq(foo Blah Bleargh \n), - "$config_dir/Maintainers.override" => qq(), - "$config_dir/indices/sources" => <new($file,'w') or - BAIL_OUT("Unable to create $file: $!"); - print {$fh} $contents; - close $fh; -} - -system('touch',"$spool_dir/index.db.realtime"); -system('ln','-s','index.db.realtime', - "$spool_dir/index.db"); -system('touch',"$spool_dir/index.archive.realtime"); -system('ln','-s','index.archive.realtime', - "$spool_dir/index.archive"); - - - -# create the spool files and sub directories -map {system('mkdir','-p',"$spool_dir/$_"); } - map {('db-h/'.$_,'archive/'.$_)} - map { sprintf "%02d",$_ % 100} 0..99; -system('mkdir','-p',"$spool_dir/incoming"); -system('mkdir','-p',"$spool_dir/lock"); - - # We're going to use create mime message to create these messages, and # then just send them to receive. -# First, check that submit@ works - -$ENV{LOCAL_PART} = 'submit@bugs.something'; -my $receive = new IO::File ('|scripts/receive.in') or BAIL_OUT("Unable to start receive.in: $!"); - -print {$receive} create_mime_message([To => 'submit@bugs.something', - From => 'foo@bugs.something', - Subject => 'Submiting a bug', - ], - <'submit@bugs.something', + headers => [To => 'submit@bugs.something', + From => 'foo@bugs.something', + Subject => 'Submiting a bug', + ], + body => < '1@bugs.something', - From => 'foo@bugs.something', - Subject => 'Sending a message to a bug', - ], - < '1@bugs.something', + headers => [To => '1@bugs.something', + From => 'foo@bugs.something', + Subject => 'Sending a message to a bug', + ], + body => <= 2,'1@bugs.something messages appear to have been sent out properly'); $SD_SIZE_PREV=$SD_SIZE_NOW; # just check to see that control doesn't explode -$ENV{LOCAL_PART} = 'control@bugs.something'; -$receive = new IO::File ('|scripts/receive.in') or - BAIL_OUT("Unable to start receive.in: $!"); - -print {$receive} create_mime_message([To => 'control@bugs.something', - From => 'foo@bugs.something', - Subject => 'Munging a bug', - ], - < 'control@bugs.something', + headers => [To => 'control@bugs.something', + From => 'foo@bugs.something', + Subject => 'Munging a bug', + ], + body => <= 1,'control@bugs.something messages appear to have been sent out properly'); $SD_SIZE_PREV=$SD_SIZE_NOW; @@ -184,5 +116,69 @@ my $status = read_bug(bug=>1); ok($status->{subject} eq 'new title','bug 1 retitled'); ok($status->{severity} eq 'wishlist','bug 1 wishlisted'); - - +# now we're going to go through and methododically test all of the control commands. +my @control_commands = + (severity_wishlist => {command => 'severity', + value => 'wishlist', + status_key => 'severity', + status_value => 'wishlist', + }, + 'found_1.0' => {command => 'found', + value => '1.0', + status_key => 'found_versions', + status_value => ['1.0'], + }, + 'notfound_1.0' => {command => 'notfound', + value => '1.0', + status_key => 'found_versions', + status_value => [], + }, + submitter_foo => {command => 'submitter', + value => 'foo@bar.com', + status_key => 'originator', + status_value => 'foo@bar.com', + }, + + forwarded_foo => {command => 'forwarded', + value => 'foo@bar.com', + status_key => 'forwarded', + status_value => 'foo@bar.com', + }, + owner_foo => {command => 'owner', + value => 'foo@bar.com', + status_key => 'owner', + status_value => 'foo@bar.com', + }, + noowner => {command => 'noowner', + value => '', + status_key => 'owner', + status_value => '', + }, + + ); + +while (my ($command,$control_command) = splice(@control_commands,0,2)) { + # just check to see that control doesn't explode + $control_command->{value} = " $control_command->{value}" if length $control_command->{value} + and $control_command->{value} !~ /^\s/; + send_message(to => 'control@bugs.something', + headers => [To => 'control@bugs.something', + From => 'foo@bugs.something', + Subject => "Munging a bug with $command", + ], + body => <{command} 1$control_command->{value} +thanks +EOF + ; + $SD_SIZE_NOW = dirsize($sendmail_dir); + ok($SD_SIZE_NOW-$SD_SIZE_PREV >= 1,'control@bugs.something messages appear to have been sent out properly'); + $SD_SIZE_PREV=$SD_SIZE_NOW; + # now we need to check to make sure the control message was processed without errors + ok(system("sh -c 'find ".$sendmail_dir.q( -type f | xargs grep -q "Subject: Processed: Munging a bug with $command"')) == 0, + 'control@bugs.something'. "$command message was parsed without errors"); + # now we need to check to make sure that the control message actually did anything + my $status = read_bug(bug=>1); + is_deeply($status->{$control_command->{status_key}},$control_command->{status_value},"bug 1 $command") + or fail(Dumper($status)); +} diff --git a/t/lib/DebbugsTest.pm b/t/lib/DebbugsTest.pm new file mode 100644 index 0000000..1ce2998 --- /dev/null +++ b/t/lib/DebbugsTest.pm @@ -0,0 +1,163 @@ + +package DebbugsTest; + +=head1 NAME + +DebbugsTest + +=head1 SYNOPSIS + +use DebbugsTest + + +=head1 DESCRIPTION + +This module contains various testing routines used to test debbugs in +a "pseudo install" + +=head1 FUNCTIONS + +=cut + +use warnings; +use strict; +use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT); +use base qw(Exporter); + +use IO::File; +use File::Temp qw(tempdir); +use Cwd qw(getcwd); +use Debbugs::MIME qw(create_mime_message); +use File::Basename qw(dirname basename); + +use Params::Validate qw(validate_with :types); + +BEGIN{ + $VERSION = 1.00; + $DEBUG = 0 unless defined $DEBUG; + + @EXPORT = (); + %EXPORT_TAGS = (configuration => [qw(dirsize create_debbugs_configuration send_message)], + ); + @EXPORT_OK = (); + Exporter::export_ok_tags(qw(configuration)); + $EXPORT_TAGS{all} = [@EXPORT_OK]; +} + +# First, we're going to send mesages to receive. +# To do so, we'll first send a message to submit, +# then send messages to the newly created bugnumber. + + + +sub create_debbugs_configuration { + my %param = validate_with(params => \@_, + spec => {debug => {type => BOOLEAN, + default => 0, + }, + cleanup => {type => BOOLEAN, + optional => 1, + }, + }, + ); + $param{cleanup} = $param{debug}?0:1 if not exists $param{cleanup}; + my $sendmail_dir = tempdir(CLEANUP => $param{cleanup}); + my $spool_dir = tempdir(CLEANUP => $param{cleanup}); + my $config_dir = tempdir(CLEANUP => $param{cleanup}); + + + $ENV{DEBBUGS_CONFIG_FILE} ="$config_dir/debbugs_config"; + $ENV{PERL5LIB} = getcwd(); + $ENV{SENDMAIL_TESTDIR} = $sendmail_dir; + my $sendmail_tester = getcwd().'/t/sendmail_tester'; + unless (-x $sendmail_tester) { + die q(t/sendmail_tester doesn't exist or isn't executable. You may be in the wrong directory.); + } + my %files_to_create = ("$config_dir/debbugs_config" => < qq(1\n), + "$config_dir/Maintainers" => qq(foo Blah Bleargh \n), + "$config_dir/Maintainers.override" => qq(), + "$config_dir/indices/sources" => <new($file,'w') or + die "Unable to create $file: $!"; + print {$fh} $contents or die "Unable to write $contents to $file: $!"; + close $fh or die "Unable to close $file: $!"; + } + + system('touch',"$spool_dir/index.db.realtime"); + system('ln','-s','index.db.realtime', + "$spool_dir/index.db"); + system('touch',"$spool_dir/index.archive.realtime"); + system('ln','-s','index.archive.realtime', + "$spool_dir/index.archive"); + + # create the spool files and sub directories + map {system('mkdir','-p',"$spool_dir/$_"); } + map {('db-h/'.$_,'archive/'.$_)} + map { sprintf "%02d",$_ % 100} 0..99; + system('mkdir','-p',"$spool_dir/incoming"); + system('mkdir','-p',"$spool_dir/lock"); + + return (spool_dir => $spool_dir, + sendmail_dir => $sendmail_dir, + config_dir => $config_dir, + ); +} + +sub dirsize{ + my ($dir) = @_; + opendir(DIR,$dir); + my @content = grep {!/^\.\.?$/} readdir(DIR); + closedir(DIR); + return scalar @content; +} + + +# We're going to use create mime message to create these messages, and +# then just send them to receive. +# First, check that submit@ works + +sub send_message{ + my %param = validate_with(params => \@_, + spec => {to => {type => SCALAR, + default => 'submit@bugs.something', + }, + headers => {type => ARRAYREF, + }, + body => {type => SCALAR, + }, + run_processall =>{type => BOOLEAN, + default => 1, + }, + } + ); + $ENV{LOCAL_PART} = $param{to}; + my $receive = new IO::File ('|scripts/receive.in') or die "Unable to start receive.in: $!"; + + print {$receive} create_mime_message($param{headers}, + $param{body}) or die "Unable to to print to receive.in"; + close($receive) or die "Unable to close receive.in"; + $? == 0 or die "receive.in failed"; + # now we should run processall to see if the message gets processed + if ($param{run_processall}) { + system('scripts/processall.in') == 0 or die "processall.in failed"; + } +} + + +1; + +__END__ + + + -- 2.39.2