]> git.donarmstrong.com Git - debbugs.git/blob - bin/test_bts
Use a checkbox and CSS to show info messages instead of JavaScript
[debbugs.git] / 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__