Upgrade to 4.0.8 with mod of ExternalAuth + absolute paths to ticket-menu.
[usit-rt.git] / sbin / rt-validate-aliases
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 }}}
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 }