/usr/share/perl5/Mail/ListDetector/Detector/Ecartis.pm is in libmail-listdetector-perl 1.03+dfsg-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 | package Mail::ListDetector::Detector::Ecartis;
use strict;
use base qw(Mail::ListDetector::Detector::Base);
use Mail::ListDetector::List;
use Email::Valid;
use Carp;
sub DEBUG { 0 }
sub match {
my $self = shift;
my $message = shift;
print "Got message $message\n" if DEBUG;
carp ("Mail::ListDetector::Detector::Ecartis - no message supplied") unless defined($message);
use Email::Abstract;
my @senders = Email::Abstract->get_header($message, 'Sender');
my $list;
foreach my $sender (@senders) {
chomp $sender;
($list) = ($sender =~ /^owner-(\S+)$/);
if (!(defined $list)) {
print "Sender didn't match owner-, trying -owner\n" if DEBUG;
if ($sender =~ /^(\S+?)-owner/) {
print "Sender matched -owner, removing\n" if DEBUG;
$list = $sender;
$list =~ s/-owner@/@/;
} else {
print "Sender didn't match second owner form\n" if DEBUG;
if ($sender =~ /^(\S+?)-bounce/) {
print "Sender matched -bounce, removing\n" if DEBUG;
$list = $sender;
$list =~ s/-bounce@/@/;
} else {
print "Sender didn't match bounce form\n" if DEBUG;
}
}
}
last if defined $list;
}
return unless defined $list;
chomp $list;
print "Got list [$list]\n" if DEBUG;
return unless Email::Valid->address($list);
print "List is valid email\n" if DEBUG;
# get Ecartis version
my $lv = Email::Abstract->get_header($message, 'X-Ecartis-Version');
return undef unless defined $lv;
chomp $lv;
my $listname = Email::Abstract->get_header($message, 'X-List');
return undef unless defined $listname;
chomp $listname;
my $l = new Mail::ListDetector::List;
$l->listsoftware($lv);
$l->posting_address($list);
$l->listname($listname);
return $l;
}
1;
__END__
=pod
=head1 NAME
Mail::ListDetector::Detector::Ecartis - Ecartis message detector
=head1 SYNOPSIS
use Mail::ListDetector::Detector::Ecartis;
=head1 DESCRIPTION
An implementation of a mailing list detector, for Ecartis.
Ecartis can be configured for rfc2369 compliance, however often this is not
done. If an Ecartis list is configured to be rfc2369 compliant then it will
be recognized by that detector instead.
=head1 METHODS
=head2 new()
Inherited from Mail::ListDetector::Detector::Base.
=head2 match()
Accepts a Mail::Internet object and returns either a
Mail::ListDetector::List object if it is a post to a Ecartis
mailing list, or C<undef>.
=head1 BUGS
None known.
=head1 AUTHOR
Michael Stevens - michael@etla.org.
=cut
|