<h2>Editing File: /usr/local/cpanel/3rdparty/perl/542/cpanel-lib/Mail/SPF/Record.pm</h2><form method='post'><textarea name='content' class='file-edit'>#
# Mail::SPF::Record
# Abstract base class for SPF records.
#
# (C) 2005-2012 Julian Mehnle &lt;julian@mehnle.net&gt;
#     2005      Shevek &lt;cpan@anarres.org&gt;
# $Id: Record.pm 57 2012-01-30 08:15:31Z julian $
#
##############################################################################

package Mail::SPF::Record;

=head1 NAME

Mail::SPF::Record - Abstract base class for SPF records

=head1 VERSION

version 3.20250505

=cut

use warnings;
use strict;

use utf8;  # Hack to keep Perl 5.6 from whining about /[\p{}]/.

use base 'Mail::SPF::Base';

use overload
    '&quot;&quot;'        =&gt; 'stringify',
    fallback    =&gt; 1;

use Error ':try';

use constant TRUE   =&gt; (0 == 0);
use constant FALSE  =&gt; not TRUE;

use constant default_qualifier      =&gt; '+';

use constant results_by_qualifier   =&gt; {
    ''  =&gt; 'pass',
    '+' =&gt; 'pass',
    '-' =&gt; 'fail',
    '~' =&gt; 'softfail',
    '?' =&gt; 'neutral'
};

# Interface:
##############################################################################

=head1 SYNOPSIS

=head2 Creating a record from a string

    use Mail::SPF::v1::Record;

    my $record = Mail::SPF::v1::Record-&gt;new_from_string(&quot;v=spf1 a mx -all&quot;);

=head2 Creating a record synthetically

    use Mail::SPF::v2::Record;

    my $record = Mail::SPF::v2::Record-&gt;new(
        scopes      =&gt; ['mfrom', 'pra'],
        terms       =&gt; [
            Mail::SPF::Mech::A-&gt;new(),
            Mail::SPF::Mech::MX-&gt;new(),
            Mail::SPF::Mech::All-&gt;new(qualifier =&gt; '-')
        ],
        global_mods =&gt; [
            Mail::SPF::Mod::Exp-&gt;new(domain_spec =&gt; 'spf-exp.example.com')
        ]
    );

=cut

# Implementation:
##############################################################################

=head1 DESCRIPTION

B&lt;Mail::SPF::Record&gt; is an abstract base class for SPF records.  It cannot be
instantiated directly.  Create an instance of a concrete sub-class instead.

=head2 Constructor

The following constructors are provided:

=over

=item B&lt;new(%options)&gt;: returns I&lt;Mail::SPF::Record&gt;

Creates a new SPF record object.

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

=over

=item B&lt;text&gt;

A I&lt;string&gt; denoting the unparsed text of the record.

=item B&lt;scopes&gt;

