"Fossies" - the Fresh Open Source Software Archive

Member "libspf2-1.2.10/perl/t/20_rfc4408.t" (28 Jan 2012, 2205 Bytes) of package /linux/privat/libspf2-1.2.10.tar.gz:

    1 use strict;
    2 use warnings;
    3 use Test::More;
    4 eval "use Mail::SPF::Test";
    5 plan skip_all => "Mail::SPF::Test required for testing SPF code" if $@;
    6 use String::Escape qw(unquote);
    7 
    8 use Mail::SPF_XS qw(:all);
    9 
   10 my $suite = new_from_yaml_file Mail::SPF::Test('t/rfc4408-tests.yml');
   11 
   12 my $tests = 0;
   13 $tests += scalar($_->test_cases) * 2 foreach $suite->scenarios;
   14 plan tests => $tests;
   15 
   16 my $casename = undef;
   17 # $casename = 'alltimeout';
   18 # $casename = 'multispf2';
   19 $casename = 'nospace2';
   20 
   21 foreach my $scenario ($suite->scenarios) {
   22 	if ($casename) {
   23 		my $found = undef;
   24 		foreach my $case ($scenario->test_cases) {
   25 			$found = 1 if $case->name eq $casename;
   26 		}
   27 		next unless $found;
   28 	}
   29 
   30 	my $server = new Mail::SPF_XS::Server({
   31 		dnstype	=> SPF_DNS_ZONE,
   32 		debug	=> 4,
   33 	});
   34 	# $server->resolver->add('test.com', ns_t_a, NETDB_SUCCESS, '127.0.0.8');
   35 
   36 	for my $record ($scenario->records) {
   37 		print "Adding record " . $record->string . "\n";
   38 		my $type = $record->type;
   39 		# $type = 'TXT' if $type eq 'SPF';
   40 		# TRY_AGAIN if it's a timeout
   41 		$server->resolver->add($record->name,
   42 				Net::DNS::typesbyname($type),
   43 				NETDB_SUCCESS,
   44 				unquote($record->rdatastr));
   45 	}
   46 
   47 	foreach my $case ($scenario->test_cases) {
   48 		if ($casename) {
   49 			next unless $case->name eq $casename;
   50 		}
   51 		print "Test case ", $case->name, "\n";
   52 
   53 		# use Data::Dumper;
   54 		# print Dumper([ $scenario->records ]);
   55 
   56 		my $request = Mail::SPF_XS::Request->new({
   57 			scope           => $case->scope,
   58 			identity        => $case->identity,
   59 			ip_address      => $case->ip_address,
   60 			helo_identity   => $case->helo_identity
   61 		});
   62 
   63 		print "Request is " . $request->string, "\n";
   64 
   65 		my $response = $server->process($request);
   66 
   67 		print "Response is " . $response->string, "\n";
   68 
   69 		my $ok = $case->is_expected_result($response->code);
   70 		diag(
   71 			$case->name . " result:\n" .
   72 			"Expected: " .  join(' or ', map("'$_'", $case->expected_results)) . "\n" .
   73 			" Got: " . $response->code)
   74 				if not $ok;
   75 		ok($ok);
   76 
   77 #		$ok = $case->expected_explanation eq $response->explanation;
   78 #		diag(
   79 #			$case->name . " explanation:\n" .
   80 #			"Expected: " .  $case->expected_explanation . "\n" .
   81 #			" Got: " . $response->explanation)
   82 #				if not $ok;
   83 #		ok($ok);
   84 	}
   85 }