MSIMERSON / Mail-DMARC-0.20130521 / 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
118
119

              
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" );
}