1#
2# Mail::SPF::Request
3# SPF request class.
4#
5# (C) 2005-2012 Julian Mehnle <julian@mehnle.net>
6#     2005      Shevek <cpan@anarres.org>
7# $Id: Request.pm 57 2012-01-30 08:15:31Z julian $
8#
9##############################################################################
10
11package Mail::SPF::Request;
12
13=head1 NAME
14
15Mail::SPF::Request - SPF request class
16
17=cut
18
19use warnings;
20use strict;
21
22use base 'Mail::SPF::Base';
23
24use NetAddr::IP;
25
26use Mail::SPF::Util;
27
28use constant TRUE   => (0 == 0);
29use constant FALSE  => not TRUE;
30
31use constant versions_for_scope => {
32    helo    => [1   ],
33    mfrom   => [1, 2],
34    pra     => [   2]
35};
36
37use constant scopes_by_version => {
38    1       => ['helo', 'mfrom'       ],
39    2       => [        'mfrom', 'pra']
40};
41
42use constant default_localpart => 'postmaster';
43
44# Interface:
45##############################################################################
46
47=head1 SYNOPSIS
48
49    use Mail::SPF;
50
51    my $request = Mail::SPF::Request->new(
52        versions    => [1, 2],              # optional
53        scope       => 'mfrom',             # or 'helo', 'pra'
54        identity    => 'fred@example.com',
55        ip_address  => '192.168.0.1',
56        helo_identity                       # optional,
57                    => 'mta.example.com'    #   for %{h} macro expansion
58    );
59
60    my @versions    = $request->versions;
61    my $scope       = $request->scope;
62    my $authority_domain
63                    = $request->authority_domain;
64    my $identity    = $request->identity;   # 'localpart@domain' or 'domain'
65    my $domain      = $request->domain;
66    my $localpart   = $request->localpart;
67    my $ip_address  = $request->ip_address;     # IPv4 or IPv6 address
68    my $ip_address_v6                           # native IPv6 address or
69                    = $request->ip_address_v6;  #   IPv4-mapped IPv6 address
70    my $helo_identity                           # additional HELO identity
71                    = $request->helo_identity;  #   for non-HELO scopes
72
73    my $record      = $request->record;
74        # the record selected during processing of the request, may be undef
75
76    $request->state(field => 'value');
77    my $value = $request->state('field');
78
79=cut
80
81# Implementation:
82##############################################################################
83
84=head1 DESCRIPTION
85
86An object of class B<Mail::SPF::Request> represents an SPF request.
87
88=head2 Constructors
89
90The following constructors are provided:
91
92=over
93
94=item B<new(%options)>: returns I<Mail::SPF::Request>
95
96Creates a new SPF request object.  The request is considered the
97I<root-request> for any subsequent sub-requests (see the L</new_sub_request>
98constructor).
99
100%options is a list of key/value pairs representing any of the following
101options:
102
103=over
104
105=item B<versions>
106
107A reference to an I<array> of I<integer>s listing the versions of SPF records
108that may be used for the SPF check.  Only those record versions that cover the
109desired scope will actually be used.  At least one applicable version must be
110specified.  For a single record version, a simple scalar may be specified
111instead of an array-ref.  Defaults to all versions that cover the desired scope
112(see below); defaults to B<[1, 2]> for the default scope of B<'mfrom'>.
113
114The following versions are supported:
115
116=over
117
118=item B<1>
119
120Use C<v=spf1> records.
121
122=item B<2>
123
124Use C<spf2.0> records.
125
126=back
127
128I<Example>:  A value of B<1> (or B<[1]>) means that only C<v=spf1> records
129should be used for the SPF check.  If at the same time a scope of B<'pra'> is
130specified, a I<Mail::SPF::EInvalidScope> exception will be thrown as C<v=spf1>
131records do not cover the PRA scope.
132
133=item B<scope>
134
135A string denoting the authorization scope of the identity that should be
136checked.  Defaults to B<'mfrom'>.  The following scope values are supported:
137
138=over
139
140=item B<'helo'>
141
142The given identity is the C<HELO> parameter of an SMTP transaction (RFC 2821)
143and should be checked against SPF records that cover the C<helo> scope
144(C<v=spf1>).  See the SPFv1 specification (RFC 4408) for the formal definition
145of the C<HELO> scope.
146
147=item B<'mfrom'>
148
149The given identity is the C<MAIL FROM> parameter of an SMTP transaction (RFC
1502821), and should be checked against SPF records that cover the C<mfrom> scope
151(C<v=spf1> and C<spf2.0/mfrom>).  See the SPFv1 specification (RFC 4408) for
152the formal definition of the C<MAIL FROM> scope.
153
154I<Note>:  In the case of an empty C<MAIL FROM> SMTP transaction parameter (C<<
155MAIL FROM:<> >>), you should perform a check with the C<helo> scope instead.
156
157=item B<'pra'>
158
159The given identity is the "Purported Responsible Address" of an internet
160message (RFC 2822) and should be checked against SPF records that cover the
161C<pra> scope (C<spf2.0/pra>).  See the PRA specification (RFC 4407) for the
162formal definition of the PRA scope.
163
164=back
165
166=item B<authority_domain>
167
168A string denoting the domain name that should be queried for sender policy
169records.  Defaults to the domain of the C<identity> option.  There is usually
170no need to specify the C<authority_domain> option.
171
172=item B<identity>
173
174I<Required>.  A string denoting the sender identity whose authorization should
175be checked.  This is a domain name for the C<helo> scope, and an e-mail address
176for the C<mfrom> and C<pra> scopes.
177
178I<Note>:  An empty identity must not be passed.  In the case of an empty C<MAIL
179FROM> SMTP transaction parameter, you should perform a check with the C<helo>
180scope instead.
181
182=item B<ip_address>
183
184I<Required> for checks with the C<helo>, C<mfrom>, and C<pra> scopes.  Either a
185string or a I<NetAddr::IP> object denoting the IP address of the host claiming
186the identity that is being checked.  Can be either an IPv4 or an IPv6 address.
187An IPv4-mapped IPv6 address (e.g. '::ffff:192.168.0.1') is treated as an IPv4
188address.
189
190=item B<helo_identity>
191
192A string denoting the C<HELO> SMTP transaction parameter in the case that the
193main identity is of a scope other than C<helo>.  This identity is then used
194merely for the expansion of C<%{h}> macros during the policy evaluation of the
195main identity.  Defaults to B<undef>, which will be expanded to B<'unknown'>.
196If the main identity is of the C<helo> scope, this option is unused.
197
198=back
199
200=cut
201
202sub new {
203    my ($self, %options) = @_;
204
205    # Create new object:
206    $self = $self->SUPER::new(%options);
207    # If the request object already has a state hash, clone its contents:
208    $self->{state} = { %{$self->{state}} }
209        if ref($self->{state}) eq 'HASH';
210
211    # Scope:
212    $self->{scope} ||= 'mfrom';
213    my $versions_for_scope = $self->versions_for_scope->{$self->{scope}}
214        or throw Mail::SPF::EInvalidScope("Invalid scope '$self->{scope}'");
215
216    # Versions:
217    if (not defined($self->{versions})) {
218        # No versions specified, use all versions relevant to scope:
219        $self->{versions} = $versions_for_scope;
220    }
221    else {
222        if (not ref($self->{versions})) {
223            # Single version specified as scalar:
224            $self->{versions} = [$self->{versions}];
225        }
226        elsif (ref($self->{versions}) ne 'ARRAY') {
227            # Something other than scalar or array-ref specified:
228            throw Mail::SPF::EInvalidOptionValue(
229                "'versions' option must be string or array-ref");
230        }
231
232        # All requested record versions must be supported:
233        my @unsupported_versions = grep(
234            (not defined($self->scopes_by_version->{$_})),
235            @{$self->{versions}}
236        );
237        not @unsupported_versions
238            or throw Mail::SPF::EInvalidOptionValue(
239                'Unsupported record version(s) ' .
240                join(', ', map("'$_'", @unsupported_versions)));
241
242        # Use only those record versions that are relevant to the requested scope:
243        my %versions_for_scope;
244           @versions_for_scope{@$versions_for_scope} = ();
245        my @versions = grep(exists($versions_for_scope{$_}), @{$self->{versions}});
246
247        # Require at least one relevant record version that covers the scope:
248        @versions
249            or throw Mail::SPF::EInvalidScope(
250                "Invalid scope '$self->{scope}' for record version(s) " .
251                join(', ', @{$self->{versions}}));
252
253        $self->{versions} = \@versions;
254    }
255
256    # Identity:
257    defined($self->{identity})
258        or throw Mail::SPF::EOptionRequired("Missing required 'identity' option");
259    length($self->{identity})
260        or throw Mail::SPF::EInvalidOptionValue("'identity' option must not be empty");
261
262    # Extract domain and localpart from identity:
263    if (
264        ($self->{scope} eq 'mfrom' or $self->{scope} eq 'pra') and
265        $self->{identity} =~ /^(.*)@(.*?)$/
266    ) {
267        $self->{domain}    = $2;
268        $self->{localpart} = $1;
269    }
270    else {
271        $self->{domain}    = $self->{identity};
272    }
273    $self->{domain} =~ s/^(.*?)\.?$/\L$1/;
274        # Lower-case domain and remove eventual trailing dot.
275    $self->{localpart} = $self->default_localpart
276        if not defined($self->{localpart}) or not length($self->{localpart});
277
278    # HELO identity:
279    if ($self->{scope} eq 'helo') {
280        $self->{helo_identity} ||= $self->{identity};
281    }
282
283    # IP address:
284    throw Mail::SPF::EOptionRequired("Missing required 'ip_address' option")
285        if  grep($self->{scope} eq $_, qw(helo mfrom pra))
286        and not defined($self->{ip_address});
287
288    # Ensure ip_address is a NetAddr::IP object:
289    if (not UNIVERSAL::isa($self->{ip_address}, 'NetAddr::IP')) {
290        my $ip_address = NetAddr::IP->new($self->{ip_address})
291            or throw Mail::SPF::EInvalidOptionValue("Invalid IP address '$self->{ip_address}'");
292        $self->{ip_address} = $ip_address;
293    }
294
295    # Convert IPv4 address to IPv4-mapped IPv6 address:
296    if (Mail::SPF::Util->ipv6_address_is_ipv4_mapped($self->{ip_address})) {
297        $self->{ip_address_v6} = $self->{ip_address};  # Accept as IPv6 address as-is.
298        $self->{ip_address} = Mail::SPF::Util->ipv6_address_to_ipv4($self->{ip_address});
299    }
300    elsif ($self->{ip_address}->version == 4) {
301        $self->{ip_address_v6} = Mail::SPF::Util->ipv4_address_to_ipv6($self->{ip_address});
302    }
303    elsif ($self->{ip_address}->version == 6) {
304        $self->{ip_address_v6} = $self->{ip_address};
305    }
306    else {
307        throw Mail::SPF::EInvalidOptionValue(
308            "Unexpected IP address version '" . $self->{ip_address}->version . "'");
309    }
310
311    return $self;
312}
313
314=item B<new_sub_request(%options)>: returns I<Mail::SPF::Request>
315
316Must be invoked on an existing request object.  Creates a new sub-request
317object by cloning the invoked request, which is then considered the new
318request's I<super-request>.  Any specified options (see the L</new>
319constructor) override the parameters of the super-request.  There is usually no
320need to specify any options I<besides> the C<authority_domain> option.
321
322=cut
323
324sub new_sub_request {
325    my ($super_request, %options) = @_;
326    UNIVERSAL::isa($super_request, __PACKAGE__)
327        or throw Mail::SPF::EInstanceMethod;
328    my $self = $super_request->new(%options);
329    $self->{super_request} = $super_request;
330    $self->{root_request}  = $super_request->root_request;
331    return $self;
332}
333
334=back
335
336=head2 Instance methods
337
338The following instance methods are provided:
339
340=over
341
342=item B<root_request>: returns I<Mail::SPF::Request>
343
344Returns the root of the request's chain of super-requests.  Specifically,
345returns the request itself if it has no super-requests.
346
347=cut
348
349sub root_request {
350    my ($self) = @_;
351    # Read-only!
352    return $self->{root_request} || $self;
353}
354
355=item B<super_request>: returns I<Mail::SPF::Request>
356
357Returns the super-request of the request, or B<undef> if there is none.
358
359=cut
360
361# Make read-only accessor:
362__PACKAGE__->make_accessor('super_request', TRUE);
363
364=item B<versions>: returns I<list> of I<string>
365
366Returns a list of the SPF record versions that are used for request.  See the
367description of the L</new> constructor's C<versions> option.
368
369=cut
370
371sub versions {
372    my ($self) = @_;
373    # Read-only!
374    return @{$self->{versions}};
375}
376
377=item B<scope>: returns I<string>
378
379Returns the scope of the request.  See the description of the L</new>
380constructor's C<scope> option.
381
382=item B<authority_domain>: returns I<string>
383
384Returns the authority domain of the request.  See the description of the
385L</new> constructor's C<authority_domain> option.
386
387=cut
388
389sub authority_domain {
390    my ($self) = @_;
391    return $self->{authority_domain} || $self->{domain};
392}
393
394=item B<identity>: returns I<string>
395
396Returns the identity of the request.  See the description of the L</new>
397constructor's C<identity> option.
398
399=item B<domain>: returns I<string>
400
401Returns the identity domain of the request.  See the description of the
402L</new> constructor's C<identity> option.
403
404=item B<localpart>: returns I<string>
405
406Returns the identity localpart of the request.  See the description of the
407L</new> constructor's C<identity> option.
408
409=item B<ip_address>: returns I<NetAddr::IP>
410
411Returns the IP address of the request as a I<NetAddr::IP> object.  See the
412description of the L</new> constructor's C<ip_address> option.
413
414=item B<ip_address_v6>: returns I<NetAddr::IP>
415
416Like the C<ip_address> method, however, an IPv4 address is returned as an
417IPv4-mapped IPv6 address (e.g. '::ffff:192.168.0.1') to facilitate uniform
418processing.
419
420=item B<helo_identity>: returns I<string>
421
422Returns the C<HELO> SMTP transaction parameter of the request.  See the
423description of the L</new> constructor's C<helo_identity> option.
424
425=cut
426
427# Make read-only accessors:
428__PACKAGE__->make_accessor($_, TRUE)
429    foreach qw(
430        scope identity domain localpart
431        ip_address ip_address_v6 helo_identity
432    );
433
434=item B<record>: returns I<Mail::SPF::Record>
435
436Returns the SPF record selected during the processing of the request, or
437B<undef> if there is none.
438
439=cut
440
441# Make read/write accessor:
442__PACKAGE__->make_accessor('record', FALSE);
443
444=item B<state($field)>: returns anything
445
446=item B<state($field, $value)>: returns anything
447
448Provides an interface for storing temporary state information with the request
449object.  This is primarily meant to be used internally by I<Mail::SPF::Server>
450and other Mail::SPF classes.
451
452If C<$value> is specified, stores it in a state field named C<$field>.  Returns
453the current (new) value of the state field named C<$field>.  This method may be
454used as an lvalue.
455
456=cut
457
458sub state :lvalue {
459    my ($self, $field, @value) = @_;
460    defined($field)
461        or throw Mail::SPF::EOptionRequired('Field name required');
462    $self->{state}->{$field} = $value[0]
463        if @value;
464    $self->{state}->{$field};
465}
466
467=back
468
469=head1 SEE ALSO
470
471L<Mail::SPF>, L<Mail::SPF::Server>
472
473L<http://tools.ietf.org/html/rfc4408>
474
475For availability, support, and license information, see the README file
476included with Mail::SPF.
477
478=head1 AUTHORS
479
480Julian Mehnle <julian@mehnle.net>, Shevek <cpan@anarres.org>
481
482=cut
483
484TRUE;
485