bin/test_bts

   1 #!/usr/bin/perl
   2 # test_bts tests a running BTS by sending mail to it, and is released
   3 # under the terms of the GPL version 2, or any later version, at your
   4 # option. See the file README and COPYING for more information.
   5 # Copyright 2006 by Don Armstrong <don@debian.org>.
   6
   7
   8
   9 use warnings;
  10 use strict;
  11
  12
  13 use Getopt::Long;
  14 use Pod::Usage;
  15
  16 =head1 NAME
  17
  18 test_bts - Test a running bts install
  19
  20 =head1 SYNOPSIS
  21
  22 test_bts [options]
  23
  24  Options:
  25   --bug, -b bug number to mail
  26   --host, -h host to send mail to
  27   --control, -c whether to send control messages (off by default)
  28   --process, -p whether to send process messages (on by default)
  29   --submit, -s whether a new bug is created (off by default)
  30   --quiet, -q disable output (off by default)
  31   --debug, -d debugging level (Default 0)
  32   --help, -h display this help
  33   --man, -m display manual
  34
  35 =head1 OPTIONS
  36
  37 =over
  38
  39 =item B<--bug, -b>
  40
  41 Bug number to mail
  42
  43 =item B<--host, -H>
  44
  45 The host running the bts
  46
  47 =item B<--control, -c>
  48
  49 Whether control messages are sent; defaults to false.
  50
  51 =item B<--process, -p>
  52
  53 Whether messages are sent to process (bugnum@host)
  54
  55 =item B<--submit, -s>
  56
  57 Whether a new bug is created by a message to submit; not enabled by default.
  58
  59 =item B<--quiet,-q>
  60
  61 Disable output
  62
  63 =item B<--debug, -d>
  64
  65 Debug verbosity. (Default 0)
  66
  67 =item B<--help, -h>
  68
  69 Display brief useage information.
  70
  71 =item B<--man, -m>
  72
  73 Display this manual.
  74
  75 =back
  76
  77 =head1 EXAMPLES
  78
  79   test_bts --bug 7 --host donbugs.donarmstrong.com
  80
  81
  82 =cut
  83
  84
  85 use Debbugs::Mail qw(send_mail_message);
  86 use Debbugs::MIME qw(create_mime_message);
  87
  88
  89 use vars qw($DEBUG $VERBOSE);
  90
  91 # XXX parse config file
  92
  93 my %options = (debug           => 0,
  94                help            => 0,
  95                man             => 0,
  96                host            => undef,
  97                bug             => undef,
  98                quiet           => 0,
  99                from            => undef,
 100                process         => 1,
 101                submit          => 0,
 102                control         => 0,
 103               );
 104
 105 GetOptions(\%options,'host|H=s','bug|b=s','control|c!','submit|s!',
 106            'process|p!','from|f=s','quiet|q+',
 107            'debug|d+','help|h|?','man|m');
 108
 109 my $ERRORS = '';
 110
 111 $ERRORS .= "--from must be set\n" if not defined $options{from};
 112 $ERRORS .= "--host must be set\n" if not defined $options{host};
 113 $ERRORS .= "--bug must be set\n" if not defined $options{bug};
 114 pod2usage($ERRORS) if length $ERRORS;
 115
 116 pod2usage() if $options{help};
 117 pod2usage({verbose=>2}) if $options{man};
 118
 119
 120 $DEBUG = $options{debug};
 121
 122 $VERBOSE = 1 - $options{quiet};
 123
 124 if ($options{process}) {
 125      my @standard_headers = ([],
 126                              ['X-Debbugs-No-Ack:','yes no ack'],
 127                             );
 128
 129      my %process_messages = ('-maintonly' => \@standard_headers,
 130                              '-quiet'     => \@standard_headers,
 131                              '-forwarded' => \@standard_headers,
 132                              '-done'      => \@standard_headers,
 133                              '-submitter' => \@standard_headers,
 134                              ''           => \@standard_headers,
 135                             );
 136      my $message_count = 0;
 137      for my $addr (keys %process_messages) {
 138           for my $header (@{$process_messages{$addr}}) {
 139                $message_count++;
 140                my $message =
 141                     create_mime_message([To   => "$options{bug}$addr\@$options{host}",
 142                                          From => $options{from},
 143                                          Subject => "message $message_count to $addr from test_bts",
 144                                          @{$header},
 145                                         ],<<END
 146 This is a testing message from test_bts
 147 This message was sent:
 148 To: $options{bug}$addr\@$options{host}
 149 From: $options{from}
 150 Subject: message $message_count to $options{bug}$addr\@$options{host} from test_bts
 151
 152 with additional headers:
 153 @{$header}
 154
 155 If you are seeing this, and have no idea what this means, please
 156 ignore this message. If you are sure that this message has been sent
 157 in error please send mail to $options{from} so they can stop sending
 158 stupid messages to you.
 159
 160 If you are reading this message in a BTS, it's only a testing message.
 161 Please ignore it... it shouldn't have been sent to a public one, but
 162 accidents happen.
 163 END
 164                                        );
 165                send_mail_message(message   => $message,
 166                                  recipients => "$options{bug}$addr\@$options{host}",
 167                                 );
 168           }
 169      }
 170 }
 171 if ($options{control}) {
 172      die "Not implemented";
 173 }
 174 if ($options{submit}) {
 175      die "Not implemented";
 176 }
 177
 178 __END__