140 lines
2.7 KiB
Perl
140 lines
2.7 KiB
Perl
package Polyze::RReject;
|
|
use Moose::Role;
|
|
use File::Basename;
|
|
use Domain::PublicSuffix;
|
|
with 'Polyze::Reporter';
|
|
|
|
our $DPSuffix = Domain::PublicSuffix->new;
|
|
|
|
has from => (
|
|
is => 'ro',
|
|
isa => 'Str',
|
|
required => 0,
|
|
builder => '_build_from',
|
|
lazy => 1,
|
|
);
|
|
|
|
has to => (
|
|
is => 'ro',
|
|
isa => 'Str',
|
|
required => 0,
|
|
builder => '_build_to',
|
|
lazy => 1,
|
|
);
|
|
|
|
has sender_domain => (
|
|
is => 'ro',
|
|
isa => 'Maybe[Str]',
|
|
required => 0,
|
|
builder => '_build_sender_domain',
|
|
lazy => 1,
|
|
);
|
|
|
|
has sender_ip => (
|
|
is => 'ro',
|
|
isa => 'Str',
|
|
required => 0,
|
|
builder => '_build_sender_ip',
|
|
lazy => 1,
|
|
);
|
|
|
|
has root_domain_or_ip => (
|
|
is => 'ro',
|
|
isa => 'Str',
|
|
required => 0,
|
|
builder => '_build_root_domain_or_ip',
|
|
lazy => 1,
|
|
);
|
|
|
|
has reason => (
|
|
is => 'ro',
|
|
isa => 'Str',
|
|
required => 0,
|
|
builder => '_build_reason',
|
|
lazy => 1,
|
|
);
|
|
|
|
has is_later_accepted => (
|
|
is => 'rw',
|
|
isa => 'Bool',
|
|
required => 0,
|
|
default => 0,
|
|
);
|
|
|
|
sub _build_from {
|
|
my ($self) = @_;
|
|
# Try to extract the header-from, available if rejection is due to
|
|
# header_checks(5) on the From: header.
|
|
my ($f) = $self->text =~ m/: reject: header From: (.+?) from \b/;
|
|
if (!$f) {
|
|
# Get the other one, the mail-from.
|
|
($f) = ($self->text =~ m/ from=<([^>]+)>/);
|
|
}
|
|
return $f // "[no from]";
|
|
}
|
|
|
|
sub _build_to {
|
|
my ($self) = @_;
|
|
my ($t) = ($self->text =~ m/ to=<([^>]+)>/);
|
|
return $t // "[no to]";
|
|
}
|
|
|
|
sub _build_sender_domain {
|
|
die("missing override");
|
|
}
|
|
|
|
sub _build_sender_ip {
|
|
die("missing override");
|
|
}
|
|
|
|
sub _build_reason {
|
|
die("missing override");
|
|
}
|
|
|
|
sub _build_root_domain_or_ip {
|
|
my ($self) = @_;
|
|
return do {
|
|
if (defined $self->sender_domain) {
|
|
# 'local' is a special case, i.e. for mail sent via the
|
|
# 'sendmail' binary.
|
|
if ('local' eq $self->sender_domain) {
|
|
'local';
|
|
} else {
|
|
$DPSuffix->get_root_domain($self->sender_domain)
|
|
// $self->sender_ip;
|
|
}
|
|
} else {
|
|
$self->sender_ip;
|
|
}
|
|
};
|
|
}
|
|
|
|
sub to_str {
|
|
my ($self) = @_;
|
|
my $fn = basename($self->line->filename);
|
|
# For brevity, shorten the log file name.
|
|
$fn =~ s/^mail.log//;
|
|
$fn ||= "_";
|
|
return sprintf(
|
|
"%s%s %s/%d %s: %s",
|
|
($self->is_later_accepted ? '*' : ''),
|
|
($self->count > 1 ? $self->count : ' '),
|
|
$fn, $self->linenumber,
|
|
$self->root_domain_or_ip, $self->from,
|
|
);
|
|
}
|
|
|
|
sub is_similar {
|
|
my ($lhs, $rhs) = @_;
|
|
return (
|
|
$rhs->does('Polyze::RReject')
|
|
&& $lhs->reason eq $rhs->reason
|
|
&& $lhs->from eq $rhs->from
|
|
&& $lhs->to eq $rhs->to
|
|
&& $lhs->root_domain_or_ip eq $rhs->root_domain_or_ip
|
|
);
|
|
}
|
|
|
|
no Moose;
|
|
1;
|