152 lines
5.1 KiB
Perl
152 lines
5.1 KiB
Perl
# <@LICENSE>
|
|
# Licensed to the Apache Software Foundation (ASF) under one or more
|
|
# contributor license agreements. See the NOTICE file distributed with
|
|
# this work for additional information regarding copyright ownership.
|
|
# The ASF licenses this file to you under the Apache License, Version 2.0
|
|
# (the "License"); you may not use this file except in compliance with
|
|
# the License. You may obtain a copy of the License at:
|
|
#
|
|
# http://www.apache.org/licenses/LICENSE-2.0
|
|
#
|
|
# Unless required by applicable law or agreed to in writing, software
|
|
# distributed under the License is distributed on an "AS IS" BASIS,
|
|
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
# See the License for the specific language governing permissions and
|
|
# limitations under the License.
|
|
# </@LICENSE>
|
|
|
|
# Eval Tests to detect genuine mailing lists.
|
|
|
|
use strict; # make Test::Perl::Critic happy
|
|
package Mail::SpamAssassin::MailingList; 1;
|
|
|
|
package Mail::SpamAssassin::PerMsgStatus;
|
|
|
|
use strict;
|
|
use warnings;
|
|
# use bytes;
|
|
use re 'taint';
|
|
|
|
sub detect_mailing_list {
|
|
my ($self) = @_;
|
|
return 1 if $self->detect_ml_ezmlm();
|
|
return 1 if $self->detect_ml_mailman();
|
|
return 1 if $self->detect_ml_sympa();
|
|
return 0;
|
|
}
|
|
|
|
# EZMLM
|
|
# Mailing-List: .*run by ezmlm
|
|
# Precedence: bulk
|
|
# List-Post: <mailto:
|
|
# List-Help: <mailto:
|
|
# List-Unsubscribe: <mailto:[a-zA-Z\.-]+-unsubscribe@
|
|
# List-Subscribe: <mailto:[a-zA-Z\.-]+-subscribe@
|
|
sub detect_ml_ezmlm {
|
|
my ($self) = @_;
|
|
return 0 unless $self->get('mailing-list') =~ /ezmlm$/;
|
|
return 0 unless $self->get('precedence') eq "bulk\n";
|
|
return 0 unless $self->get('list-post') =~ /^<mailto:/i;
|
|
return 0 unless $self->get('list-help') =~ /^<mailto:/i;
|
|
return 0 unless $self->get('list-unsubscribe') =~ /<mailto:[a-zA-Z\.-]+-unsubscribe\@/i;
|
|
return 0 unless $self->get('list-subscribe') =~ /<mailto:[a-zA-Z\.-]+-subscribe\@/i;
|
|
return 1; # assume ezmlm then.
|
|
}
|
|
|
|
# MailMan (the gnu mailing list manager)
|
|
# Precedence: bulk [or list for v2]
|
|
# List-Help: <mailto:
|
|
# List-Post: <mailto:
|
|
# List-Subscribe: .*<mailto:.*=subscribe>
|
|
# List-Id:
|
|
# List-Unsubscribe: .*<mailto:.*=unsubscribe>
|
|
# List-Archive:
|
|
# X-Mailman-Version: \d
|
|
#
|
|
# However, for mailing list membership reminders, most of
|
|
# those headers are gone, so we identify on the following:
|
|
#
|
|
# Subject: ...... mailing list memberships reminder (v1)
|
|
# or X-List-Administrivia: yes (only in version 2)
|
|
# X-Mailman-Version: \d
|
|
# Precedence: bulk [or list for v2]
|
|
# X-No-Archive: yes
|
|
# Errors-To:
|
|
# X-BeenThere:
|
|
sub detect_ml_mailman {
|
|
my ($self) = @_;
|
|
return 0 unless $self->get('x-mailman-version') =~ /^\d/;
|
|
return 0 unless $self->get('precedence') =~ /^(?:bulk|list)$/;
|
|
|
|
if ($self->get('x-list-administrivia') =~ /yes/ ||
|
|
$self->get('subject') =~ /mailing list memberships reminder$/)
|
|
{
|
|
return 0 unless defined $self->get('errors-to',undef);
|
|
return 0 unless defined $self->get('x-beenthere',undef);
|
|
return 0 unless $self->get('x-no-archive') =~ /yes/;
|
|
return 1;
|
|
}
|
|
|
|
return 0 unless defined $self->get('list-id',undef);
|
|
return 0 unless $self->get('list-help') =~ /^<mailto:/i;
|
|
return 0 unless $self->get('list-post') =~ /^<mailto:/i;
|
|
return 0 unless $self->get('list-subscribe') =~ /<mailto:.*=subscribe>/i;
|
|
return 0 unless $self->get('list-unsubscribe') =~ /<mailto:.*=unsubscribe>/i;
|
|
return 1; # assume this is a valid mailman list
|
|
}
|
|
|
|
# Sympa
|
|
# Return-Path: somelist-owner@somedomain.com [...]
|
|
# Precedence: list [...]
|
|
# List-Id: <somelist@somedomain.com>
|
|
# List-Help: <mailto:sympa@somedomain.com?subject=help>
|
|
# List-Subscribe: <mailto:somedomain.com?subject=subscribe%20somelist>
|
|
# List-Unsubscribe: <mailto:sympa@somedomain.com?subject=unsubscribe%somelist>
|
|
# List-Post: <mailto:somelist@somedomain.com>
|
|
# List-Owner: <mailto:somelist-request@somedomain.com>
|
|
# X-Mailer: Sympa 6.2.22
|
|
# X-Sympa-To: somelist@somedomain.com
|
|
# [and optionally] List-Archive: <http://www.somedomain.com/wws/arc/somelist>
|
|
|
|
sub detect_ml_sympa {
|
|
my ($self) = @_;
|
|
return 1 if $self->get('X-Mailer') =~ /^Sympa \d\.\d\.\d/;
|
|
return 1 if defined ($self->get('X-Sympa-To',undef));
|
|
return 0;
|
|
}
|
|
|
|
# Lyris
|
|
# Not implemented - need headers
|
|
sub detect_ml_lyris {
|
|
}
|
|
|
|
# ListBuilder
|
|
# Sep 17 2002 jm: turned off due to bad S/O ratio
|
|
|
|
# sub detect_ml_listbuilder {
|
|
# my ($self, $full) = @_;
|
|
#
|
|
# my $reply = $self->get('Reply-To:addr');
|
|
# if ($reply !~ /\@lb.bcentral.com/) { return 0; }
|
|
#
|
|
# # Received: from unknown (HELO lbrout14.listbuilder.com) (204.71.191.9)
|
|
# my $rcvd = $self->get('received');
|
|
# return 0 unless ($rcvd =~ /\blbrout\d+\.listbuilder\.com\b/i);
|
|
# return 0 unless ($rcvd =~ /\b204\.71\.191\.\d+\b/);
|
|
#
|
|
# # _______________________________________________________________________
|
|
# # Powered by List Builder
|
|
# # To unsubscribe follow the link:
|
|
# # http://lb.bcentral.com/ex/sp?c=19511&s=76CA511711046877&m=14
|
|
# $full = join ("\n", @{$full});
|
|
#
|
|
# if ($full !~ /__________________{40,}\s+Powered by List Builder\s/) { return 0; }
|
|
# if ($full !~
|
|
# m,\shttp://lb\.bcentral\.com/ex/sp\?c=[0-9A-Z]*&s=[0-9A-Z]*&m=[0-9A-Z]*\s,)
|
|
# { return 0; }
|
|
#
|
|
# return 1;
|
|
# }
|
|
|
|
1;
|