This file is indexed.

/usr/share/perl5/Mail/SPF/Result.pm is in libmail-spf-perl 2.9.0-2.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
#
# Mail::SPF::Result
# SPF result class.
#
# (C) 2005-2012 Julian Mehnle <julian@mehnle.net>
# $Id: Result.pm 57 2012-01-30 08:15:31Z julian $
#
##############################################################################

package Mail::SPF::Result;

=head1 NAME

Mail::SPF::Result - SPF result class

=cut

use warnings;
use strict;

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

use base 'Error', 'Mail::SPF::Base';
    # An SPF result is not really a code exception in ideology, but in form.
    # The Error base class fits our purpose, anyway.

use Mail::SPF::Util;

use Error ':try';

use constant TRUE   => (0 == 0);
use constant FALSE  => not TRUE;

use constant result_classes => {
    pass        => 'Mail::SPF::Result::Pass',
    fail        => 'Mail::SPF::Result::Fail',
    softfail    => 'Mail::SPF::Result::SoftFail',
    neutral     => 'Mail::SPF::Result::Neutral',
   'neutral-by-default'
                => 'Mail::SPF::Result::NeutralByDefault',
    none        => 'Mail::SPF::Result::None',
    error       => 'Mail::SPF::Result::Error',
    permerror   => 'Mail::SPF::Result::PermError',
    temperror   => 'Mail::SPF::Result::TempError'
};

use constant received_spf_header_name => 'Received-SPF';

use constant received_spf_header_scope_names_by_scope => {
    helo        => 'helo',
    mfrom       => 'mailfrom',
    pra         => 'pra'
};

use constant received_spf_header_identity_key_names_by_scope => {
    helo        => 'helo',
    mfrom       => 'envelope-from',
    pra         => 'pra'
};

