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


line stmt bran cond sub pod time code
1             #
2             # Mail::SPF::Mech::Include
3             # SPF record "include" mechanism class.
4             #
5             # (C) 2005-2012 Julian Mehnle
6             # 2005 Shevek
7             # $Id: Include.pm 57 2012-01-30 08:15:31Z julian $
8             #
9             ##############################################################################
10              
11             package Mail::SPF::Mech::Include;
12              
13             =head1 NAME
14              
15             Mail::SPF::Mech::Include - SPF record C mechanism class
16              
17             =head1 VERSION
18              
19             version 3.20250505
20              
21             =cut
22              
23 1     1   1546 use warnings;
  1         3  
  1         73  
24 1     1   8 use strict;
  1         3  
  1         34  
25              
26 1     1   6 use base 'Mail::SPF::Mech';
  1         2  
  1         188  
27              
28 1     1   9 use constant TRUE => (0 == 0);
  1         4  
  1         80  
29 1     1   9 use constant FALSE => not TRUE;
  1         12  
  1         65  
30              
31 1     1   7 use constant name => 'include';
  1         4  
  1         90  
32 1     1   8 use constant name_pattern => qr/${\name}/i;
  1         2  
  1         2  
  1         464  
33              
34             =head1 DESCRIPTION
35              
36             An object of class B represents an SPF record
37             mechanism of type C.
38              
39             =head2 Constructors
40              
41             The following constructors are provided:
42              
43             =over
44              
45             =item B: returns I
46              
47             Creates a new SPF record C mechanism object.
48              
49             %options is a list of key/value pairs representing any of the following
50             options:
51              
52             =over
53              
54             =item B
55              
56             =item B
57              
58             See L.
59              
60             =back
61              
62             =item B: returns I;
63             throws I, I
64              
65             Creates a new SPF record C mechanism object by parsing the string and
66             any options given.
67              
68             =back
69              
70             =head2 Class methods
71              
72             The following class methods are provided:
73              
74             =over
75              
76             =item B
77              
78             =item B
79              
80             See L.
81              
82             =item B: returns I
83              
84             Returns B<'include'>.
85              
86             =item B: returns I
87              
88             Returns a regular expression that matches a mechanism name of B<'include'>.
89              
90             =back
91              
92             =head2 Instance methods
93              
94             The following instance methods are provided:
95              
96             =over
97              
98             =cut
99              
100             sub parse_params {
101 0     0 0   my ($self) = @_;
102 0           $self->parse_domain_spec(TRUE);
103 0           return;
104             }
105              
106             =item B
107              
108             =item B
109              
110             =item B
111              
112             =cut
113              
114             sub params {
115 0     0 1   my ($self) = @_;
116 0 0         return defined($self->{domain_spec}) ? ':' . $self->{domain_spec} : undef;
117             }
118              
119             =item B
120              
121             See L.
122              
123             =item B: returns I
124              
125             Returns the C parameter of the mechanism.
126              
127             =cut
128              
129             # Make read-only accessor:
130             __PACKAGE__->make_accessor('domain_spec', TRUE);
131              
132             =item B: returns I
133              
134             Performs a recursive SPF check using the given SPF server and request objects
135             and substituting the mechanism's target domain name for the request's authority
136             domain. The result of the recursive SPF check is translated as follows:
137              
138             Recursive result | Effect
139             ------------------+-----------------
140             pass | return true
141             fail | return false
142             softfail | return false
143             neutral | return false
144             none | throw PermError
145             permerror | throw PermError
146             temperror | throw TempError
147              
148             See RFC 4408, 5.2, for the exact algorithm used.
149              
150             =cut
151              
152             sub match {
153 0     0 1   my ($self, $server, $request) = @_;
154              
155 0           $server->count_dns_interactive_term($request);
156              
157             # Create sub-request with mutated authority domain:
158 0           my $authority_domain = $self->domain($server, $request);
159 0           my $sub_request = $request->new_sub_request(authority_domain => $authority_domain);
160              
161             # Process sub-request:
162 0           my $result = $server->process($sub_request);
163              
164             # Translate result of sub-request (RFC 4408, 5/9):
165              
166 0 0         return TRUE
167             if $result->isa('Mail::SPF::Result::Pass');
168              
169 0 0 0       return FALSE
      0        
170             if $result->isa('Mail::SPF::Result::Fail')
171             or $result->isa('Mail::SPF::Result::SoftFail')
172             or $result->isa('Mail::SPF::Result::Neutral');
173              
174 0 0         $server->throw_result('permerror', $request,
175             "Included domain '$authority_domain' has no applicable sender policy")
176             if $result->isa('Mail::SPF::Result::None');
177              
178             # Propagate any other results (including {Perm,Temp}Error) as-is:
179 0           $result->throw();
180             }
181              
182             =back
183              
184             =head1 SEE ALSO
185              
186             L, L, L, L
187              
188             L
189              
190             For availability, support, and license information, see the README file
191             included with Mail::SPF.
192              
193             =head1 AUTHORS
194              
195             Julian Mehnle , Shevek
196              
197             =cut
198              
199             TRUE;