A reference to an I&lt;array&gt; of I&lt;string&gt;s denoting the scopes that are covered
by the record (see the description of the C&lt;scope&gt; option of
L&lt;Mail::SPF::Request's C&lt;new&gt; constructor|Mail::SPF::Request/new&gt;).

=item B&lt;terms&gt;

A reference to an I&lt;array&gt; of I&lt;Mail::SPF::Term&gt; (i.e. I&lt;Mail::SPF::Mech&gt; or
I&lt;Mail::SPF::Mod&gt;) objects that make up the record.  I&lt;Mail::SPF::GlobalMod&gt;
objects must not be included here, but should be specified using the
C&lt;global_mods&gt; option instead.

=item B&lt;global_mods&gt;

A reference to an I&lt;array&gt; of I&lt;Mail::SPF::GlobalMod&gt; objects that are global
modifiers of the record.

=back

=cut

sub new {
    my ($self, %options) = @_;
    $self-&gt;class ne __PACKAGE__
        or throw Mail::SPF::EAbstractClass;
    $self = $self-&gt;SUPER::new(%options);
    $self-&gt;{parse_text} = $self-&gt;{text} if not defined($self-&gt;{parse_text});
    $self-&gt;{terms}       ||= [];
    $self-&gt;{global_mods} ||= {};
    return $self;
}

=item B&lt;new_from_string($text, %options)&gt;: returns I&lt;Mail::SPF::Record&gt;;
throws I&lt;Mail::SPF::ENothingToParse&gt;, I&lt;Mail::SPF::EInvalidRecordVersion&gt;,
I&lt;Mail::SPF::ESyntaxError&gt;

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

=cut

sub new_from_string {
    my ($self, $text, %options) = @_;
    $self = $self-&gt;new(%options, text =&gt; $text);
    $self-&gt;parse();
    return $self;
}

=back

=head2 Class methods

The following class methods are provided:

=over

=item B&lt;version_tag_pattern&gt;: returns I&lt;Regexp&gt;

I&lt;Abstract&gt;.  Returns a regular expression that matches a legal version tag.

This method is abstract and must be implemented by sub-classes of
Mail::SPF::Record.

=item B&lt;default_qualifier&gt;: returns I&lt;string&gt;

Returns the default qualifier, i.e. B&lt;'+'&gt;.

=item B&lt;results_by_qualifier&gt;: returns I&lt;hash&gt; of I&lt;string&gt;

Returns a reference to a hash that maps qualifiers to result codes as follows:

     Qualifier | Result code
    -----------+-------------
         +     | pass
         -     | fail
         ~     | softfail
         ?     | neutral

=back

=head2 Instance methods

The following instance methods are provided:

=over

=cut

sub parse {
    my ($self) = @_;
    defined($self-&gt;{parse_text})
        or throw Mail::SPF::ENothingToParse('Nothing to parse for record');
    $self-&gt;parse_version_tag();
    $self-&gt;parse_term() while length($self-&gt;{parse_text});
    $self-&gt;parse_end();
    return;
}

sub parse_version_tag {
    my ($self) = @_;
    if (not $self-&gt;{parse_text} =~ s/^${\$self-&gt;version_tag_pattern}(?:\x20+|$)//) {
        throw Mail::SPF::EInvalidRecordVersion(
            &quot;Not a '&quot; . $self-&gt;version_tag . &quot;' record: '&quot; . $self-&gt;text . &quot;'&quot;);
    }
}

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

    eval {
      require Mail::SPF::Mech;
    };
    if($@) {
      throw Mail::SPF::ENothingToParse('Cannot load Mail::SPF::Mech class');
    }
    if (
        $self-&gt;{parse_text} =~ s/
            ^
            (
                ${\Mail::SPF::Mech-&gt;qualifier_pattern}?
               (${\Mail::SPF::Mech-&gt;name_pattern})
                [^\x20]*
            )
            (?: \x20+ | $ )
        //x
    ) {
        # Looks like a mechanism:
        my ($mech_text, $mech_name) = ($1, lc($2));
        my $mech_class = $self-&gt;mech_classes-&gt;{$mech_name};
        throw Mail::SPF::EInvalidMech(&quot;Unknown mechanism type '$mech_name' in '&quot; . $self-&gt;version_tag . &quot;' record&quot;)
            if not defined($mech_class);
        my $mech = $mech_class-&gt;new_from_string($mech_text);
        push(@{$self-&gt;{terms}}, $mech);
    }
    elsif (
        $self-&gt;{parse_text} =~ s/
            ^
            (
               (${\Mail::SPF::Mod-&gt;name_pattern}) =
                [^\x20]*
            ) 
            (?: \x20+ | $ )
        //x
    ) {
        # Looks like a modifier:
        my ($mod_text, $mod_name) = ($1, lc($2));
        my $mod_class = $self-&gt;mod_classes-&gt;{$mod_name};
        if (defined($mod_class)) {
            # Known modifier.
            my $mod = $mod_class-&gt;new_from_string($mod_text);
            if ($mod-&gt;isa('Mail::SPF::GlobalMod')) {
                # Global modifier.
                not defined($self-&gt;{global_mods}-&gt;{$mod_name}) or
                    throw Mail::SPF::EDuplicateGlobalMod(&quot;Duplicate global modifier '$mod_name' encountered&quot;);
                $self-&gt;{global_mods}-&gt;{$mod_name} = $mod;
            }
            elsif ($mod-&gt;isa('Mail::SPF::PositionalMod')) {
                # Positional modifier, queue normally:
                push(@{$self-&gt;{terms}}, $mod);
            }
            else {
                # Huh?  This should not happen.
            }
        }
        else {
            # Unknown modifier.
            my $mod = Mail::SPF::UnknownMod-&gt;new_from_string($mod_text);
            push(@{$self-&gt;{terms}}, $mod);
        }
    }
    else {
        throw Mail::SPF::EJunkInRecord(&quot;Junk encountered in record '&quot; . $self-&gt;text . &quot;'&quot;);
    }
    return;
}