use constant atext_pattern              => qr/[\p{IsAlnum}!#\$%&'*+\-\/=?^_`{|}~]/;

use constant dot_atom_pattern           => qr/
    (${\atext_pattern})+ ( \. (${\atext_pattern})+ )*
/x;

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

=head1 SYNOPSIS

For the general usage of I<Mail::SPF::Result> objects in code that calls
Mail::SPF, see L<Mail::SPF>.  For the detailed interface of I<Mail::SPF::Result>
and its derivatives, see below.

=head2 Throwing results

    package Mail::SPF::Foo;
    use Error ':try';
    use Mail::SPF::Result;

    sub foo {
        if (...) {
            $server->throw_result('pass', $request)
        }
        else {
            $server->throw_result('permerror', $request, 'Invalid foo');
        }
    }

=head2 Catching results

    package Mail::SPF::Bar;
    use Error ':try';
    use Mail::SPF::Foo;

    try {
        Mail::SPF::Foo->foo();
    }
    catch Mail::SPF::Result with {
        my ($result) = @_;
        ...
    };

=head2 Using results

    my $result_name     = $result->name;
    my $result_code     = $result->code;
    my $request         = $result->request;
    my $local_exp       = $result->local_explanation;
    my $authority_exp   = $result->authority_explanation
        if $result->can('authority_explanation');
    my $spf_header      = $result->received_spf_header;

=cut

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

=head1 DESCRIPTION

An object of class B<Mail::SPF::Result> represents the result of an SPF
request.

There is usually no need to construct an SPF result object directly using the
C<new> constructor.  Instead, use the C<throw> class method to signal to the
calling code that a definite SPF result has been determined.  In other words,
use Mail::SPF::Result and its derivatives just like exceptions.  See L<Error>
or L<perlfunc/eval> for how to handle exceptions in Perl.

=head2 Constructor

The following constructor is provided:

=over

=item B<new($server, $request)>: returns I<Mail::SPF::Result>

=item B<new($server, $request, $text)>: returns I<Mail::SPF::Result>

Creates a new SPF result object and associates the given I<Mail::SPF::Server>
and I<Mail::SPF::Request> objects with it.  An optional result text may be
specified.

=cut

sub new {
    my ($self, @args) = @_;

    local $Error::Depth = $Error::Depth + 1;

    $self =
        ref($self) ?                        # Was new() invoked on a class or an object?
            bless({ %$self }, ref($self))   # Object: clone source result object.
        :   $self->SUPER::new();            # Class:  create new result object.

    # Set/override fields:
    $self->{server}  = shift(@args) if @args;
    defined($self->{server})
        or throw Mail::SPF::EOptionRequired('Mail::SPF server object required');
    $self->{request} = shift(@args) if @args;
    defined($self->{request})
        or throw Mail::SPF::EOptionRequired('Request object required');
    $self->{'-text'} = shift(@args) if @args;

    return $self;
}

=back

=head2 Class methods

The following class methods are provided:

=over

=item B<throw($server, $request)>: throws I<Mail::SPF::Result>

=item B<throw($server, $request, $text)>: throws I<Mail::SPF::Result>

Throws a new SPF result object, associating the given I<Mail::SPF::Server> and
I<Mail::SPF::Request> objects with it.  An optional result text may be
specified.

I<Note>:  Do not write code invoking C<throw> on I<literal> result class names
as this would ignore any derivative result classes provided by B<Mail::SPF>
extension modules.  Invoke the L<C<throw_result>|Mail::SPF::Server/throw_result>
method on a I<Mail::SPF::Server> object instead.

=cut

sub throw {
    my ($self, @args) = @_;
    local $Error::Depth = $Error::Depth + 1;
    $self = $self->new(@args);
        # Always create/clone a new result object, not just when throwing for the first time!
    die($Error::THROWN = $self);
}

=item B<name>: returns I<string>

I<Abstract>.  Returns the result name of the result class (or object).  For
classes of the I<Mail::SPF::Result::*> hierarchy, this roughly corresponds to
the trailing part of the class name.  For example, returns C<neutral-by-default>
if invoked on I<Mail::SPF::Result::NeutralByDefault>.  Also see the L</code>
method.  This method may also be used as an instance method.

This method must be implemented by sub-classes of Mail::SPF::Result for which
the result I<name> differs from the result I<code>.

=cut

# This method being implemented here does not make it any less abstract,
# because the code() method it uses is still abstract.
sub name {
    my ($self) = @_;
    return $self->code;
}

=item B<class>: returns I<class>

=item B<class($name)>: returns I<class>

Maps the given result name to the corresponding I<Mail::SPF::Result::*> class,
or returns the result base class (the class on which it is invoked) if no
result name is given.  If an unknown result name is specified, returns
B<undef>.

=cut

sub class {
    my ($self, $name) = @_;
    return defined($name) ? $self->result_classes->{lc($name)} : (ref($self) || $self);
}

=item B<isa_by_name($name)>: returns I<boolean>

If the class (or object) on which this method is invoked represents the given
result name (or a derivative name), returns B<true>.  Returns B<false>
otherwise.  This method may also be used as an instance method.

For example, C<< Mail::SPF::Result::NeutralByDefault->isa_by_name('neutral') >>
returns B<true>.

=cut

sub isa_by_name {
    my ($self, $name) = @_;
    my $suspect_class = $self->class($name);
    return FALSE if not defined($suspect_class);
    return $self->isa($suspect_class);
}

=item B<code>: returns I<string>

I<Abstract>.  Returns the basic SPF result code (C<"pass">, C<"fail">,
C<"softfail">, C<"neutral">, C<"none">, C<"error">, C<"permerror">,
C<"temperror">) of the result class on which it is invoked.  All valid result
codes are valid result names as well, the reverse however does not apply.  This
method may also be used as an instance method.

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

=item B<is_code($code)>: returns I<boolean>

If the class (or object) on which this method is invoked represents the given
result code, returns B<true>.  Returns B<false> otherwise.  This method may
also be used as an instance method.

I<Note>:  The L</isa_by_name> method provides a superset of this method's
functionality.

=cut

sub is_code {
    my ($self, $code) = @_;
    return $self->isa_by_name($code);
}

=item B<received_spf_header_name>: returns I<string>

Returns B<'Received-SPF'> as the field name for C<Received-SPF> header fields.
This method should be overridden by B<Mail::SPF> extension modules that provide
non-standard features (such as local policy) with the capacity to dilute the
purity of SPF results, in order not to deceive users of the header field into
mistaking it as an indication of a natural SPF result.

=back

=head2 Instance methods

The following instance methods are provided:

=over

=item B<throw>: throws I<Mail::SPF::Result>

=item B<throw($server, $request)>: throws I<Mail::SPF::Result>

=item B<throw($server, $request, $text)>: throws I<Mail::SPF::Result>

Re-throws an existing SPF result object.  If I<Mail::SPF::Server> and
I<Mail::SPF::Request> objects are specified, associates them with the result
object, replacing the prior server and request objects.  If a result text is
specified as well, overrides the prior result text.

=item B<server>: returns I<Mail::SPF::Server>

Returns the Mail::SPF server object that produced the result at hand.

=item B<request>: returns I<Mail::SPF::Request>

Returns the SPF request that led to the result at hand.

=cut

# Read-only accessors:
__PACKAGE__->make_accessor($_, TRUE)
    foreach qw(server request);

=item B<text>: returns I<string>

Returns the text message of the result object.

=item B<stringify>: returns I<string>

Returns the result's name and text message formatted as a string.  You can
simply use a Mail::SPF::Result object as a string for the same effect, see
L</OVERLOADING>.

=cut

sub stringify {
    my ($self) = @_;
    return sprintf(
        "%s (%s)",
        $self->name,
        Mail::SPF::Util->sanitize_string($self->SUPER::stringify)
    );
}

=item B<local_explanation>: returns I<string>; throws I<Mail::SPF::EDNSError>,
I<Mail::SPF::EInvalidMacroString>

Returns a locally generated explanation for the result.

The local explanation is prefixed with the authority domain whose sender policy
is responsible for the result.  If the responsible sender policy referred to
another domain's policy (using the C<include> mechanism or the C<redirect>
modifier), that other domain which is I<directly> responsible for the result is
also included in the local explanation's head.  For example:

    example.com: <local-explanation>

