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