File Coverage

blib/lib/Mail/SPF/Mech/MX.pm
Criterion Covered Total %
statement 22 42 52.3
branch 0 14 0.0
condition 0 6 0.0
subroutine 7 10 70.0
pod 2 3 66.6
total 31 75 41.3


line stmt bran cond sub pod time code
1             #
2             # Mail::SPF::Mech::MX
3             # SPF record "mx" mechanism class.
4             #
5             # (C) 2005-2012 Julian Mehnle
6             # 2005 Shevek
7             # $Id: MX.pm 57 2012-01-30 08:15:31Z julian $
8             #
9             ##############################################################################
10              
11             package Mail::SPF::Mech::MX;
12              
13             =head1 NAME
14              
15             Mail::SPF::Mech::MX - SPF record C mechanism class
16              
17             =head1 VERSION
18              
19             version 3.20250505
20              
21             =cut
22              
23 1     1   1135 use warnings;
  1         1  
  1         48  
24 1     1   4 use strict;
  1         1  
  1         18  
25              
26 1     1   3 use base 'Mail::SPF::SenderIPAddrMech';
  1         2  
  1         182  
27              
28 1     1   9 use constant TRUE => (0 == 0);
  1         3  
  1         86  
29 1     1   7 use constant FALSE => not TRUE;
  1         3  
  1         72  
30              
31 1     1   7 use constant name => 'mx';
  1         4  
  1         72  
32 1     1   5 use constant name_pattern => qr/${\name}/i;
  1         2  
  1         1  
  1         404  
33              
34             =head1 DESCRIPTION
35              
36             An object of class B represents an SPF record mechanism of
37             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             =item B
59              
60             =item B
61              
62             See L.
63              
64             =back
65              
66             =item B: returns I;
67             throws I, I
68              
69             Creates a new SPF record C mechanism object by parsing the string and
70             any options given.
71              
72             =back
73              
74             =head2 Class methods
75              
76             The following class methods are provided:
77              
78             =over
79              
80             =item B
81              
82             =item B
83              
84             =item B
85              
86             =item B
87              
88             See L.
89              
90             =item B: returns I
91              
92             Returns B<'mx'>.
93              
94             =item B: returns I
95              
96             Returns a regular expression that matches a mechanism name of B<'mx'>.
97              
98             =back
99              
100             =head2 Instance methods
101              
102             The following instance methods are provided:
103              
104             =over
105              
106             =cut
107              
108             sub parse_params {
109 0     0 0   my ($self) = @_;
110 0           $self->parse_domain_spec();
111 0           $self->parse_ipv4_ipv6_prefix_lengths();
112 0           return;
113             }
114              
115             =item B
116              
117             =item B
118              
119             =item B
120              
121             =cut
122              
123             sub params {
124 0     0 1   my ($self) = @_;
125 0           my $params;
126             $params .= ':' . $self->{domain_spec}
127 0 0         if defined($self->{domain_spec});
128             $params .= '/' . $self->{ipv4_prefix_length}
129             if defined($self->{ipv4_prefix_length})
130 0 0 0       and $self->{ipv4_prefix_length} != $self->default_ipv4_prefix_length;
131             $params .= '//' . $self->{ipv6_prefix_length}
132             if defined($self->{ipv6_prefix_length})
133 0 0 0       and $self->{ipv6_prefix_length} != $self->default_ipv6_prefix_length;
134 0           return $params;
135             }
136              
137             =item B
138              
139             =item B
140              
141             =item B
142              
143             See L.
144              
145             =item B: returns I
146              
147             Returns the C parameter of the mechanism.
148              
149             =item B: returns I
150              
151             Returns the IPv4 network prefix length of the mechanism.
152              
153             =item B: returns I
154              
155             Returns the IPv6 network prefix length of the mechanism.
156              
157             =cut
158              
159             # Make read-only accessors:
160             __PACKAGE__->make_accessor($_, TRUE)
161             foreach qw(domain_spec ipv4_prefix_length ipv6_prefix_length);
162              
163             =item B: returns I
164              
165             Checks whether any MX hosts of the mechanism's target domain name (that is, any
166             of the host addresses of its DNS C records) matches the given request's IP
167             address (see L), and returns B if it does,
168             or B otherwise. The mechanism's IP network prefix lengths are respected
169             when matching address records against the request's IP address. See RFC 4408,
170             5 and 5.4, for the exact algorithm used.
171              
172             =cut
173              
174             sub match {
175 0     0 1   my ($self, $server, $request) = @_;
176              
177 0           $server->count_dns_interactive_term($request);
178              
179 0           my $target_domain = $self->domain($server, $request);
180 0           my $mx_packet = $server->dns_lookup($target_domain, 'MX');
181 0 0         my @mx_rrs = $mx_packet->answer
182             or $server->count_void_dns_lookup($request);
183              
184             # Respect the MX mechanism lookups limit (RFC 4408, 5.4/3/4):
185 0 0         @mx_rrs = splice(@mx_rrs, 0, $server->max_name_lookups_per_mx_mech)
186             if defined($server->max_name_lookups_per_mx_mech);
187              
188             # TODO Use A records from packet's "additional" section? Probably not.
189              
190             # Check MX records:
191 0           foreach my $rr (@mx_rrs) {
192 0 0         if ($rr->type eq 'MX') {
193 0 0         return TRUE
194             if $self->match_in_domain($server, $request, $rr->exchange);
195             }
196             else {
197             # Unexpected RR type.
198             # TODO Generate debug info or ignore silently.
199             }
200             }
201              
202 0           return FALSE;
203             }
204              
205             =back
206              
207             =head1 SEE ALSO
208              
209             L, L, L, L
210              
211             L
212              
213             For availability, support, and license information, see the README file
214             included with Mail::SPF.
215              
216             =head1 AUTHORS
217              
218             Julian Mehnle , Shevek
219              
220             =cut
221              
222             TRUE;