The authority domain C<example.com>'s sender policy is directly responsible for
the result.

    example.com ... other.example.org: <local-explanation>

The authority domain C<example.com> (directly or indirectly) referred to the
domain C<other.example.org>, whose sender policy then led to the result.

=cut

sub local_explanation {
    my ($self) = @_;
    my $local_explanation = $self->{local_explanation};

    return $local_explanation
        if defined($local_explanation);

    # Prepare local explanation:
    my $request = $self->{request};
    $local_explanation = $request->state('local_explanation');
    if (defined($local_explanation)) {
        $local_explanation = sprintf("%s (%s)", $local_explanation->expand, lcfirst($self->text));
    }
    else {
        $local_explanation = $self->text;
    }

    # Resolve authority domains of root-request and bottom sub-request:
    my $root_request = $request->root_request;
    $local_explanation =
        $request == $root_request ?
            sprintf("%s: %s", $request->authority_domain, $local_explanation)
        :   sprintf("%s ... %s: %s",
                $root_request->authority_domain, $request->authority_domain, $local_explanation);

    return $self->{local_explanation} = Mail::SPF::Util->sanitize_string($local_explanation);
}

=item B<received_spf_header>: returns I<string>

Returns a string containing an appropriate C<Received-SPF> header field for the
result object.  The header field is not line-wrapped and contains no trailing
newline character.

=cut

