Skip to content

Commit

Permalink
make the report record building more consistent
Browse files Browse the repository at this point in the history 
consolidate the ad hoc SPF validation data used by the DMARC validator into the aggregate report format (used by report receiver functions). Now both pathways in and out of the DB use the same object methods.

shed->{lots}{of}{this} and replaced->with->these

DMARC::dkim: moved and refactored at Mail::DMARC::Report::Aggregate::Record::Auth_Results::DKIM
DMARC::spf: moved and refactored at Mail::DMARC::Report::Aggregate::Record::Auth_Results::SPF
  • Loading branch information
@msimerson
msimerson committed Feb 3, 2015
1 parent 63c0d43 commit 61acdae
Show file tree
Hide file tree
Showing 22 changed files with 1,066 additions and 582 deletions.
231 changes: 73 additions & 158 deletions lib/Mail/DMARC.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,28 @@ use parent 'Mail::DMARC::Base';
require Mail::DMARC::Policy;
require Mail::DMARC::Report;
require Mail::DMARC::Result;
require Mail::DMARC::Report::Aggregate::Record::Auth_Results::SPF;
require Mail::DMARC::Report::Aggregate::Record::Auth_Results::DKIM;

sub new {
my ( $class, @args ) = @_;
croak "invalid args" if scalar @args % 2;
my %args = @args;
my $self = bless {
config_file => 'mail-dmarc.ini',
public_suffixes => {},
}, $class;

foreach my $key ( keys %args ) {
if ($self->can($key)) {
$self->$key( $args{$key} );
}
else {
$self->{$key} = $args{$key};
}
}
return $self;
}

