15 This module contains various testing routines used to test debbugs in
24 use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT);
25 use base qw(Exporter);
28 use File::Temp qw(tempdir);
30 use Debbugs::MIME qw(create_mime_message);
31 use File::Basename qw(dirname basename);
36 use Params::Validate qw(validate_with :types);
40 $DEBUG = 0 unless defined $DEBUG;
43 %EXPORT_TAGS = (configuration => [qw(dirsize create_debbugs_configuration send_message)],
44 mail => [qw(num_messages_sent)],
47 Exporter::export_ok_tags(qw(configuration mail));
48 $EXPORT_TAGS{all} = [@EXPORT_OK];
51 # First, we're going to send mesages to receive.
52 # To do so, we'll first send a message to submit,
53 # then send messages to the newly created bugnumber.
57 sub create_debbugs_configuration {
58 my %param = validate_with(params => \@_,
59 spec => {debug => {type => BOOLEAN,
60 default => exists $ENV{DEBUG}?
63 cleanup => {type => BOOLEAN,
68 $param{cleanup} = $param{debug}?0:1 if not exists $param{cleanup};
69 my $sendmail_dir = tempdir(CLEANUP => $param{cleanup});
70 my $spool_dir = tempdir(CLEANUP => $param{cleanup});
71 my $config_dir = tempdir(CLEANUP => $param{cleanup});
74 $ENV{DEBBUGS_CONFIG_FILE} ="$config_dir/debbugs_config";
75 $ENV{PERL5LIB} = getcwd();
76 $ENV{SENDMAIL_TESTDIR} = $sendmail_dir;
78 my $sendmail_tester = getcwd().'/t/sendmail_tester';
79 unless (-x $sendmail_tester) {
80 die q(t/sendmail_tester doesn't exist or isn't executable. You may be in the wrong directory.);
82 my %files_to_create = ("$config_dir/debbugs_config" => <<END,
83 \$gSendmail='$sendmail_tester';
84 \$gSpoolDir='$spool_dir';
85 \$gLibPath='@{[getcwd()]}/scripts';
86 \$gTemplateDir='@{[getcwd()]}/templates';
87 \$gWebDir='@{[getcwd()]}/html';
88 \$gWebHost='localhost';
91 "$spool_dir/nextnumber" => qq(1\n),
92 "$config_dir/Maintainers" => qq(foo Blah Bleargh <foo\@baz.com>\nbar Bar Bleargh <bar\@baz.com>\n),
93 "$config_dir/Maintainers.override" => qq(),
94 "$config_dir/Source_maintainers" => qq(foo Blah Bleargh <foo\@baz.com>\nbar Bar Bleargh <bar\@baz.com>\n),
95 "$config_dir/indices/sources" => <<END,
98 "$config_dir/pseudo-packages.description" => '',
99 "$config_dir/pseudo-packages.maintainers" => '',
101 while (my ($file,$contents) = each %files_to_create) {
102 system('mkdir','-p',dirname($file));
103 my $fh = IO::File->new($file,'w') or
104 die "Unable to create $file: $!";
105 print {$fh} $contents or die "Unable to write $contents to $file: $!";
106 close $fh or die "Unable to close $file: $!";
109 system('touch',"$spool_dir/index.db.realtime");
110 system('ln','-s','index.db.realtime',
111 "$spool_dir/index.db");
112 system('touch',"$spool_dir/index.archive.realtime");
113 system('ln','-s','index.archive.realtime',
114 "$spool_dir/index.archive");
116 # create the spool files and sub directories
117 for my $dir (0..99) {
118 for my $archive (qw(db-h archive)) {
119 system('mkdir','-p',"$spool_dir/$archive/".sprintf('%02d',$dir));
122 system('mkdir','-p',"$spool_dir/incoming");
123 system('mkdir','-p',"$spool_dir/lock");
127 diag("spool_dir: $spool_dir\n");
128 diag("config_dir: $config_dir\n",);
129 diag("sendmail_dir: $sendmail_dir\n");
134 BAIL_OUT ($@) if ($@);
135 return (spool_dir => $spool_dir,
136 sendmail_dir => $sendmail_dir,
137 config_dir => $config_dir,
144 my @content = grep {!/^\.\.?$/} readdir(DIR);
146 return scalar @content;
150 # We're going to use create mime message to create these messages, and
151 # then just send them to receive.
152 # First, check that submit@ works
155 my %param = validate_with(params => \@_,
156 spec => {to => {type => SCALAR,
157 default => 'submit@bugs.something',
159 headers => {type => ARRAYREF,
161 body => {type => SCALAR,
163 attachments => {type => ARRAYREF,
166 run_processall =>{type => BOOLEAN,
171 $ENV{LOCAL_PART} = $param{to};
174 my $pipe_handler = $SIG{PIPE};
175 $SIG{PIPE} = 'IGNORE';
176 $SIG{CHLD} = 'DEFAULT';
177 my $pid = open3($wfd,$rfd,$rfd,'scripts/receive')
178 or die "Unable to start receive: $!";
179 print {$wfd} create_mime_message($param{headers},
181 $param{attachments}) or
182 die "Unable to to print to receive";
183 close($wfd) or die "Unable to close receive";
184 $SIG{PIPE} = $pipe_handler;
186 my $childpid = waitpid($pid,0);
187 if ($childpid != -1) {
189 print STDERR "receive pid: $pid doesn't match childpid: $childpid\n" if $childpid != $pid;
192 my $rfh = IO::Handle->new_from_fd($rfd,'r') or die "Unable to create filehandle: $!";
195 while ($rv = $rfh->sysread($output,1000,length($output))) {}
196 if (not defined $rv) {
197 print STDERR "Reading from STDOUT/STDERR would have blocked.";
199 print STDERR $output,qq(\n);
200 die "receive failed with exit status $err";
202 # now we should run processall to see if the message gets processed
203 if ($param{run_processall}) {
204 system('scripts/processall') == 0 or die "processall failed";
211 package DebbugsTest::HTTPServer;
212 use base qw(HTTP::Server::Simple::CGI HTTP::Server::Simple::CGI::Environment);
214 our $child_pid = undef;
215 our $webserver = undef;
216 our $server_handler = undef;
219 if (defined $child_pid) {
228 sub fork_and_create_webserver {
229 my ($handler,$port) = @_;
231 if (defined $child_pid) {
232 die "We appear to have already forked once";
234 $server_handler = $handler;
236 return 0 if not defined $pid;
239 # Wait here for a second to let the child start up
244 $webserver = DebbugsTest::HTTPServer->new($port);
251 if (defined $server_handler) {
252 $server_handler->(@_);
255 warn "No handler defined\n";
256 print "No handler defined\n";
261 =head2 num_messages_sent
263 $SD_SIZE = num_messages_sent($SD_SIZE,2,$sendmail_dir,'2 messages have been sent properly');
265 Tests to make sure that at least a certain number of messages have
266 been sent since the last time this command was run. Usefull to test to
267 make sure that mail has been sent.
271 sub num_messages_sent {
272 my ($prev_size,$num_messages,$sendmail_dir,$test_name) = @_;
273 my $cur_size = dirsize($sendmail_dir);
274 ## print STDERR "sendmail: $sendmail_dir, want: $num_messages,
275 ## size: $cur_size, prev_size: $prev_size\n";
276 ok($cur_size-$prev_size >= $num_messages, $test_name);