/usr/share/perl5/Mail/ListDetector/Detector/Majordomo.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 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 | package Mail::ListDetector::Detector::Majordomo;
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::Majordomo - no message supplied") unless defined($message);
use Email::Abstract;
my $sender = Email::Abstract->get_header($message, 'Sender');
print "Got sender\n" if DEBUG;
return unless defined $sender;
print "Sender was defined\n" if DEBUG;
chomp $sender;
print "Sender is [$sender]\n" if DEBUG;
my ($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;
return undef;
}
}
return unless defined $list;
chomp $list;
print "Got list [$list]\n" if DEBUG;
if ($list =~ m/(majordomo?|domo)\@/) {
return undef;
}
return unless Email::Valid->address($list);
print "List is valid email\n" if DEBUG;
my $mv;
# Some versions of Majordomo provide a version number
unless ($mv = Email::Abstract->get_header($message, 'X-Majordomo-Version')) {
# If we don't have a version number check the received headers.
my (@received) = Email::Abstract->get_header($message, 'Received');
my $majordom = 0;
foreach my $received_line (@received) {
if ($received_line =~ /(majordomo?|domo)\@/) {
$majordom++;
last;
}
}
print "Received check returned [$majordom]\n" if DEBUG;
return unless $majordom;
}
print "On list\n" if DEBUG;
my $l = new Mail::ListDetector::List;
if ($mv) {
$l->listsoftware("majordomo $mv");
} else {
$l->listsoftware('majordomo');
}
$l->posting_address($list);
print "Set listsoftware 'majordomo', posting address [$list]\n" if DEBUG;
my ($listname) = ($list =~ /^([^@]+)@/);
print "Listname is [$listname]\n" if DEBUG;
$l->listname($listname);
return $l;
}
1;
__END__
=pod
=head1 NAME
Mail::ListDetector::Detector::Majordomo - Majordomo message detector
=head1 SYNOPSIS
use Mail::ListDetector::Detector::Majordomo;
=head1 DESCRIPTION
An implementation of a mailing list detector, for majordomo.
=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 majordomo
mailing list, or C<undef>.
=head1 BUGS
=over 4
=item *
This module needs to guess a little about whether a message is a post
to a majordomo mailing list, as majordomo puts so little information in
the message headers.
=back
=head1 AUTHOR
Michael Stevens - michael@etla.org.
=cut
|