Server IP : 85.214.239.14 / Your IP : 3.144.98.61 Web Server : Apache/2.4.62 (Debian) System : Linux h2886529.stratoserver.net 4.9.0 #1 SMP Tue Jan 9 19:45:01 MSK 2024 x86_64 User : www-data ( 33) PHP Version : 7.4.18 Disable Function : pcntl_alarm,pcntl_fork,pcntl_waitpid,pcntl_wait,pcntl_wifexited,pcntl_wifstopped,pcntl_wifsignaled,pcntl_wifcontinued,pcntl_wexitstatus,pcntl_wtermsig,pcntl_wstopsig,pcntl_signal,pcntl_signal_get_handler,pcntl_signal_dispatch,pcntl_get_last_error,pcntl_strerror,pcntl_sigprocmask,pcntl_sigwaitinfo,pcntl_sigtimedwait,pcntl_exec,pcntl_getpriority,pcntl_setpriority,pcntl_async_signals,pcntl_unshare, MySQL : OFF | cURL : OFF | WGET : ON | Perl : ON | Python : ON | Sudo : ON | Pkexec : OFF Directory : /usr/share/perl5/Mail/SPF/ |
Upload File : |
# # Mail::SPF::Record # Abstract base class for SPF records. # # (C) 2005-2012 Julian Mehnle <julian@mehnle.net> # 2005 Shevek <cpan@anarres.org> # $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 =cut use warnings; use strict; use utf8; # Hack to keep Perl 5.6 from whining about /[\p{}]/. use base 'Mail::SPF::Base'; use overload '""' => 'stringify', fallback => 1; use Error ':try'; use constant TRUE => (0 == 0); use constant FALSE => not TRUE; use constant default_qualifier => '+'; use constant results_by_qualifier => { '' => 'pass', '+' => 'pass', '-' => 'fail', '~' => 'softfail', '?' => 'neutral' }; # Interface: ############################################################################## =head1 SYNOPSIS =head2 Creating a record from a string use Mail::SPF::v1::Record; my $record = Mail::SPF::v1::Record->new_from_string("v=spf1 a mx -all"); =head2 Creating a record synthetically use Mail::SPF::v2::Record; my $record = Mail::SPF::v2::Record->new( scopes => ['mfrom', 'pra'], terms => [ Mail::SPF::Mech::A->new(), Mail::SPF::Mech::MX->new(), Mail::SPF::Mech::All->new(qualifier => '-') ], global_mods => [ Mail::SPF::Mod::Exp->new(domain_spec => 'spf-exp.example.com') ] ); =cut # Implementation: ############################################################################## =head1 DESCRIPTION B<Mail::SPF::Record> 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<new(%options)>: returns I<Mail::SPF::Record> Creates a new SPF record object. %options is a list of key/value pairs representing any of the following options: =over =item B<text> A I<string> denoting the unparsed text of the record. =item B<scopes> A reference to an I<array> of I<string>s denoting the scopes that are covered by the record (see the description of the C<scope> option of L<Mail::SPF::Request's C<new> constructor|Mail::SPF::Request/new>). =item B<terms> A reference to an I<array> of I<Mail::SPF::Term> (i.e. I<Mail::SPF::Mech> or I<Mail::SPF::Mod>) objects that make up the record. I<Mail::SPF::GlobalMod> objects must not be included here, but should be specified using the C<global_mods> option instead. =item B<global_mods> A reference to an I<array> of I<Mail::SPF::GlobalMod> objects that are global modifiers of the record. =back =cut sub new { my ($self, %options) = @_; $self->class ne __PACKAGE__ or throw Mail::SPF::EAbstractClass; $self = $self->SUPER::new(%options); $self->{parse_text} = $self->{text} if not defined($self->{parse_text}); $self->{terms} ||= []; $self->{global_mods} ||= {}; return $self; } =item B<new_from_string($text, %options)>: returns I<Mail::SPF::Record>; throws I<Mail::SPF::ENothingToParse>, I<Mail::SPF::EInvalidRecordVersion>, I<Mail::SPF::ESyntaxError> 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->new(%options, text => $text); $self->parse(); return $self; } =back =head2 Class methods The following class methods are provided: =over =item B<version_tag_pattern>: returns I<Regexp> I<Abstract>. 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<default_qualifier>: returns I<string> Returns the default qualifier, i.e. B<'+'>. =item B<results_by_qualifier>: returns I<hash> of I<string> 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->{parse_text}) or throw Mail::SPF::ENothingToParse('Nothing to parse for record'); $self->parse_version_tag(); $self->parse_term() while length($self->{parse_text}); $self->parse_end(); return; } sub parse_version_tag { my ($self) = @_; if (not $self->{parse_text} =~ s/^${\$self->version_tag_pattern}(?:\x20+|$)//) { throw Mail::SPF::EInvalidRecordVersion( "Not a '" . $self->version_tag . "' record: '" . $self->text . "'"); } } sub parse_term { my ($self) = @_; if ( $self->{parse_text} =~ s/ ^ ( ${\Mail::SPF::Mech->qualifier_pattern}? (${\Mail::SPF::Mech->name_pattern}) [^\x20]* ) (?: \x20+ | $ ) //x ) { # Looks like a mechanism: my ($mech_text, $mech_name) = ($1, lc($2)); my $mech_class = $self->mech_classes->{$mech_name}; throw Mail::SPF::EInvalidMech("Unknown mechanism type '$mech_name' in '" . $self->version_tag . "' record") if not defined($mech_class); my $mech = $mech_class->new_from_string($mech_text); push(@{$self->{terms}}, $mech); } elsif ( $self->{parse_text} =~ s/ ^ ( (${\Mail::SPF::Mod->name_pattern}) = [^\x20]* ) (?: \x20+ | $ ) //x ) { # Looks like a modifier: my ($mod_text, $mod_name) = ($1, lc($2)); my $mod_class = $self->mod_classes->{$mod_name}; if (defined($mod_class)) { # Known modifier. my $mod = $mod_class->new_from_string($mod_text); if ($mod->isa('Mail::SPF::GlobalMod')) { # Global modifier. not defined($self->{global_mods}->{$mod_name}) or throw Mail::SPF::EDuplicateGlobalMod("Duplicate global modifier '$mod_name' encountered"); $self->{global_mods}->{$mod_name} = $mod; } elsif ($mod->isa('Mail::SPF::PositionalMod')) { # Positional modifier, queue normally: push(@{$self->{terms}}, $mod); } else { # Huh? This should not happen. } } else { # Unknown modifier. my $mod = Mail::SPF::UnknownMod->new_from_string($mod_text); push(@{$self->{terms}}, $mod); } } else { throw Mail::SPF::EJunkInRecord("Junk encountered in record '" . $self->text . "'"); } return; } sub parse_end { my ($self) = @_; throw Mail::SPF::EJunkInRecord("Junk encountered in record '" . $self->text . "'") if $self->{parse_text} ne ''; delete($self->{parse_text}); return; } =item B<text>: returns I<string>; throws I<Mail::SPF::ENoUnparsedText> Returns the unparsed text of the record. Throws a I<Mail::SPF::ENoUnparsedText> exception if the record was created synthetically instead of being parsed, and no text was provided. =cut sub text { my ($self) = @_; defined($self->{text}) or throw Mail::SPF::ENoUnparsedText; return $self->{text}; } =item B<version_tag>: returns I<string> I<Abstract>. Returns the version tag of the record. This method is abstract and must be implemented by sub-classes of Mail::SPF::Record. =item B<scopes>: returns I<list> of I<string> Returns a list of the scopes that are covered by the record. See the description of the L</new> constructor's C<scopes> option. =cut sub scopes { my ($self) = @_; return @{$self->{scopes}}; } =item B<terms>: returns I<list> of I<Mail::SPF::Term> Returns a list of the terms that make up the record, excluding any global modifiers, which are returned by the C<global_mods> method. See the description of the L</new> constructor's C<terms> option. =cut sub terms { my ($self) = @_; return @{$self->{terms}}; } =item B<global_mods>: returns I<list> of I<Mail::SPF::GlobalMod> Returns a list of the global modifiers of the record, ordered ascending by modifier precedence. See the description of the L</new> constructor's C<global_mods> option. =cut sub global_mods { my ($self) = @_; return sort { $a->precedence <=> $b->precedence } values(%{$self->{global_mods}}); } =item B<global_mod($mod_name)>: returns I<Mail::SPF::GlobalMod> Returns the global modifier of the given name if it is present in the record. Returns B<undef> 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->{global_mods}->{$mod_name}; } =item B<stringify>: returns I<string> 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<"OVERLOADING">. =cut sub stringify { my ($self) = @_; return join(' ', $self->version_tag, $self->terms, $self->global_mods); } =item B<eval($server, $request)>: throws I<Mail::SPF::Result> Evaluates the SPF record in the context of the request parameters represented by the given I<Mail::SPF::Request> object. The given I<Mail::SPF::Server> object is used for performing DNS look-ups. Throws a I<Mail::SPF::Result> object matching the outcome of the evaluation; see L<Mail::SPF::Result>. 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 { foreach my $term ($self->terms) { if ($term->isa('Mail::SPF::Mech')) { # Term is a mechanism. my $mech = $term; if ($mech->match($server, $request)) { my $result_name = $self->results_by_qualifier->{$mech->qualifier}; my $result_class = $server->result_class($result_name); my $result = $result_class->new($server, $request, "Mechanism '$term' matched"); $mech->explain($server, $request, $result); $result->throw(); } } elsif ($term->isa('Mail::SPF::PositionalMod')) { # Term is a positional modifier. my $mod = $term; $mod->process($server, $request); } elsif ($term->isa('Mail::SPF::UnknownMod')) { # Term is an unknown modifier. Ignore it (RFC 4408, 6/3). } else { # Invalid term object encountered: throw Mail::SPF::EUnexpectedTermObject( "Unexpected term object '$term' encountered"); } } # Default result when "falling off" the end of the record (RFC 4408, 4.7/1): $server->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->global_mods) { $global_mod->process($server, $request, $result); } $result->throw(); }; } =back =head1 OVERLOADING If a Mail::SPF::Record object is used as a I<string>, the C<stringify> method is used to convert the object into a string. =head1 SEE ALSO L<Mail::SPF>, L<Mail::SPF::v1::Record>, L<Mail::SPF::v2::Record>, L<Mail::SPF::Term>, L<Mail::SPF::Mech>, L<Mail::SPF::Mod> L<http://tools.ietf.org/html/rfc4408> 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;