—
—
—
—
—
—
—
—

              
#
# Mail::SPF::Request
# SPF request class.
#
# (C) 2005-2006 Julian Mehnle <julian@mehnle.net>
#     2005      Shevek <cpan@anarres.org>
# $Id: Request.pm 14 2006-11-04 15:30:34Z Julian Mehnle $
#
##############################################################################
package Mail::SPF::Request;
HideShow 6 lines of Pod
=head1 NAME
Mail::SPF::Request - SPF request class
=cut
use warnings;
use strict;
use base 'Mail::SPF::Base';
use NetAddr::IP;
use Mail::SPF::Util;
use constant TRUE   => (0 == 0);
use constant FALSE  => not TRUE;
use constant versions_for_scope => {
    helo    => [1   ],
    mfrom   => [1, 2],
    pra     => [   2]
};
use constant scopes_by_version => {
    1       => ['helo', 'mfrom'       ],
    2       => [        'mfrom', 'pra']
};
use constant default_localpart => 'postmaster';
# Interface:
##############################################################################
HideShow 31 lines of Pod
=head1 SYNOPSIS
    use Mail::SPF;
     
    my $request = Mail::SPF::Request->new(
        versions    => [1, 2],              # optional
        scope       => 'mfrom',             # or 'helo', 'pra'
        identity    => 'fred@example.com',
        ip_address  => '192.168.0.1',
        helo_identity                       # optional,
                    => 'mta.example.com'    #   for %{h} macro expansion
    );
     
    my @versions    = $request->versions;
    my $scope       = $request->scope;
    my $authority_domain
                    = $request->authority_domain;
    my $identity    = $request->identity;   # 'localpart@domain' or 'domain'
    my $domain      = $request->domain;
    my $localpart   = $request->localpart;
    my $ip_address  = $request->ip_address;     # IPv4 or IPv6 address
    my $ip_address_v6                           # native IPv6 address or
                    = $request->ip_address_v6;  #   IPv4-mapped IPv6 address
    my $helo_identity                           # additional HELO identity
                    = $request->helo_identity;  #   for non-HELO scopes
     
    $request->state(field => 'value');
    my $value = $request->state('field');
