rt/sbin/rt-validate-aliases.in

   1 #!@PERL@
   2 # BEGIN BPS TAGGED BLOCK {{{
   3 #
   4 # COPYRIGHT:
   5 #
   6 # This software is Copyright (c) 1996-2019 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 = ("@RT_LIB_PATH@", "@LOCAL_LIB_PATH@");
  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
  70 require RT;
  71 RT::LoadConfig();
  72 RT::Init();
  73
  74 my ($PREFIX, $URL, $HOST) = ("");
  75 GetOptions(
  76     "prefix|p=s" => \$PREFIX,
  77     "url|u=s"    => \$URL,
  78     "host|h=s"   => \$HOST,
  79 );
  80
  81 unless (@ARGV) {
  82     @ARGV = grep {-f} ("/etc/aliases",
  83                        "/etc/mail/aliases",
  84                        "/etc/postfix/aliases");
  85     die "Can't determine aliases file to parse!"
  86         unless @ARGV;
  87 }
  88
  89 my %aliases = parse_lines();
  90 unless (%aliases) {
  91     warn "No mailgate aliases found in @ARGV";
  92     exit;
  93 }
  94
  95 my %seen;
  96 my $global_mailgate;
  97 for my $address (sort keys %aliases) {
  98     my ($mailgate, $opts, $extra) = @{$aliases{$address}};
  99     my %opts = %{$opts};
 100
 101     next if $opts{url} and $URL and $opts{url} !~ /\Q$URL\E/;
 102
 103     if ($mailgate !~ /^\|/) {
 104         warn "Missing the leading | on alias $address\n";
 105         $mailgate = "|$mailgate";
 106     }
 107     if (($global_mailgate ||= $mailgate) ne $mailgate) {
 108         warn "Unexpected mailgate for alias $address -- expected $global_mailgate, got $mailgate\n";
 109     }
 110
 111     if (not defined $opts{action}) {
 112         warn "Missing --action parameter for alias $address\n";
 113     } elsif ($opts{action} !~ /^(correspond|comment)$/) {
 114         warn "Invalid --action parameter for alias $address: $opts{action}\n"
 115     }
 116
 117     my $queue = RT::Queue->new( RT->SystemUser );
 118     if (not defined $opts{queue}) {
 119         warn "Missing --queue parameter for alias $address\n";
 120     } else {
 121         $queue->Load( $opts{queue} );
 122         if (not $queue->id) {
 123             warn "Invalid --queue parameter for alias $address: $opts{queue}\n";
 124         } elsif ($queue->Disabled) {
 125             warn "Disabled --queue given for alias $address: $opts{queue}\n";
 126         }
 127     }
 128
 129     if (not defined $opts{url}) {
 130         warn "Missing --url parameter for alias $address\n";
 131     } #XXX: Test connectivity and/or https certs?
 132
 133     if ($queue->id and $opts{action} =~ /^(correspond|comment)$/) {
 134         push @{$seen{lc $queue->Name}{$opts{action}}}, $address;
 135     }
 136
 137     warn "Unknown extra arguments for alias $address: @{$extra}\n"
 138         if @{$extra};
 139 }
 140
 141 # Check the global settings
 142 my %global;
 143 for my $action (qw/correspond comment/) {
 144     my $setting = ucfirst($action) . "Address";
 145     my $value = RT->Config->Get($setting);
 146     if (not defined $value) {
 147         warn "$setting is not set!\n";
 148         next;
 149     }
 150     my ($local,$host) = lc($value) =~ /(.*?)\@(.*)/;
 151     next if $HOST and $host !~ /\Q$HOST\E/;
 152     $local = "$PREFIX$local" unless exists $aliases{$local};
 153
 154     $global{$setting} = $local;
 155     if (not exists $aliases{$local}) {
 156         warn "$setting $value does not exist in aliases!\n"
 157     } elsif ($aliases{$local}[1]{action} ne $action) {
 158         warn "$setting $value is a $aliases{$local}[1]{action} in aliases!"
 159     }
 160 }
 161 warn "CorrespondAddress and CommentAddress are the same!\n"
 162     if RT->Config->Get("CorrespondAddress") eq RT->Config->Get("CommentAddress");
 163
 164
 165 # Go through the queues, one at a time
 166 my $queues = RT::Queues->new( RT->SystemUser );
 167 $queues->UnLimit;
 168 while (my $q = $queues->Next) {
 169     my $qname = $q->Name;
 170     for my $action (qw/correspond comment/) {
 171         my $setting = ucfirst($action) . "Address";
 172         my $value = $q->$setting;
 173
 174         if (not $value) {
 175             my @other = grep {$_ ne $global{$setting}} @{$seen{lc $q->Name}{$action} || []};
 176             warn "$setting not set on $qname, but in aliases as "
 177                 .join(" and ", @other) . "\n" if @other;
 178             next;
 179         }
 180
 181         if ($action eq "comment" and $q->CorrespondAddress
 182                 and $q->CorrespondAddress eq $q->CommentAddress) {
 183             warn "CorrespondAddress and CommentAddress are set the same on $qname\n";
 184             next;
 185         }
 186
 187         my ($local, $host) = lc($value) =~ /(.*?)\@(.*)/;
 188         next if $HOST and $host !~ /\Q$HOST\E/;
 189         $local = "$PREFIX$local" unless exists $aliases{$local};
 190
 191         my @other = @{$seen{lc $q->Name}{$action} || []};
 192         if (not exists $aliases{$local}) {
 193             if (@other) {
 194                 warn "$setting $value on $qname does not exist in aliases -- typo'd as "
 195                     .join(" or ", @other) . "?\n";
 196             } else {
 197                 warn "$setting $value on $qname does not exist in aliases!\n"
 198             }
 199             next;
 200         }
 201
 202         my %opt = %{$aliases{$local}[1]};
 203         if ($opt{action} ne $action) {
 204             warn "$setting address $value on $qname is a $opt{action} in aliases!\n"
 205         }
 206         if (lc $opt{queue} ne lc $q->Name and $action ne "comment") {
 207             warn "$setting address $value on $qname points to queue $opt{queue} in aliases!\n";
 208         }
 209
 210         @other = grep {$_ ne $local} @other;
 211         warn "Extra aliases for queue $qname: ".join(",",@other)."\n"
 212             if @other;
 213     }
 214 }
 215
 216
 217 sub parse_lines {
 218     local @ARGV = @ARGV;
 219
 220     my %aliases;
 221     my $line = "";
 222     for (<>) {
 223         next unless /\S/;
 224         next if /^#/;
 225         chomp;
 226         if (/^\s+/) {
 227             $line .= $_;
 228         } else {
 229             add_line($line, \%aliases);
 230             $line = $_;
 231         }
 232     }
 233     add_line($line, \%aliases);
 234
 235     expand(\%aliases);
 236     filter_mailgate(\%aliases);
 237
 238     return %aliases;
 239 }
 240
 241 sub expand {
 242     my ($data) = @_;
 243
 244     for (1..100) {
 245         my $expanded = 0;
 246         for my $address (sort keys %{$data}) {
 247             my @new;
 248             for my $part (@{$data->{$address}}) {
 249                 if (m!^[|/]! or not $data->{$part}) {
 250                     push @new, $part;
 251                 } else {
 252                     $expanded++;
 253                     push @new, @{$data->{$part}};
 254                 }
 255             }
 256             $data->{$address} = \@new;
 257         }
 258         return unless $expanded;
 259     }
 260     warn "Recursion limit exceeded -- cycle in aliases?\n";
 261 }
 262
 263 sub filter_mailgate {
 264     my ($data) = @_;
 265
 266     for my $address (sort keys %{$data}) {
 267         my @parts = @{delete $data->{$address}};
 268
 269         my @pipes = grep {m!^\|?.*?/rt-mailgate\b!} @parts;
 270         next unless @pipes;
 271
 272         my $pipe = shift @pipes;
 273         warn "More than one rt-mailgate pipe for alias: $address\n"
 274             if @pipes;
 275
 276         my @args = Text::ParseWords::shellwords($pipe);
 277
 278         # We allow "|/random-other-command /opt/rt4/bin/rt-mailgate ...",
 279         # we just need to strip off enough
 280         my $index = 0;
 281         $index++ while $args[$index] !~ m!/rt-mailgate!;
 282         my $mailgate = join(' ', splice(@args,0,$index+1));
 283
 284         my %opts;
 285         local @ARGV = @args;
 286         Getopt::Long::Configure( "pass_through" ); # Allow unknown options
 287         my $ret = eval {
 288             GetOptions( \%opts, "queue=s", "action=s", "url=s",
 289                         "jar=s", "debug", "extension=s",
 290                         "timeout=i", "verify-ssl!", "ca-file=s",
 291                     );
 292             1;
 293         };
 294         warn "Failed to parse options for $address: $@" unless $ret;
 295         next unless %opts;
 296
 297         $data->{lc $address} = [$mailgate, \%opts, [@ARGV]];
 298     }
 299 }
 300
 301 sub add_line {
 302     my ($line, $data) = @_;
 303     return unless $line =~ /\S/;
 304
 305     my ($name, $parts) = parse_line($line);
 306     return unless defined $name;
 307
 308     if (defined $data->{$name}) {
 309         warn "Duplicate definition for alias $name\n";
 310         return;
 311     }
 312
 313     $data->{lc $name} = $parts;
 314 }
 315
 316 sub parse_line {
 317     my $re_name      = qr/\S+/;
 318     # Intentionally accept pipe-like aliases with a missing | -- we deal with them later
 319     my $re_quoted_pipe    = qr/"\|?[^\\"]*(?:\\[\\"][^\\"]*)*"/;
 320     my $re_nonquoted_pipe = qr/\|[^\s,]+/;
 321     my $re_pipe      = qr/(?:$re_quoted_pipe|$re_nonquoted_pipe)/;
 322     my $re_path      = qr!/[^,\s]+!;
 323     my $re_address   = qr![^|/,\s][^,\s]*!;
 324     my $re_value     = qr/(?:$re_pipe|$re_path|$re_address)/;
 325     my $re_values    = qr/(?:$re_value(?:\s*,\s*$re_value)*)/;
 326
 327     my ($line) = @_;
 328     if ($line =~ /^($re_name):\s*($re_values)/) {
 329         my ($name, $all_parts) = ($1, $2);
 330         my @parts;
 331         while ($all_parts =~ s/^(?:\s*,\s*)?($re_value)//) {
 332             my $part = $1;
 333             if ($part =~ /^"/) {
 334                 $part =~ s/^"//; $part =~ s/"$//;
 335                 $part =~ s/\\(.)/$1/g;
 336             }
 337             push @parts, $part;
 338         }
 339         return $name, [@parts];
 340     } else {
 341         warn "Parse failure, line $. of $ARGV: $line\n";
 342         return ();
 343     }
 344 }
 345
 346 __END__
 347
 348 =head1 NAME
 349
 350 rt-validate-aliases - Check an MTA alias file against RT queue configuration
 351
 352 =head1 SYNOPSIS
 353
 354 rt-validate-aliases [options] /etc/aliases
 355
 356 =head1 OPTIONS
 357
 358 =over
 359
 360 =item C<--prefix>
 361
 362 An expected address prefix used in the alias file
 363
 364 =item C<--url>
 365
 366 The root URL of your RT server (the same URL you expect to be passed to
 367 rt-mailgate)
 368
 369 =item C<--host>
 370
 371 The host part of your RT email addresses
 372
 373 =back