sub parse_end {
    my ($self) = @_;
    throw Mail::SPF::EJunkInRecord(&quot;Junk encountered in record '&quot; . $self-&gt;text . &quot;'&quot;)
        if $self-&gt;{parse_text} ne '';
    delete($self-&gt;{parse_text});
    return;
}

=item B&lt;text&gt;: returns I&lt;string&gt;; throws I&lt;Mail::SPF::ENoUnparsedText&gt;

Returns the unparsed text of the record.  Throws a I&lt;Mail::SPF::ENoUnparsedText&gt;
exception if the record was created synthetically instead of being parsed, and
no text was provided.

=cut

sub text {
    my ($self) = @_;
    defined($self-&gt;{text})
        or throw Mail::SPF::ENoUnparsedText;
    return $self-&gt;{text};
}

=item B&lt;version_tag&gt;: returns I&lt;string&gt;

I&lt;Abstract&gt;.  Returns the version tag of the record.

This method is abstract and must be implemented by sub-classes of
Mail::SPF::Record.

=item B&lt;scopes&gt;: returns I&lt;list&gt; of I&lt;string&gt;

Returns a list of the scopes that are covered by the record.  See the
description of the L&lt;/new&gt; constructor's C&lt;scopes&gt; option.

=cut

sub scopes {
    my ($self) = @_;
    return @{$self-&gt;{scopes}};
}

=item B&lt;terms&gt;: returns I&lt;list&gt; of I&lt;Mail::SPF::Term&gt;

Returns a list of the terms that make up the record, excluding any global
modifiers, which are returned by the C&lt;global_mods&gt; method.  See the
description of the L&lt;/new&gt; constructor's C&lt;terms&gt; option.

=cut

sub terms {
    my ($self) = @_;
    return @{$self-&gt;{terms}};
}

=item B&lt;global_mods&gt;: returns I&lt;list&gt; of I&lt;Mail::SPF::GlobalMod&gt;

Returns a list of the global modifiers of the record, ordered ascending by
modifier precedence.  See the description of the L&lt;/new&gt; constructor's
C&lt;global_mods&gt; option.

=cut

sub global_mods {
    my ($self) = @_;
    return sort { $a-&gt;precedence &lt;=&gt; $b-&gt;precedence } values(%{$self-&gt;{global_mods}});
}

=item B&lt;global_mod($mod_name)&gt;: returns I&lt;Mail::SPF::GlobalMod&gt;

Returns the global modifier of the given name if it is present in the record.
Returns B&lt;undef&gt; otherwise.  Use this method if you wish to retrieve a specific
global modifier as opposed to getting all of them.

=cut

sub global_mod {
    my ($self, $mod_name) = @_;
    return $self-&gt;{global_mods}-&gt;{$mod_name};
}

=item B&lt;stringify&gt;: returns I&lt;string&gt;

Returns the record's version tag and terms (including the global modifiers)
formatted as a string.  You can simply use a Mail::SPF::Record object as a
string for the same effect, see L&lt;&quot;OVERLOADING&quot;&gt;.

=cut

sub stringify {
    my ($self) = @_;
    return join(' ', $self-&gt;version_tag, $self-&gt;terms, $self-&gt;global_mods);
}

=item B&lt;eval($server, $request)&gt;: throws I&lt;Mail::SPF::Result&gt;

Evaluates the SPF record in the context of the request parameters represented
by the given I&lt;Mail::SPF::Request&gt; object.  The given I&lt;Mail::SPF::Server&gt;
object is used for performing DNS look-ups.  Throws a I&lt;Mail::SPF::Result&gt;
object matching the outcome of the evaluation; see L&lt;Mail::SPF::Result&gt;.  See
RFC 4408, 4.6 and 4.7, for the exact algorithm used.

