1 |
#!/usr/bin/perl |
2 |
# |
3 |
# File: test.pl |
4 |
# Author: James Couzens <jcouzens@codeshare.ca> (Maintainer) |
5 |
# Author: Wayne Schlitt <wayne@midwestcs.com> (Author) |
6 |
# Author: Meng Weng Wong <mengwengwong@pobox.com> (Original Author) |
7 |
# |
8 |
# Desc: |
9 |
# Originally designed to stress test any SPF implementation however |
10 |
# this particular implementation has long since been updated with any of Wayne's |
11 |
# code since he has added many "features" to his library which I disagree with. |
12 |
# We don't need features at this stage, we need stable code. Quite frankly, |
13 |
# we don't need any features, we just need what the RFC states. |
14 |
# |
15 |
# Date: 01/25/04 - based on the perl Mail-SPF-Query-1.99.tar |
16 |
# Date: 07/28/04 - Edit to use to spfqtool |
17 |
# Date: 10/07/04 - cleaned this mess up, no wonder people think perl is ugly |
18 |
# |
19 |
######################### |
20 |
|
21 |
use Test; |
22 |
use strict; |
23 |
|
24 |
use Getopt::Long; |
25 |
|
26 |
my $HELP = 0; |
27 |
my $SPFPROG = "./spfqtool_static"; |
28 |
my $SPFDATA = "test.txt"; |
29 |
my $VALGRIND = '/usr/bin/valgrind'; |
30 |
my $VG_OPTS = '--log-file=vg_test.txt --tool=memcheck --leak-check=yes --show-reachable=yes --num-callers=50 --trace-children=yes'; |
31 |
|
32 |
|
33 |
my $result = GetOptions( |
34 |
'help' => \$HELP, |
35 |
'program=s' => \$SPFPROG, |
36 |
'data=s' => \$SPFDATA, |
37 |
); |
38 |
|
39 |
if ($HELP || !$result) |
40 |
{ |
41 |
print <<EOF; |
42 |
Usage: apmiser [options] |
43 |
|
44 |
-help Help on the options. |
45 |
|
46 |
-program=/path/program Use an alternate spfqtool command. |
47 |
-data=/path/test.txt Use an alternate alternate test data |
48 |
EOF |
49 |
exit(0); |
50 |
} |
51 |
|
52 |
|
53 |
my @test_table; |
54 |
|
55 |
BEGIN |
56 |
{ |
57 |
open(TESTFILE, "test.txt"); |
58 |
|
59 |
@test_table = grep |
60 |
{ |
61 |
/\S/ and not /^\s*#/ |
62 |
} <TESTFILE>; |
63 |
|
64 |
chomp @test_table; |
65 |
close(TESTFILE); |
66 |
|
67 |
plan tests => (1 + @test_table); |
68 |
}; |
69 |
|
70 |
# 1: did the library load okay? |
71 |
ok(1); |
72 |
|
73 |
######################### |
74 |
|
75 |
foreach my $tuple (@test_table) |
76 |
{ |
77 |
my ($num, |
78 |
$domain, |
79 |
$ipv4, |
80 |
$expected_result, |
81 |
$expected_smtp_comment, |
82 |
$expected_header_comment) = $tuple =~ /\t/ ? split(/\t/, $tuple) : |
83 |
split(' ', $tuple); |
84 |
|
85 |
my ($sender, $localpolicy) = split(':', $domain, 2); |
86 |
|
87 |
$sender =~ s/\\([0-7][0-7][0-7])/chr(oct($1))/ge; |
88 |
$domain = $sender; |
89 |
|
90 |
if ($domain =~ /\@/) |
91 |
{ |
92 |
($domain) = $domain =~ /\@(.+)/ |
93 |
} |
94 |
|
95 |
if ($expected_result =~ /=(pass | fail),/) |
96 |
{ |
97 |
print "these tests are not implemented yet.\n"; |
98 |
|
99 |
for (my $debug = 0; $debug < 2; $debug++) |
100 |
{ |
101 |
last; |
102 |
|
103 |
my $query = ""; |
104 |
|
105 |
my $ok = 1; |
106 |
my $header_comment; |
107 |
|
108 |
foreach my $e_result (split(/,/, $expected_result)) |
109 |
{ |
110 |
if ($e_result !~ /=/) |
111 |
{ |
112 |
my ($msg_result, $smtp_comment); |
113 |
|
114 |
($msg_result, $smtp_comment, $header_comment) = |
115 |
eval |
116 |
{ |
117 |
$query->message_result2 |
118 |
}; |
119 |
|
120 |
# its this kind of code that makes people hate perl !@($*_#! |
121 |
$ok = ok($msg_result, $e_result) if (!$debug); |
122 |
|
123 |
if (!$ok) |
124 |
{ |
125 |
last; |
126 |
} |
127 |
} |
128 |
else |
129 |
{ |
130 |
my ($recip, $expected_recip_result) = split(/=/, $e_result, 2); |
131 |
|
132 |
my ($recip_result, $smtp_comment) = |
133 |
eval |
134 |
{ |
135 |
$query->result2(split(';',$recip)) |
136 |
}; |
137 |
|
138 |
$ok = ok($recip_result, $expected_recip_result) if (!$debug); |
139 |
|
140 |
if (!$ok) |
141 |
{ |
142 |
last; |
143 |
} |
144 |
} # else |
145 |
} # foreach |
146 |
|
147 |
$header_comment =~ s/\S+: //; # strip the reporting hostname prefix |
148 |
|
149 |
if ($expected_header_comment) |
150 |
{ |
151 |
$ok &= ok($header_comment, $expected_header_comment) if (!$debug); |
152 |
} |
153 |
|
154 |
last if ($ok); |
155 |
} # foreach |
156 |
|
157 |
} # if expected result |
158 |
else |
159 |
{ |
160 |
open(SPFQUERY, "$SPFPROG -i \"$ipv4\" -s \"$sender\" -h \"$domain\" -z 1 |"); |
161 |
|
162 |
my ($result, $smtp_comment, $header_comment); |
163 |
|
164 |
chomp($result = <SPFQUERY>); |
165 |
chomp($smtp_comment = <SPFQUERY>); |
166 |
chomp($header_comment = <SPFQUERY>); |
167 |
|
168 |
close(SPFQUERY); |
169 |
|
170 |
$header_comment =~ s/^\S+: //; # strip the reporting hostname prefix |
171 |
|
172 |
print "bin/spfqtool_static -i $ipv4 -s $sender -h $domain -z 1\n"; |
173 |
|
174 |
my $ok = (! $expected_smtp_comment |
175 |
? ok($result, $expected_result) |
176 |
: (ok($result, $expected_result) && |
177 |
ok($smtp_comment, $expected_smtp_comment) && |
178 |
ok($header_comment, $expected_header_comment))); |
179 |
|
180 |
if (not $ok) |
181 |
{ |
182 |
print "./spfqtool_static -i \"$ipv4\" -s \"$sender\" -h \"$domain\" -z 1 |\n"; |
183 |
|
184 |
printf "Result: %s\n", $result; |
185 |
printf "SMTP comment: %s\n", $smtp_comment; |
186 |
printf "Header comment: %s\n", $header_comment; |
187 |
|
188 |
open(SPFQUERY, "$SPFPROG -i \"$ipv4\" -s \"$sender\" -h \"$domain\" -z 1 |"); |
189 |
|
190 |
while(<SPFQUERY>) |
191 |
{ |
192 |
print $_; |
193 |
} |
194 |
|
195 |
close(SPFQUERY); |
196 |
|
197 |
if ($@) |
198 |
{ |
199 |
print " trapped error: $@\n"; |
200 |
next; |
201 |
} |
202 |
} # if (not $ok) |
203 |
} # else |
204 |
} # foreach |
205 |
|
206 |
# end of test.pl |