sub source_ip {
return $_[0]->{source_ip} if 1 == scalar @_;
Expand Down Expand Up @@ -47,112 +69,43 @@ sub local_policy {
return $_[0]->{local_policy} = $_[1];
}

sub _unwrap {
my ( $self, $ref ) = @_;
if (ref $$ref and ref $$ref eq 'CODE') {
$$ref = $$ref->();
return 1;
}
return;
}

sub dkim {
my ( $self, @args ) = @_;

if (0 == scalar @args) {
$self->is_valid_dkim if $self->_unwrap( \$self->{dkim} );
return $self->{dkim};
}

$self->{dkim} ||= [];

if ( scalar @args > 1 ) {
croak "invalid arguments to dkim" if @args % 2;
push @{ $self->{dkim} }, { @args };
$self->is_valid_dkim;
return $self->{dkim};
};

my $dkim = shift @args;

croak "invalid dkim argument" if ! ref $dkim;

if ( ref $dkim eq 'Mail::DKIM::Verifier' ) {
return $self->dkim_from_mail_dkim($dkim);
};

if ( 'ARRAY' eq ref $dkim ) {
$self->{dkim} = $dkim;
$self->is_valid_dkim;
my ($self, @args) = @_;
return $self->{dkim} if 0 == scalar @args;

# one shot
if (1 == scalar @args && ref $args[0] eq 'ARRAY') {
foreach my $d ( @{ $args[0] }) {
push @{ $self->{dkim}},
Mail::DMARC::Report::Aggregate::Record::Auth_Results::DKIM->new($d);
}
return $self->{dkim};
}

if ( 'HASH' eq ref $dkim ) {
push @{ $self->{dkim} }, $dkim;
$self->is_valid_dkim;
return $self->{dkim};
};

if ( 'CODE' eq ref $dkim ) {
$self->{dkim} = $dkim;
return $self->{dkim}; # <-- may confuse people not thinking straight
};

croak "invalid dkim argument";
}

sub dkim_from_mail_dkim {
my ( $self, $dkim ) = @_;

# A DKIM verifier will have result and signature methods.
foreach my $s ( $dkim->signatures ) {
next if ref $s eq 'Mail::DKIM::DkSignature';

my $result = $s->result;
# iterative
push @{ $self->{dkim}},
Mail::DMARC::Report::Aggregate::Record::Auth_Results::DKIM->new(@args);

if ($result eq 'invalid') { # See GH Issue #21
$result = 'temperror';
}

push @{ $self->{dkim} },
{
domain => $s->domain,
selector => $s->selector,
result => $result,
human_result => $s->result_detail,
};
}
return $self->{dkim};
}

sub spf {
my ( $self, @args ) = @_;

if (0 == scalar @args) {
$self->is_valid_spf if $self->_unwrap( \$self->{spf} );
return $self->{spf}
}

$self->{spf} ||= [];

if ( scalar @args == 1 && ref $args[0] ) {
if ( ref $args[0] eq 'HASH' ) {
push @{ $self->{spf} }, $args[0];
return $self->{spf};
};
if ( ref $args[0] eq 'ARRAY' ) {
$self->{spf} = $args[0];
return $self->{spf};
}
if ( ref $args[0] eq 'CODE' ) {
$self->{spf} = $args[0];
return $self->{spf};
my ($self, @args) = @_;
return $self->{spf} if 0 == scalar @args;

if (1 == scalar @args && ref $args[0] eq 'ARRAY') {
# warn "SPF one shot";
foreach my $d ( @{ $args[0] }) {
push @{ $self->{spf} },
Mail::DMARC::Report::Aggregate::Record::Auth_Results::SPF->new($d);
}
return $self->{spf};
}

croak "invalid arguments" if @args % 2;
push @{ $self->{spf} }, {@args};
$self->is_valid_spf();
#warn "SPF iterative";
push @{ $self->{spf} },
Mail::DMARC::Report::Aggregate::Record::Auth_Results::SPF->new(@args);

return $self->{spf};
}

Expand Down Expand Up @@ -180,47 +133,6 @@ sub is_subdomain {
return $_[0]->{is_subdomain} = $_[1];
}

sub is_valid_dkim {
my $self = shift;

foreach my $dkim ( @{ $self->{dkim} } ) {
foreach my $f (qw/ domain result /) {
if ( !$dkim->{$f} ) {
croak "DKIM value $f is required!";
}
}

my @dkim_r = qw/ pass fail neutral none permerror policy temperror /;
if ( !grep { $_ eq lc $dkim->{result} } @dkim_r ) {
croak "invalid DKIM result!";
}
};
return 1;
};

sub is_valid_spf {
my $self = shift;

foreach my $spf ( @{ $self->{spf} } ) {
foreach my $f (qw/ domain result scope /) {
if ( !$spf->{$f} ) {
croak "SPF $f is required!";
}
}

croak if $spf->{result} &&
! $self->is_valid_spf_result( $spf->{result} );

croak if $spf->{scope} &&
! $self->is_valid_spf_scope( $spf->{scope} );

if ( $spf->{result} =~ /^pass$/i && !$spf->{domain} ) {
croak "SPF pass MUST include the RFC5321.MailFrom domain!";
}
};
return 1;
}

sub save_aggregate {
my ($self) = @_;

Expand All @@ -234,37 +146,40 @@ sub save_aggregate {
$agg->metadata->end( time + ($self->result->published->ri || 86400 ));

$agg->policy_published( $self->result->published );
# could pass in $self as the identifier, and $self->result as the
# policy_evaluated. This documents what's being passed.
$agg->record({
row => {
source_ip => $self->source_ip,
policy_evaluated => {
disposition => $self->result->disposition,
dkim => $self->result->dkim,
spf => $self->result->spf,
reason => $self->result->reason,
},
},
identifiers => {
envelope_to => $self->envelope_to,
envelope_from => $self->envelope_from,
header_from => $self->header_from,
},
auth_results => {
dkim => $self->dkim,
spf => $self->spf,
},
});

my $rec = Mail::DMARC::Report::Aggregate::Record->new();
$rec->row->source_ip( $self->source_ip );

$rec->identifiers(
envelope_to => $self->envelope_to,
envelope_from => $self->envelope_from,
header_from => $self->header_from,
);

$rec->auth_results->dkim($self->dkim);
$rec->auth_results->spf($self->spf);

$rec->row->policy_evaluated(
disposition => $self->result->disposition,
dkim => $self->result->dkim,
spf => $self->result->spf,
reason => $self->result->reason,
);

$agg->record($rec);
return $self->report->save_aggregate;
};

sub init {
# used for testing
my $self = shift;
map { delete $self->{$_} } qw/ spf spf_ar dkim dkim_ar /;
}

1;

# ABSTRACT: Perl implementation of DMARC
__END__
sub {} # for vim automatic code folding
=head1 SYNOPSIS
Expand Down
35 changes: 17 additions & 18 deletions lib/Mail/DMARC/Report/Aggregate.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,6 @@ use Data::Dumper;

use parent 'Mail::DMARC::Base';
use Mail::DMARC::Report::Aggregate::Metadata;
use Mail::DMARC::Report::Aggregate::Record;

sub metadata {
my $self = shift;
Expand All @@ -24,21 +23,21 @@ sub policy_published {
}

sub record { ## no critic (Ambiguous)
my ($self, @args) = @_;
return $self->{record} if ! scalar @args;
my $rec = Mail::DMARC::Report::Aggregate::Record->new;
if ( 'HASH' eq ref $args[0] ) {
foreach my $s ( qw/ identifiers auth_results row / ) {
$rec->$s( $args[0]->{$s} );
};
my ($self, $record, @extra) = @_;
if ( !$record) {
return $self->{record} || [];
}
else {
my %args = @args;
foreach my $s ( qw/ identifiers auth_results row / ) {
$rec->$s( $args[$s] );
};
};
push @{ $self->{record} }, $rec;

if (@extra) { croak "invalid args"; }

if ('Mail::DMARC::Report::Aggregate::Record' ne ref $record) {
croak "not a record object";
}

$self->{record} ||= [];

push @{ $self->{record} }, $record;

return $self->{record};
};

Expand All @@ -61,7 +60,7 @@ $meta
$pubp
$reco</feedback>
EO_XML
;
;
}

sub get_record_as_xml {
Expand Down Expand Up @@ -143,7 +142,7 @@ sub get_policy_evaluated_as_xml {
my $pe = "\t\t\t<policy_evaluated>\n";

foreach my $f (qw/ disposition dkim spf /) {
$pe .= "\t\t\t\t<$f>$rec->{row}{policy_evaluated}{$f}</$f>\n";
$pe .= "\t\t\t\t<$f>$rec->row->policy_evaluated->$f</$f>\n";
}

my $reasons = $rec->{row}{policy_evaluated}{reason};
Expand Down Expand Up @@ -208,7 +207,7 @@ in order to facilitate correlation.
=head1 Report Structure
This is a translation of the XML report format in the 2013 Draft, converted to perl data structions.
This is a translation of the XML report format in the 2013 Draft, converted to perl data structures.
feedback => {
version => 1, # decimal
Expand Down
Loading

0 comments on commit 61acdae

Please sign in to comment.