src/spfqtool/test.pl

#!/usr/bin/perl
#
#  File: test.pl
#  Author: James Couzens <jcouzens@codeshare.ca> (Maintainer)
#  Author: Wayne Schlitt <wayne@midwestcs.com> (Author)
#  Author: Meng Weng Wong <mengwengwong@pobox.com> (Original Author)
#  
#  Desc:  
#          Originally designed to stress test any SPF implementation however
#  this particular implementation has long since been updated with any of Wayne's
#  code since he has added many "features" to his library which I disagree with.
#  We don't need features at this stage, we need stable code.  Quite frankly,
#  we don't need any features, we just need what the RFC states.
#
# Date: 01/25/04  - based on the perl Mail-SPF-Query-1.99.tar
# Date: 07/28/04  - Edit to use to spfqtool
# Date: 10/07/04  - cleaned this mess up, no wonder people think perl is ugly
#
#########################

use Test;
use strict;

use Getopt::Long;

my $HELP     = 0;
my $SPFPROG  = "./spfqtool_static";
my $SPFDATA  = "test.txt";
my $VALGRIND = '/usr/bin/valgrind';
my $VG_OPTS  = '--log-file=vg_test.txt --tool=memcheck --leak-check=yes --show-reachable=yes --num-callers=50 --trace-children=yes';


my $result = GetOptions(
  'help'      => \$HELP,
  'program=s' => \$SPFPROG,
  'data=s'    => \$SPFDATA,
);

if ($HELP  || !$result)
{
  print <<EOF;
Usage: apmiser [options]

      -help     Help on the options.

      -program=/path/program  Use an alternate spfqtool command.
      -data=/path/test.txt    Use an alternate alternate test data
EOF
  exit(0);
}


my @test_table;

BEGIN
{
  open(TESTFILE, "test.txt");

  @test_table = grep
                {
                  /\S/ and not /^\s*#/
                } <TESTFILE>;

  chomp @test_table;
  close(TESTFILE);

  plan tests => (1 + @test_table);
};

# 1: did the library load okay?
ok(1);

#########################

foreach my $tuple (@test_table)
{
  my ($num,
      $domain,
      $ipv4,
      $expected_result,
      $expected_smtp_comment,
      $expected_header_comment) = $tuple =~ /\t/ ? split(/\t/, $tuple) :
                                                    split(' ', $tuple);

  my ($sender, $localpolicy) = split(':', $domain, 2);

  $sender =~ s/\\([0-7][0-7][0-7])/chr(oct($1))/ge;
  $domain = $sender;

  if ($domain =~ /\@/)
  {
    ($domain) = $domain =~ /\@(.+)/
  }

  if ($expected_result =~ /=(pass | fail),/)
  {
    print "these tests are not implemented yet.\n";

    for (my $debug = 0; $debug < 2; $debug++)
    {
      last;

      my $query = "";

      my $ok = 1;
      my $header_comment;

      foreach my $e_result (split(/,/, $expected_result))
      {
        if ($e_result !~ /=/)
        {
          my ($msg_result, $smtp_comment);

          ($msg_result, $smtp_comment, $header_comment) =
            eval
            {
              $query->message_result2
            };

          # its this kind of code that makes people hate perl !@($*_#!
          $ok = ok($msg_result, $e_result) if (!$debug);

          if (!$ok)
          {
            last;
          }
        }
        else
        {
          my ($recip, $expected_recip_result) = split(/=/, $e_result, 2);

          my ($recip_result, $smtp_comment) =
            eval
            {
              $query->result2(split(';',$recip))
            };

            $ok = ok($recip_result, $expected_recip_result) if (!$debug);

            if (!$ok)
            {
              last;
            }
        } # else
      } # foreach

      $header_comment =~ s/\S+: //; # strip the reporting hostname prefix

      if ($expected_header_comment)
      {
          $ok &= ok($header_comment, $expected_header_comment) if (!$debug);
      }

      last if ($ok);
    } # foreach
    
  } # if expected result
  else
  {
    open(SPFQUERY, "$SPFPROG -i \"$ipv4\" -s \"$sender\" -h \"$domain\" -z 1 |");

    my ($result, $smtp_comment, $header_comment);

    chomp($result         = <SPFQUERY>);
    chomp($smtp_comment   = <SPFQUERY>);
    chomp($header_comment = <SPFQUERY>);

    close(SPFQUERY);

    $header_comment =~ s/^\S+: //; # strip the reporting hostname prefix

    print "bin/spfqtool_static -i $ipv4 -s $sender -h $domain -z 1\n";

    my $ok = (! $expected_smtp_comment
              ?  ok($result, $expected_result)
              : (ok($result, $expected_result) &&
                 ok($smtp_comment, $expected_smtp_comment) &&
                 ok($header_comment, $expected_header_comment)));

    if (not $ok)
    {
       print "./spfqtool_static -i \"$ipv4\" -s \"$sender\" -h \"$domain\" -z 1 |\n";

       printf "Result:         %s\n", $result;
       printf "SMTP comment:   %s\n", $smtp_comment;
       printf "Header comment: %s\n", $header_comment;

       open(SPFQUERY, "$SPFPROG -i \"$ipv4\" -s \"$sender\" -h \"$domain\" -z 1 |");

       while(<SPFQUERY>)
       {
         print $_;
       }

      close(SPFQUERY);

      if ($@)
      {
        print "  trapped error: $@\n";
        next;
      }
    } # if (not $ok)
  } # else
} # foreach

# end of test.pl
Revision:	1.1
Committed:	Tue Nov 13 00:51:36 2007 UTC (18 years, 10 months ago) by root
Content type:	text/plain
Branch:	MAIN
CVS Tags:	HEAD
Log Message:	initial import of libspf-1.0.0-p5 from freebsd ports
#	User	Rev	Content
1	root	1.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