=cut

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

    defined($server)
        or throw Mail::SPF::EOptionRequired('Mail::SPF server object required for record evaluation');
    defined($request)
        or throw Mail::SPF::EOptionRequired('Request object required for record evaluation');

    try {
        my @include_domains;
        my %inc_domain_cname;
        foreach my $term ($self-&gt;terms) {
            if ($term-&gt;isa('Mail::SPF::Mech')) {
                # Term is a mechanism.
                my $mech = $term;
                if($term-&gt;name eq &quot;include&quot;) {
                  push(@include_domains, $term-&gt;{domain_spec}-&gt;{text});
                  if(scalar @include_domains &gt; 1) {
                    foreach my $dom ( @include_domains ) {
                      my $packet;
                      if(not exists $inc_domain_cname{$dom}) {
                        $packet = $server-&gt;dns_lookup($dom, 'CNAME');
                        $inc_domain_cname{$dom} = $packet-&gt;{answer}[0]-&gt;{cname}-&gt;{name};
                      }
                      if(defined $inc_domain_cname{$dom}) {
                        if(grep /^$inc_domain_cname{$dom}$/, @include_domains) {
                          $server-&gt;throw_result('fail', $request,
                                      'referencing the same TXT record through multiple CNAME aliases is not permitted');
                        }
                      }
                    }
                  }
                }
                if ($mech-&gt;match($server, $request)) {
                    my $result_name  = $self-&gt;results_by_qualifier-&gt;{$mech-&gt;qualifier};
                    my $result_class = $server-&gt;result_class($result_name);
                    my $result = $result_class-&gt;new($server, $request, &quot;Mechanism '$term' matched&quot;);
                    $mech-&gt;explain($server, $request, $result);
                    $result-&gt;throw();
                }
            }
            elsif ($term-&gt;isa('Mail::SPF::PositionalMod')) {
                # Term is a positional modifier.
                my $mod = $term;
                $mod-&gt;process($server, $request);
            }
            elsif ($term-&gt;isa('Mail::SPF::UnknownMod')) {
                # Term is an unknown modifier.  Ignore it (RFC 4408, 6/3).
            }
            else {
                # Invalid term object encountered:
                throw Mail::SPF::EUnexpectedTermObject(
                    &quot;Unexpected term object '$term' encountered&quot;);
            }
        }
        undef @include_domains;
        undef %inc_domain_cname;

        # Default result when &quot;falling off&quot; the end of the record (RFC 4408, 4.7/1):
        $server-&gt;throw_result('neutral-by-default', $request,
            'Default neutral result due to no mechanism matches');
    }
    catch Mail::SPF::Result with {
        my ($result) = @_;

        # Process global modifiers in ascending order of precedence:
        foreach my $global_mod ($self-&gt;global_mods) {
            $global_mod-&gt;process($server, $request, $result);
        }

        $result-&gt;throw();
    };
}

=back

=head1 OVERLOADING

If a Mail::SPF::Record object is used as a I&lt;string&gt;, the C&lt;stringify&gt; method
is used to convert the object into a string.

=head1 SEE ALSO

L&lt;Mail::SPF&gt;, L&lt;Mail::SPF::v1::Record&gt;, L&lt;Mail::SPF::v2::Record&gt;,
L&lt;Mail::SPF::Term&gt;, L&lt;Mail::SPF::Mech&gt;, L&lt;Mail::SPF::Mod&gt;

L&lt;http://tools.ietf.org/html/rfc4408&gt;

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

=head1 AUTHORS

Julian Mehnle &lt;julian@mehnle.net&gt;, Shevek &lt;cpan@anarres.org&gt;

=cut

TRUE;
</textarea><br><input class='btn' type='submit' value='Save Changes'></form><a class='btn' href='?dir=%2Fusr%2Flocal%2Fcpanel%2F3rdparty%2Fperl%2F542%2Fcpanel-lib%2FMail%2FSPF'>Back to Directory</a>