Added absolute paths to ticket-menu.
[usit-rt.git] / sbin / rt-validate-aliases
CommitLineData
12d122df
MKG
1#!/usr/bin/perl
2# BEGIN BPS TAGGED BLOCK {{{
3#
4# COPYRIGHT:
5#
6# This software is Copyright (c) 1996-2012 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 }}}
49use strict;
50use warnings;
51use Text::ParseWords qw//;
52use Getopt::Long;
53
54BEGIN { # 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
69require RT;
70RT::LoadConfig();
71RT::Init();
72
73my ($PREFIX, $URL, $HOST) = ("");
74GetOptions(
75 "prefix|p=s" => \$PREFIX,
76 "url|u=s" => \$URL,
77 "host|h=s" => \$HOST,
78);
79
80unless (@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
88my %aliases = parse_lines();
89unless (%aliases) {
90 warn "No mailgate aliases found in @ARGV";
91 exit;
92}
93
94my %seen;
95my $global_mailgate;
96for 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
141my %global;
142for 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}
160warn "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
165my $queues = RT::Queues->new( RT->SystemUser );
166$queues->UnLimit;
167while (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
216sub 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
240sub 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
262sub 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
300sub 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
315sub 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}