=cut
# Implementation:
##############################################################################
HideShow 115 lines of Pod
=head1 DESCRIPTION
An object of class B<Mail::SPF::Request> represents an SPF request.
=head2 Constructor
The following constructor is provided:
=over
=item B<new(%options)>: returns I<Mail::SPF::Request>
Creates a new SPF request object.
%options is a list of key/value pairs representing any of the following
options:
=over
=item B<versions>
A reference to an I<array> of I<integer>s listing the versions of SPF records
that may be used for the SPF check.  Only those record versions that cover the
desired scope will actually be used.  At least one applicable version must be
specified.  For a single record version, a simple scalar may be specified
instead of an array-ref.  Defaults to all versions that cover the desired scope
(see below); defaults to B<[1, 2]> for the default scope of B<'mfrom'>.
The following versions are supported:
=over
=item B<1>
Use C<v=spf1> records.
=item B<2>
Use C<spf2.0> records.
=back
I<Example>:  A value of B<1> (or B<[1]>) means that only C<v=spf1> records
should be used for the SPF check.  If at the same time a scope of B<'pra'> is
specified, a I<Mail::SPF::EInvalidScope> exception will be thrown as C<v=spf1>
records do not cover the PRA scope.
=item B<scope>
A string denoting the authorization scope against which the identity should be
checked.  Defaults to B<'mfrom'>.  The following scope values are supported:
=over
=item B<'helo'>
The given identity is the C<HELO> parameter of an SMTP transaction (RFC 2821)
and should be checked against SPF records that cover the C<helo> scope
(C<v=spf1>).  See the SPFv1 specification (RFC 4408) for the formal definition
of the C<HELO> scope.
=item B<'mfrom'>
The given identity is the C<MAIL FROM> parameter of an SMTP transaction (RFC
2821), or, in the case of an empty C<MAIL FROM> parameter (C<< MAIL FROM:<>
>>), derived from the transaction's C<HELO> parameter, and should be checked
against SPF records that cover the C<mfrom> scope (C<v=spf1> and
C<spf2.0/mfrom>).  See the SPFv1 specification (RFC 4408) for the formal
definition of the C<MAIL FROM> scope.
=item B<'pra'>
The given identity is the "Purported Responsible Address" of an internet
message (RFC 2822) and should be checked against SPF records that cover the
C<pra> scope (C<spf2.0/pra>).  See the PRA specification (RFC 4407) for the
formal definition of the PRA scope.
=back
=item B<authority_domain>
A string denoting the domain name that should be queried for sender policy
records.  Defaults to the domain of the C<identity> option.  There is usually
no need to specify the C<authority_domain> option.
=item B<identity>
I<Required>.  A string denoting the sender identity whose authorization should
be checked.  This is a domain name for the C<helo> scope, and an e-mail address
for the C<mfrom> and C<pra> scopes.
I<Note>:  For checks against the C<mfrom> scope, in the case of an empty C<MAIL
FROM> SMTP transaction parameter, the caller must provide to Mail::SPF::Request
the C<HELO> transaction parameter instead.
=item B<ip_address>
I<Required> for checks against the C<helo>, C<mfrom>, and C<pra> scopes.
Either a string or a I<NetAddr::IP> object denoting the IP address of the host
claiming the identity that is being checked.  Can be either an IPv4 or an IPv6
address.  An IPv4-mapped IPv6 address (e.g. '::ffff:192.168.0.1') is treated
as an IPv4 address.
=item B<helo_identity>
A string denoting the C<HELO> SMTP transaction parameter in the case that the
main identity is of a scope other than C<helo>.  This identity is then used
merely for the expansion of C<%{h}> macros during the policy evaluation of the
main identity.  Defaults to B<undef>, which will be expanded to B<'unknown'>.
If the main identity is of the C<helo> scope, this option is unused.
=back
=cut
sub new {
    my ($self, %options) = @_;
     
    # Create new object:
    $self = $self->SUPER::new(%options);
    # If the request object already has a state hash, clone its contents:
    $self->{state} = { %{$self->{state}} }
        if ref($self->{state}) eq 'HASH';
     
    # Scope:
    $self->{scope} ||= 'mfrom';
    my $versions_for_scope = $self->versions_for_scope->{$self->{scope}}
        or throw Mail::SPF::EInvalidScope("Invalid scope '$self->{scope}'");
     
    # Versions:
    if (not defined($self->{versions})) {
        # No versions specified, use all versions relevant to scope:
        $self->{versions} = $versions_for_scope;
    }
    else {
        if (not ref($self->{versions})) {
            # Single version specified as scalar:
            $self->{versions} = [$self->{versions}];
        }
        elsif (ref($self->{versions}) ne 'ARRAY') {
            # Something other than scalar or array-ref specified:
            throw Mail::SPF::EInvalidOptionValue(
                "'versions' option must be string or array-ref");
        }
         
        # All requested record versions must be supported:
        my @unsupported_versions = grep(
            (not defined($self->scopes_by_version->{$_})),
            @{$self->{versions}}
        );
        not @unsupported_versions
            or throw Mail::SPF::EInvalidOptionValue(
                'Unsupported record version(s) ' .
                join(', ', map("'$_'", @unsupported_versions)));
         
        # Use only those record versions that are relevant to the requested scope:
        my %versions_for_scope;
           @versions_for_scope{@$versions_for_scope} = ();
        my @versions = grep(exists($versions_for_scope{$_}), @{$self->{versions}});
         
        # Require at least one relevant record version that covers the scope:
        @versions
            or throw Mail::SPF::EInvalidScope(
                "Invalid scope '$self->{scope}' for record version(s) " .
                join(', ', @{$self->{versions}}));
         
        $self->{versions} = \@versions;
    }
     
    # Identity:
    defined($self->{identity})
        or throw Mail::SPF::EOptionRequired("Missing required 'identity' option");
     
    # Extract domain and localpart from identity:
    if (
        ($self->{scope} eq 'mfrom' or $self->{scope} eq 'pra') and
        $self->{identity} =~ /^(.*)@(.*?)$/
    ) {
        $self->{domain}    = $2;
        $self->{localpart} = $1;
    }
    else {
        $self->{domain}    = $self->{identity};
    }
    $self->{domain} =~ s/^(.*?)\.?$/\L$1/;
        # Lower-case domain and remove eventual trailing dot.
    $self->{localpart} = $self->default_localpart
        if not defined($self->{localpart});
     
    # HELO identity:
    if ($self->{scope} eq 'helo') {
        $self->{helo_identity} ||= $self->{identity};
    }
     
    # IP address:
    throw Mail::SPF::EOptionRequired("Missing required 'ip_address' option")
        if  grep($self->{scope} eq $_, qw(helo mfrom pra))
        and not defined($self->{ip_address});
     
    # Ensure ip_address is a NetAddr::IP object:
    $self->{ip_address} = NetAddr::IP->new($self->{ip_address})
        if not UNIVERSAL::isa($self->{ip_address}, 'NetAddr::IP');
     
    # Convert IPv4 address to IPv4-mapped IPv6 address:
    if (Mail::SPF::Util->ipv6_address_is_ipv4_mapped($self->{ip_address})) {
        $self->{ip_address_v6} = $self->{ip_address};  # Accept as IPv6 address as-is.
        $self->{ip_address} = Mail::SPF::Util->ipv6_address_to_ipv4($self->{ip_address});
    }
    elsif ($self->{ip_address}->version == 4) {
        $self->{ip_address_v6} = Mail::SPF::Util->ipv4_address_to_ipv6($self->{ip_address});
    }
    elsif ($self->{ip_address}->version == 6) {
        $self->{ip_address_v6} = $self->{ip_address};
    }
    else {
        throw Mail::SPF::EInvalidOptionValue(
            "Unexpected IP address version '" . $self->{ip_address}->version . "'");
    }
     
    return $self;
}
HideShow 15 lines of Pod
=back
=head2 Instance methods
The following instance methods are provided:
=over
=item B<versions>: returns I<list> of I<string>
Returns a list of the SPF record versions that are used for request.  See the
description of the L</new> constructor's C<versions> option.
=cut
sub versions {
    my ($self) = @_;
    # Read-only!
    return @{$self->{versions}};
}
HideShow 12 lines of Pod
=item B<scope>: returns I<string>
Returns the scope of the request.  See the description of the L</new>
constructor's C<scope> option.
=item B<authority_domain>: returns I<string>
Returns the authority domain of the request.  See the description of the
L</new> constructor's C<authority_domain> option.
=cut
sub authority_domain {
    my ($self) = @_;
    return $self->{authority_domain} || $self->{domain};
}
HideShow 33 lines of Pod
=item B<identity>: returns I<string>
Returns the identity of the request.  See the description of the L</new>
constructor's C<identity> option.
=item B<domain>: returns I<string>
Returns the identity domain of the request.  See the description of the
L</new> constructor's C<identity> option.
=item B<localpart>: returns I<string>
Returns the identity localpart of the request.  See the description of the
L</new> constructor's C<identity> option.
=item B<ip_address>: returns I<NetAddr::IP>
Returns the IP address of the request as a I<NetAddr::IP> object.  See the
description of the L</new> constructor's C<ip_address> option.
=item B<ip_address_v6>: returns I<NetAddr::IP>
Like the C<ip_address> method, however, an IPv4 address is returned as an
IPv4-mapped IPv6 address (e.g. '::ffff:192.168.0.1') to facilitate uniform
processing.
=item B<helo_identity>: returns I<string>
Returns the C<HELO> SMTP transaction parameter of the request.  See the
description of the L</new> constructor's C<helo_identity> option.
=cut
# Make read-only accessors:
__PACKAGE__->make_accessor($_, TRUE)
    foreach qw(
        scope identity domain localpart
        ip_address ip_address_v6 helo_identity
    );
HideShow 13 lines of Pod
=item B<state($field)>: returns anything
=item B<state($field, $value)>: returns anything
Provides an interface for storing temporary state information with the request
object.  This is primarily meant to be used internally by I<Mail::SPF::Server>
and other Mail::SPF classes.
If C<$value> is specified, stores it in a state field named C<$field>.  Returns
the current (new) value of the state field named C<$field>.
=cut
sub state {
    my ($self, $field, @value) = @_;
    defined($field)
        or throw Mail::SPF::EOptionRequired('Field name required');
    $self->{state}->{$field} = $value[0]
        if @value;
    return $self->{state}->{$field};
}
HideShow 17 lines of Pod
=back
=head1 SEE ALSO
L<Mail::SPF>, L<Mail::SPF::Server>
L<http://www.ietf.org/rfc/rfc4408.txt|"RFC 4408">
For availability, support, and license information, see the README file
included with Mail::SPF.
=head1 AUTHORS
Julian Mehnle <julian@mehnle.net>, Shevek <cpan@anarres.org>
=cut
TRUE;