]>
Commit | Line | Data |
---|---|---|
1 | #!/usr/bin/perl | |
2 | # BEGIN BPS TAGGED BLOCK {{{ | |
3 | # | |
4 | # COPYRIGHT: | |
5 | # | |
6 | # This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC | |
7 | # <sales@bestpractical.com> | |
8 | # | |
9 | # (Except where explicitly superseded by other copyright notices) | |
10 | # | |
11 | # | |
12 | # LICENSE: | |
13 | # | |
14 | # This work is made available to you under the terms of Version 2 of | |
15 | # the GNU General Public License. A copy of that license should have | |
16 | # been provided with this software, but in any event can be snarfed | |
17 | # from www.gnu.org. | |
18 | # | |
19 | # This work is distributed in the hope that it will be useful, but | |
20 | # WITHOUT ANY WARRANTY; without even the implied warranty of | |
21 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
22 | # General Public License for more details. | |
23 | # | |
24 | # You should have received a copy of the GNU General Public License | |
25 | # along with this program; if not, write to the Free Software | |
26 | # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA | |
27 | # 02110-1301 or visit their web page on the internet at | |
28 | # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. | |
29 | # | |
30 | # | |
31 | # CONTRIBUTION SUBMISSION POLICY: | |
32 | # | |
33 | # (The following paragraph is not intended to limit the rights granted | |
34 | # to you to modify and distribute this software under the terms of | |
35 | # the GNU General Public License and is only of importance to you if | |
36 | # you choose to contribute your changes and enhancements to the | |
37 | # community by submitting them to Best Practical Solutions, LLC.) | |
38 | # | |
39 | # By intentionally submitting any modifications, corrections or | |
40 | # derivatives to this work, or any other work intended for use with | |
41 | # Request Tracker, to Best Practical Solutions, LLC, you confirm that | |
42 | # you are the copyright holder for those contributions and you grant | |
43 | # Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, | |
44 | # royalty-free, perpetual, license to use, copy, create derivative | |
45 | # works based on those contributions, and sublicense and distribute | |
46 | # those contributions and any derivatives thereof. | |
47 | # | |
48 | # END BPS TAGGED BLOCK }}} | |
49 | use strict; | |
50 | use warnings; | |
51 | use Text::ParseWords qw//; | |
52 | use Getopt::Long; | |
53 | ||
54 | BEGIN { # BEGIN RT CMD BOILERPLATE | |
55 | require File::Spec; | |
56 | require Cwd; | |
57 | my @libs = ("lib", "local/lib"); | |
58 | my $bin_path; | |
59 | ||
60 | for my $lib (@libs) { | |
61 | unless ( File::Spec->file_name_is_absolute($lib) ) { | |
62 | $bin_path ||= ( File::Spec->splitpath(Cwd::abs_path(__FILE__)) )[1]; | |
63 | $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib ); | |
64 | } | |
65 | unshift @INC, $lib; | |
66 | } | |
67 | } | |
68 | ||
69 | require RT; | |
70 | RT::LoadConfig(); | |
71 | RT::Init(); | |
72 | ||
73 | my ($PREFIX, $URL, $HOST) = (""); | |
74 | GetOptions( | |
75 | "prefix|p=s" => \$PREFIX, | |
76 | "url|u=s" => \$URL, | |
77 | "host|h=s" => \$HOST, | |
78 | ); | |
79 | ||
80 | unless (@ARGV) { | |
81 | @ARGV = grep {-f} ("/etc/aliases", | |
82 | "/etc/mail/aliases", | |
83 | "/etc/postfix/aliases"); | |
84 | die "Can't determine aliases file to parse!" | |
85 | unless @ARGV; | |
86 | } | |
87 | ||
88 | my %aliases = parse_lines(); | |
89 | unless (%aliases) { | |
90 | warn "No mailgate aliases found in @ARGV"; | |
91 | exit; | |
92 | } | |
93 | ||
94 | my %seen; | |
95 | my $global_mailgate; | |
96 | for my $address (sort keys %aliases) { | |
97 | my ($mailgate, $opts, $extra) = @{$aliases{$address}}; | |
98 | my %opts = %{$opts}; | |
99 | ||
100 | next if $opts{url} and $URL and $opts{url} !~ /\Q$URL\E/; | |
101 | ||
102 | if ($mailgate !~ /^\|/) { | |
103 | warn "Missing the leading | on alias $address\n"; | |
104 | $mailgate = "|$mailgate"; | |
105 | } | |
106 | if (($global_mailgate ||= $mailgate) ne $mailgate) { | |
107 | warn "Unexpected mailgate for alias $address -- expected $global_mailgate, got $mailgate\n"; | |
108 | } | |
109 | ||
110 | if (not defined $opts{action}) { | |
111 | warn "Missing --action parameter for alias $address\n"; | |
112 | } elsif ($opts{action} !~ /^(correspond|comment)$/) { | |
113 | warn "Invalid --action parameter for alias $address: $opts{action}\n" | |
114 | } | |
115 | ||
116 | my $queue = RT::Queue->new( RT->SystemUser ); | |
117 | if (not defined $opts{queue}) { | |
118 | warn "Missing --queue parameter for alias $address\n"; | |
119 | } else { | |
120 | $queue->Load( $opts{queue} ); | |
121 | if (not $queue->id) { | |
122 | warn "Invalid --queue parameter for alias $address: $opts{queue}\n"; | |
123 | } elsif ($queue->Disabled) { | |
124 | warn "Disabled --queue given for alias $address: $opts{queue}\n"; | |
125 | } | |
126 | } | |
127 | ||
128 | if (not defined $opts{url}) { | |
129 | warn "Missing --url parameter for alias $address\n"; | |
130 | } #XXX: Test connectivity and/or https certs? | |
131 | ||
132 | if ($queue->id and $opts{action} =~ /^(correspond|comment)$/) { | |
133 | push @{$seen{lc $queue->Name}{$opts{action}}}, $address; | |
134 | } | |
135 | ||
136 | warn "Unknown extra arguments for alias $address: @{$extra}\n" | |
137 | if @{$extra}; | |
138 | } | |
139 | ||
140 | # Check the global settings | |
141 | my %global; | |
142 | for my $action (qw/correspond comment/) { | |
143 | my $setting = ucfirst($action) . "Address"; | |
144 | my $value = RT->Config->Get($setting); | |
145 | if (not defined $value) { | |
146 | warn "$setting is not set!\n"; | |
147 | next; | |
148 | } | |
149 | my ($local,$host) = lc($value) =~ /(.*?)\@(.*)/; | |
150 | next if $HOST and $host !~ /\Q$HOST\E/; | |
151 | $local = "$PREFIX$local" unless exists $aliases{$local}; | |
152 | ||
153 | $global{$setting} = $local; | |
154 | if (not exists $aliases{$local}) { | |
155 | warn "$setting $value does not exist in aliases!\n" | |
156 | } elsif ($aliases{$local}[1]{action} ne $action) { | |
157 | warn "$setting $value is a $aliases{$local}[1]{action} in aliases!" | |
158 | } | |
159 | } | |
160 | warn "CorrespondAddress and CommentAddress are the same!\n" | |
161 | if RT->Config->Get("CorrespondAddress") eq RT->Config->Get("CommentAddress"); | |
162 | ||
163 | ||
164 | # Go through the queues, one at a time | |
165 | my $queues = RT::Queues->new( RT->SystemUser ); | |
166 | $queues->UnLimit; | |
167 | while (my $q = $queues->Next) { | |
168 | my $qname = $q->Name; | |
169 | for my $action (qw/correspond comment/) { | |
170 | my $setting = ucfirst($action) . "Address"; | |
171 | my $value = $q->$setting; | |
172 | ||
173 | if (not $value) { | |
174 | my @other = grep {$_ ne $global{$setting}} @{$seen{lc $q->Name}{$action} || []}; | |
175 | warn "CorrespondAddress not set on $qname, but in aliases as " | |
176 | .join(" and ", @other) . "\n" if @other; | |
177 | next; | |
178 | } | |
179 | ||
180 | if ($action eq "comment" and $q->CorrespondAddress | |
181 | and $q->CorrespondAddress eq $q->CommentAddress) { | |
182 | warn "CorrespondAddress and CommentAddress are set the same on $qname\n"; | |
183 | next; | |
184 | } | |
185 | ||
186 | my ($local, $host) = lc($value) =~ /(.*?)\@(.*)/; | |
187 | next if $HOST and $host !~ /\Q$HOST\E/; | |
188 | $local = "$PREFIX$local" unless exists $aliases{$local}; | |
189 | ||
190 | my @other = @{$seen{lc $q->Name}{$action} || []}; | |
191 | if (not exists $aliases{$local}) { | |
192 | if (@other) { | |
193 | warn "$setting $value on $qname does not exist in aliases -- typo'd as " | |
194 | .join(" or ", @other) . "?\n"; | |
195 | } else { | |
196 | warn "$setting $value on $qname does not exist in aliases!\n" | |
197 | } | |
198 | next; | |
199 | } | |
200 | ||
201 | my %opt = %{$aliases{$local}[1]}; | |
202 | if ($opt{action} ne $action) { | |
203 | warn "$setting address $value on $qname is a $opt{action} in aliases!\n" | |
204 | } | |
205 | if (lc $opt{queue} ne lc $q->Name and $action ne "comment") { | |
206 | warn "$setting address $value on $qname points to queue $opt{queue} in aliases!\n"; | |
207 | } | |
208 | ||
209 | @other = grep {$_ ne $local} @other; | |
210 | warn "Extra aliases for queue $qname: ".join(",",@other)."\n" | |
211 | if @other; | |
212 | } | |
213 | } | |
214 | ||
215 | ||
216 | sub parse_lines { | |
217 | local @ARGV = @ARGV; | |
218 | ||
219 | my %aliases; | |
220 | my $line = ""; | |
221 | for (<>) { | |
222 | next unless /\S/; | |
223 | next if /^#/; | |
224 | chomp; | |
225 | if (/^\s+/) { | |
226 | $line .= $_; | |
227 | } else { | |
228 | add_line($line, \%aliases); | |
229 | $line = $_; | |
230 | } | |
231 | } | |
232 | add_line($line, \%aliases); | |
233 | ||
234 | expand(\%aliases); | |
235 | filter_mailgate(\%aliases); | |
236 | ||
237 | return %aliases; | |
238 | } | |
239 | ||
240 | sub expand { | |
241 | my ($data) = @_; | |
242 | ||
243 | for (1..100) { | |
244 | my $expanded = 0; | |
245 | for my $address (sort keys %{$data}) { | |
246 | my @new; | |
247 | for my $part (@{$data->{$address}}) { | |
248 | if (m!^[|/]! or not $data->{$part}) { | |
249 | push @new, $part; | |
250 | } else { | |
251 | $expanded++; | |
252 | push @new, @{$data->{$part}}; | |
253 | } | |
254 | } | |
255 | $data->{$address} = \@new; | |
256 | } | |
257 | return unless $expanded; | |
258 | } | |
259 | warn "Recursion limit exceeded -- cycle in aliases?\n"; | |
260 | } | |
261 | ||
262 | sub filter_mailgate { | |
263 | my ($data) = @_; | |
264 | ||
265 | for my $address (sort keys %{$data}) { | |
266 | my @parts = @{delete $data->{$address}}; | |
267 | ||
268 | my @pipes = grep {m!^\|?.*?/rt-mailgate\b!} @parts; | |
269 | next unless @pipes; | |
270 | ||
271 | my $pipe = shift @pipes; | |
272 | warn "More than one rt-mailgate pipe for alias: $address\n" | |
273 | if @pipes; | |
274 | ||
275 | my @args = Text::ParseWords::shellwords($pipe); | |
276 | ||
277 | # We allow "|/random-other-command /opt/rt4/bin/rt-mailgate ...", | |
278 | # we just need to strip off enough | |
279 | my $index = 0; | |
280 | $index++ while $args[$index] !~ m!/rt-mailgate!; | |
281 | my $mailgate = join(' ', splice(@args,0,$index+1)); | |
282 | ||
283 | my %opts; | |
284 | local @ARGV = @args; | |
285 | Getopt::Long::Configure( "pass_through" ); # Allow unknown options | |
286 | my $ret = eval { | |
287 | GetOptions( \%opts, "queue=s", "action=s", "url=s", | |
288 | "jar=s", "debug", "extension=s", | |
289 | "timeout=i", "verify-ssl!", "ca-file=s", | |
290 | ); | |
291 | 1; | |
292 | }; | |
293 | warn "Failed to parse options for $address: $@" unless $ret; | |
294 | next unless %opts; | |
295 | ||
296 | $data->{lc $address} = [$mailgate, \%opts, [@ARGV]]; | |
297 | } | |
298 | } | |
299 | ||
300 | sub add_line { | |
301 | my ($line, $data) = @_; | |
302 | return unless $line =~ /\S/; | |
303 | ||
304 | my ($name, $parts) = parse_line($line); | |
305 | return unless defined $name; | |
306 | ||
307 | if (defined $data->{$name}) { | |
308 | warn "Duplicate definition for alias $name\n"; | |
309 | return; | |
310 | } | |
311 | ||
312 | $data->{lc $name} = $parts; | |
313 | } | |
314 | ||
315 | sub parse_line { | |
316 | my $re_name = qr/\S+/; | |
317 | # Intentionally accept pipe-like aliases with a missing | -- we deal with them later | |
318 | my $re_quoted_pipe = qr/"\|?[^\\"]*(?:\\[\\"][^\\"]*)*"/; | |
319 | my $re_nonquoted_pipe = qr/\|[^\s,]+/; | |
320 | my $re_pipe = qr/(?:$re_quoted_pipe|$re_nonquoted_pipe)/; | |
321 | my $re_path = qr!/[^,\s]+!; | |
322 | my $re_address = qr![^|/,\s][^,\s]*!; | |
323 | my $re_value = qr/(?:$re_pipe|$re_path|$re_address)/; | |
324 | my $re_values = qr/(?:$re_value(?:\s*,\s*$re_value)*)/; | |
325 | ||
326 | my ($line) = @_; | |
327 | if ($line =~ /^($re_name):\s*($re_values)/) { | |
328 | my ($name, $all_parts) = ($1, $2); | |
329 | my @parts; | |
330 | while ($all_parts =~ s/^(?:\s*,\s*)?($re_value)//) { | |
331 | my $part = $1; | |
332 | if ($part =~ /^"/) { | |
333 | $part =~ s/^"//; $part =~ s/"$//; | |
334 | $part =~ s/\\(.)/$1/g; | |
335 | } | |
336 | push @parts, $part; | |
337 | } | |
338 | return $name, [@parts]; | |
339 | } else { | |
340 | warn "Parse failure, line $. of $ARGV: $line\n"; | |
341 | return (); | |
342 | } | |
343 | } |