2 # BEGIN BPS TAGGED BLOCK {{{
6 # This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
7 # <sales@bestpractical.com>
9 # (Except where explicitly superseded by other copyright notices)
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
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.
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.
31 # CONTRIBUTION SUBMISSION POLICY:
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.)
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.
48 # END BPS TAGGED BLOCK }}}
51 use Text::ParseWords qw//;
54 BEGIN { # BEGIN RT CMD BOILERPLATE
57 my @libs = ("lib", "local/lib");
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 );
74 my ($PREFIX, $URL, $HOST) = ("");
76 "prefix|p=s" => \$PREFIX,
82 @ARGV = grep {-f} ("/etc/aliases",
84 "/etc/postfix/aliases");
85 die "Can't determine aliases file to parse!"
89 my %aliases = parse_lines();
91 warn "No mailgate aliases found in @ARGV";
97 for my $address (sort keys %aliases) {
98 my ($mailgate, $opts, $extra) = @{$aliases{$address}};
101 next if $opts{url} and $URL and $opts{url} !~ /\Q$URL\E/;
103 if ($mailgate !~ /^\|/) {
104 warn "Missing the leading | on alias $address\n";
105 $mailgate = "|$mailgate";
107 if (($global_mailgate ||= $mailgate) ne $mailgate) {
108 warn "Unexpected mailgate for alias $address -- expected $global_mailgate, got $mailgate\n";
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"
117 my $queue = RT::Queue->new( RT->SystemUser );
118 if (not defined $opts{queue}) {
119 warn "Missing --queue parameter for alias $address\n";
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";
129 if (not defined $opts{url}) {
130 warn "Missing --url parameter for alias $address\n";
131 } #XXX: Test connectivity and/or https certs?
133 if ($queue->id and $opts{action} =~ /^(correspond|comment)$/) {
134 push @{$seen{lc $queue->Name}{$opts{action}}}, $address;
137 warn "Unknown extra arguments for alias $address: @{$extra}\n"
141 # Check the global settings
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";
150 my ($local,$host) = lc($value) =~ /(.*?)\@(.*)/;
151 next if $HOST and $host !~ /\Q$HOST\E/;
152 $local = "$PREFIX$local" unless exists $aliases{$local};
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!"
161 warn "CorrespondAddress and CommentAddress are the same!\n"
162 if RT->Config->Get("CorrespondAddress") eq RT->Config->Get("CommentAddress");
165 # Go through the queues, one at a time
166 my $queues = RT::Queues->new( RT->SystemUser );
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;
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;
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";
187 my ($local, $host) = lc($value) =~ /(.*?)\@(.*)/;
188 next if $HOST and $host !~ /\Q$HOST\E/;
189 $local = "$PREFIX$local" unless exists $aliases{$local};
191 my @other = @{$seen{lc $q->Name}{$action} || []};
192 if (not exists $aliases{$local}) {
194 warn "$setting $value on $qname does not exist in aliases -- typo'd as "
195 .join(" or ", @other) . "?\n";
197 warn "$setting $value on $qname does not exist in aliases!\n"
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"
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";
210 @other = grep {$_ ne $local} @other;
211 warn "Extra aliases for queue $qname: ".join(",",@other)."\n"
229 add_line($line, \%aliases);
233 add_line($line, \%aliases);
236 filter_mailgate(\%aliases);
246 for my $address (sort keys %{$data}) {
248 for my $part (@{$data->{$address}}) {
249 if (m!^[|/]! or not $data->{$part}) {
253 push @new, @{$data->{$part}};
256 $data->{$address} = \@new;
258 return unless $expanded;
260 warn "Recursion limit exceeded -- cycle in aliases?\n";
263 sub filter_mailgate {
266 for my $address (sort keys %{$data}) {
267 my @parts = @{delete $data->{$address}};
269 my @pipes = grep {m!^\|?.*?/rt-mailgate\b!} @parts;
272 my $pipe = shift @pipes;
273 warn "More than one rt-mailgate pipe for alias: $address\n"
276 my @args = Text::ParseWords::shellwords($pipe);
278 # We allow "|/random-other-command /opt/rt4/bin/rt-mailgate ...",
279 # we just need to strip off enough
281 $index++ while $args[$index] !~ m!/rt-mailgate!;
282 my $mailgate = join(' ', splice(@args,0,$index+1));
286 Getopt::Long::Configure( "pass_through" ); # Allow unknown options
288 GetOptions( \%opts, "queue=s", "action=s", "url=s",
289 "jar=s", "debug", "extension=s",
290 "timeout=i", "verify-ssl!", "ca-file=s",
294 warn "Failed to parse options for $address: $@" unless $ret;
297 $data->{lc $address} = [$mailgate, \%opts, [@ARGV]];
302 my ($line, $data) = @_;
303 return unless $line =~ /\S/;
305 my ($name, $parts) = parse_line($line);
306 return unless defined $name;
308 if (defined $data->{$name}) {
309 warn "Duplicate definition for alias $name\n";
313 $data->{lc $name} = $parts;
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)*)/;
328 if ($line =~ /^($re_name):\s*($re_values)/) {
329 my ($name, $all_parts) = ($1, $2);
331 while ($all_parts =~ s/^(?:\s*,\s*)?($re_value)//) {
334 $part =~ s/^"//; $part =~ s/"$//;
335 $part =~ s/\\(.)/$1/g;
339 return $name, [@parts];
341 warn "Parse failure, line $. of $ARGV: $line\n";