sub received_spf_header {
    my ($self) = @_;
    return $self->{received_spf_header}
        if defined($self->{received_spf_header});
    my $scope_name =
        $self->received_spf_header_scope_names_by_scope->{$self->{request}->scope};
    my $identity_key_name =
        $self->received_spf_header_identity_key_names_by_scope->{$self->{request}->scope};
    my @info_pairs = (
        receiver            => $self->{server}->hostname || 'unknown',
        identity            => $scope_name,
        $identity_key_name  => $self->{request}->identity,
        (
            ($self->{request}->scope ne 'helo' and defined($self->{request}->helo_identity)) ?
                (helo       => $self->{request}->helo_identity)
            :   ()
        ),
        'client-ip'         => Mail::SPF::Util->ip_address_to_string($self->{request}->ip_address)
    );
    my $info_string;
    while (@info_pairs) {
        my $key   = shift(@info_pairs);
        my $value = shift(@info_pairs);
        $info_string .= '; ' if defined($info_string);
        if ($value !~ /^${\dot_atom_pattern}$/o) {
            $value =~ s/(["\\])/\\$1/g;   # Escape '\' and '"' characters.
            $value = '"' . $value . '"';  # Double-quote value.
        }
        $info_string .= "$key=$value";
    }
    return $self->{received_spf_header} = sprintf(
        "%s: %s (%s) %s",
        $self->received_spf_header_name,
        $self->code,
        $self->local_explanation,
        $info_string
    );
}

=back

=head1 OVERLOADING

If a Mail::SPF::Result object is used as a I<string>, the L</stringify> method
is used to convert the object into a string.

=head1 RESULT CLASSES

The following result classes are provided:

=over

=item *

I<Mail::SPF::Result::Pass>

=item *

I<Mail::SPF::Result::Fail>

=item *

I<Mail::SPF::Result::SoftFail>

=item *

I<Mail::SPF::Result::Neutral>

=over

=item *

I<Mail::SPF::Result::NeutralByDefault>

This is a special case of the C<neutral> result that is thrown as a default
when "falling off" the end of the record during evaluation.  See RFC 4408,
4.7.

=back

=item *

I<Mail::SPF::Result::None>

=item *

I<Mail::SPF::Result::Error>

=over

=item *

I<Mail::SPF::Result::PermError>

=item *

I<Mail::SPF::Result::TempError>

=back

=back

The following result classes have additional functionality:

=over

=item I<Mail::SPF::Result::Fail>

The following additional instance method is provided:

=over

=item B<authority_explanation>: returns I<string>; throws I<Mail::SPF::EDNSError>,
I<Mail::SPF::EInvalidMacroString>

Returns the authority domain's explanation for the result.  Be aware that the
authority domain may be a malicious party and thus the authority explanation
should not be trusted blindly.  See RFC 4408, 10.5, for a detailed discussion
of this issue.

=back

=back

=cut

package Mail::SPF::Result::Pass;
our @ISA = 'Mail::SPF::Result';
use constant code => 'pass';

package Mail::SPF::Result::Fail;
our @ISA = 'Mail::SPF::Result';
use Error ':try';
use Mail::SPF::Exception;
use constant code => 'fail';

sub authority_explanation {
    my ($self) = @_;
    my $authority_explanation = $self->{authority_explanation};

    return $authority_explanation
        if defined($authority_explanation);

    my $server  = $self->{server};
    my $request = $self->{request};

    my $authority_explanation_macrostring = $request->state('authority_explanation');

    # If an explicit explanation was specified by the authority domain...
    if (defined($authority_explanation_macrostring)) {
        try {
            # ... then try to expand it:
            $authority_explanation = $authority_explanation_macrostring->expand;
        }
        catch Mail::SPF::EInvalidMacroString with {};
            # Ignore expansion errors and leave authority explanation undefined.
    }

    # If no authority explanation could be determined so far...
    if (not defined($authority_explanation)) {
        # ... then use the server's default authority explanation:
        $authority_explanation =
            $server->default_authority_explanation->new(request => $request)->expand;
    }

    return $self->{authority_explanation} = $authority_explanation;
}

package Mail::SPF::Result::SoftFail;
our @ISA = 'Mail::SPF::Result';
use constant code => 'softfail';

package Mail::SPF::Result::Neutral;
our @ISA = 'Mail::SPF::Result';
use constant code => 'neutral';

package Mail::SPF::Result::NeutralByDefault;
our @ISA = 'Mail::SPF::Result::Neutral';
use constant name => 'neutral-by-default';
    # This is a special-case of the Neutral result that is thrown as a default
    # when "falling off" the end of the record.  See Mail::SPF::Record::eval().

package Mail::SPF::Result::None;
our @ISA = 'Mail::SPF::Result';
use constant code => 'none';

package Mail::SPF::Result::Error;
our @ISA = 'Mail::SPF::Result';
use constant code => 'error';

package Mail::SPF::Result::PermError;
our @ISA = 'Mail::SPF::Result::Error';
use constant code => 'permerror';

package Mail::SPF::Result::TempError;
our @ISA = 'Mail::SPF::Result::Error';
use constant code => 'temperror';

=head1 SEE ALSO

L<Mail::SPF>, L<Mail::SPF::Server>, L<Error>, L<perlfunc/eval>

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>

=cut

package Mail::SPF::Result;

TRUE;