File Coverage

blib/lib/Mail/SPF/Mech/Include.pm

Criterion	Covered	Total	%
statement	22	36	61.1
branch	0	8	0.0
condition	0	6	0.0
subroutine	7	10	70.0
pod	2	3	66.6
total	31	63	49.2

#
# Mail::SPF::Mech::Include
# SPF record "include" mechanism class.
#
# (C) 2005-2012 Julian Mehnle
#     2005      Shevek
# $Id: Include.pm 57 2012-01-30 08:15:31Z julian $
#
##############################################################################

package Mail::SPF::Mech::Include;

=head1 NAME

Mail::SPF::Mech::Include - SPF record C mechanism class

=cut

use warnings;
use strict;

use base 'Mail::SPF::Mech';

use constant TRUE   => (0 == 0);
use constant FALSE  => not TRUE;

use constant name           => 'include';
use constant name_pattern   => qr/${\name}/i;

=head1 DESCRIPTION

An object of class B represents an SPF record
mechanism of type C.

=head2 Constructors

The following constructors are provided:

=over

=item B: returns I

Creates a new SPF record C mechanism object.

%options is a list of key/value pairs representing any of the following
options:

=over

=item B

=item B

See L.

=back

=item B: returns I;
throws I, I

Creates a new SPF record C mechanism object by parsing the string and
any options given.

=back

=head2 Class methods

The following class methods are provided:

=over

=item B

=item B

See L.

=item B: returns I

Returns B<'include'>.

=item B: returns I

Returns a regular expression that matches a mechanism name of B<'include'>.

=back

=head2 Instance methods

The following instance methods are provided:

=over

=cut

sub parse_params {
    my ($self) = @_;
    $self->parse_domain_spec(TRUE);
    return;
}

=item B

=item B

=item B

=cut

sub params {
    my ($self) = @_;
    return defined($self->{domain_spec}) ? ':' . $self->{domain_spec} : undef;
}

=item B

See L.

=item B: returns I

Returns the C parameter of the mechanism.

=cut

# Make read-only accessor:
__PACKAGE__->make_accessor('domain_spec', TRUE);

=item B: returns I

Performs a recursive SPF check using the given SPF server and request objects
and substituting the mechanism's target domain name for the request's authority
domain.  The result of the recursive SPF check is translated as follows:

     Recursive result | Effect
    ------------------+-----------------
     pass             | return true
     fail             | return false
     softfail         | return false
     neutral          | return false
     none             | throw PermError
     permerror        | throw PermError
     temperror        | throw TempError

See RFC 4408, 5.2, for the exact algorithm used.

=cut

sub match {
    my ($self, $server, $request) = @_;

    $server->count_dns_interactive_term($request);

    # Create sub-request with mutated authority domain:
    my $authority_domain = $self->domain($server, $request);
    my $sub_request = $request->new_sub_request(authority_domain => $authority_domain);

    # Process sub-request:
    my $result = $server->process($sub_request);

    # Translate result of sub-request (RFC 4408, 5/9):

    return TRUE
        if $result->isa('Mail::SPF::Result::Pass');

    return FALSE
        if $result->isa('Mail::SPF::Result::Fail')
        or $result->isa('Mail::SPF::Result::SoftFail')
        or $result->isa('Mail::SPF::Result::Neutral');

    $server->throw_result('permerror', $request,
        "Included domain '$authority_domain' has no applicable sender policy")
        if $result->isa('Mail::SPF::Result::None');

    # Propagate any other results (including {Perm,Temp}Error) as-is:
    $result->throw();
}

=back

=head1 SEE ALSO

L, L, L, L

L

For availability, support, and license information, see the README file
included with Mail::SPF.

=head1 AUTHORS

Julian Mehnle , Shevek

=cut

TRUE;