From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

MSIMERSON / Mail-DMARC-0.20130520 / t / 00.Dmarc.t 

            

              
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

              
use strict;
use warnings;
use Test::More;
use lib 'lib';
use_ok( 'Mail::DMARC' );
my $dmarc = Mail::DMARC->new();
isa_ok( $dmarc, 'Mail::DMARC' );
my %sample_dmarc = (
        config_file   => 'mail-dmarc.ini',
        source_ip     => '192.0.1.1',
        envelope_to   => 'example.com',
        envelope_from => 'cars4you.info',
        header_from   => 'yahoo.com',
        dkim          => [ {
                domain      => 'example.com',
                selector    => 'apr2013',
                result      => 'fail',
                human_result=> 'fail (body has been altered)',
        } ],
        spf           => {
                domain => 'example.com',
                scope  => 'mfrom',
                result => 'pass',
        },
    );
test_new();
test_header_from();
test_setter_values();
test_spf();
done_testing();
exit;
sub test_spf {
    ok( $dmarc->spf( domain => 'a.c', scope=>'mfrom', result => 'fail' ), "spf");
    eval { $dmarc->spf( dom => 'foo', 'blah' ) };
    ok( $@, "spf, neg, $@");
};
sub test_header_from {
    my @good_vals = ( qw/ spam-example.com bar.com / );
    foreach my $k ( @good_vals ) {
        ok( $dmarc->header_from( $k ), "header_from, $k");
    };
    my @bad_vals = ( qw/ a.b a@b.c f*ct.org / );
    foreach my $k ( @bad_vals ) {
        eval { $dmarc->header_from( $k ); };
        chomp $@;
        ok( $@, "header_from, $k, $@" );
    };
};
sub test_setter_values {
    my %good_vals = (
            source_ip     => [ qw/ 0.0.0.0 1.1.1.1 255.255.255.255 / ],
            envelope_to   => [ qw/ example.com / ],
            envelope_from => [ qw/ example.com / ],
            header_from   => [ qw/ spam-example.com / ],
            dkim          => [ $sample_dmarc{dkim} ],
            spf           => [ $sample_dmarc{spf} ],
            );
    foreach my $k ( keys %good_vals ) {
        foreach my $t ( @{$good_vals{$k}} ) {
            ok( defined $dmarc->$k( $t ), "$k, $t");
        };
    };
    my %bad_vals = (
            source_ip     => [ qw/ 0.257.0.25 255.255.255.256 / ],
            envelope_to   => [ qw/ 3.a / ],
            envelope_from => [ qw/ / ],
            header_from   => [ qw/ / ],
            dkim          => [ qw/ / ],
            spf           => [ qw/ / ],
            );
    foreach my $k ( keys %bad_vals ) {
        foreach my $t ( @{$bad_vals{$k}} ) {
            eval { $dmarc->$k( $t ); };
            ok( $@, "neg, $k, $t") or diag $dmarc->$k( $t );
        };
    };
};
sub test_new {
# empty policy
    my $dmarc = Mail::DMARC->new();
    isa_ok( $dmarc, 'Mail::DMARC' );
    is_deeply( $dmarc, { config_file => 'mail-dmarc.ini' }, "new, empty" );
# new, one shot request
    $dmarc = Mail::DMARC->new( %sample_dmarc );
    isa_ok( $dmarc, 'Mail::DMARC' );
    is_deeply( $dmarc, \%sample_dmarc, "new, one shot" );
# new, individual accessors
    $dmarc = Mail::DMARC->new();
    isa_ok( $dmarc, 'Mail::DMARC' );
    foreach my $key ( keys %sample_dmarc ) {
        next if grep {/$key/} qw/ config config_file /;
        eval { $dmarc->$key( $sample_dmarc{$key} ); }
            or diag "error running $key with $sample_dmarc{$key} arg: $@";
    };
    delete $dmarc->{config};
    is_deeply( $dmarc, \%sample_dmarc, "new, individual accessors" );
};