| #!/usr/bin/perl -w -T |
| |
| # test URIs with UTF8 IDNA-equivalent dots between domains instead of ordinary '.' |
| |
| BEGIN { |
| if (-e 't/test_dir') { # if we are running "t/rule_names.t", kluge around ... |
| chdir 't'; |
| } |
| |
| if (-e 'test_dir') { # running from test directory, not .. |
| unshift(@INC, '../blib/lib'); |
| } |
| } |
| |
| my $prefix = '.'; |
| if (-e 'test_dir') { # running from test directory, not .. |
| $prefix = '..'; |
| } |
| |
| use strict; |
| use lib '.'; use lib 't'; |
| use SATest; sa_t_init("body_str.t"); |
| use Test::More tests => 12; |
| use Mail::SpamAssassin; |
| |
| my $header = <<'EOH'; |
| Message-ID: <clean.1010101@example.com> |
| Date: Mon, 07 Oct 2002 09:00:00 +0000 |
| From: Sender <sender@example.com> |
| MIME-Version: 1.0 |
| To: Recipient <recipient@example.com> |
| Subject: SUBJECT X |
| Content-Type: text/plain; charset="UTF-8" |
| Content-Transfer-Encoding: 8bit |
| |
| EOH |
| |
| sub write_mail { |
| my $body = shift; |
| return $header.$body; |
| } |
| |
| sub run_sa { |
| my $message = write_mail(shift); |
| my $scansize = shift; |
| my $rawbody_re = shift; |
| my $body_re = shift; |
| |
| # initialize SpamAssassin |
| my $sa = create_saobj({ |
| dont_copy_prefs => 1, |
| config_text => " |
| dns_available no |
| use_auto_whitelist 0 |
| use_bayes 0 |
| util_rb_tld com |
| rawbody_part_scan_size $scansize |
| body_part_scan_size $scansize |
| ", |
| }); |
| $sa->init(0); # parse rules |
| |
| my $mail = $sa->parse($message); |
| my $pms = Mail::SpamAssassin::PerMsgStatus->new($sa, $mail); |
| |
| my $rawbody = join("", @{$pms->get_decoded_body_text_array()}); |
| my $body = join("", @{$pms->get_decoded_stripped_body_text_array()}); |
| |
| my $body_part_scan_size = $pms->{main}->{conf}->{body_part_scan_size}; |
| my $rawbody_part_scan_size = $pms->{main}->{conf}->{rawbody_part_scan_size}; |
| |
| $pms->finish(); |
| $mail->finish(); |
| $sa->finish(); |
| |
| my $rawbody_str = $rawbody; |
| my $body_str = $body; |
| $rawbody_str =~ s/\n/\\n/s; |
| $rawbody_str =~ s/([^ [:graph:]])/sprintf("\\x%s",unpack("H*",$1))/ge; |
| $body_str =~ s/\n/\\n/s; |
| $body_str =~ s/([^ [:graph:]])/sprintf("\\x%s",unpack("H*",$1))/ge; |
| |
| if ($rawbody_part_scan_size != $scansize || |
| $body_part_scan_size != $scansize) { |
| print STDERR "FAIL: scan_size mismatch!\n"; |
| return 0; |
| } |
| |
| if ($rawbody !~ /$rawbody_re/) { |
| print STDERR "FAIL: rawbody mismatch: <BEGIN>$rawbody_str<END>\n"; |
| return 0; |
| } |
| |
| if ($body !~ /$body_re/) { |
| print STDERR "FAIL: body mismatch: <BEGIN>$body_str<END>\n"; |
| return 0; |
| } |
| |
| return 1; |
| } |
| |
| ok(run_sa( |
| "FIRST LAST", |
| 0, |
| qr/^FIRST LAST\z/, |
| qr/^SUBJECT X\nFIRST LAST\z/ |
| )); |
| |
| ok(run_sa( |
| "<html><body><p>FIRST LAST</p></body></html>", |
| 0, |
| qr!^<html><body><p>FIRST LAST</p></body></html>\z!, |
| qr!^SUBJECT X\n<html><body><p>FIRST LAST</p></body></html>\z! |
| )); |
| |
| ok(run_sa( |
| "<html><body><p>FIRST X<p><p>LAST</p></body></html>", |
| 0, |
| qr!^<html><body><p>FIRST X<p><p>LAST</p></body></html>\z!, |
| qr!^SUBJECT X\n<html><body><p>FIRST X<p><p>LAST</p></body></html>\z! |
| )); |
| |
| ok(run_sa( |
| "FIRST LAST", |
| 9, |
| qr/^FIRST LAS\z/, |
| qr/^SUBJECT X\nFIRST LAS\z/ |
| )); |
| |
| ok(run_sa( |
| "FIRST XYZ\nLAST", |
| 10, |
| qr/^FIRST XYZ\n\z/, |
| qr/^SUBJECT X\nFIRST XYZ \z/ |
| )); |
| |
| ok(run_sa( |
| "FIRST LAST", |
| 11, |
| qr/^FIRST LAST\z/, |
| qr/^SUBJECT X\nFIRST LAST\z/ |
| )); |
| |
| ok(run_sa( |
| "<html><body><p>FIRST LAST</p></body></html>", |
| 11, |
| qr/^<html><body>\z/, |
| qr/^SUBJECT X\n<html><body><p>FIRST \z/ |
| )); |
| |
| ok(run_sa( |
| "FIRST XYZ BA R\nLAST", |
| 11, |
| qr/^FIRST XYZ BA R\n\z/, |
| qr/^SUBJECT X\nFIRST XYZ BA R \z/ |
| )); |
| |
| ok(run_sa( |
| "FIRST" . "X" x 1000 . "LAST", |
| 11, |
| qr/^FIRSTXXXXXX\z/, |
| qr/^SUBJECT X\nFIRSTXXXXXX\z/ |
| )); |
| |
| ok(run_sa( |
| "FIRST" . "X" x 3000 . "LAST", |
| 11, |
| qr/^FIRSTXXXXXX\z/, |
| qr/^SUBJECT X\nFIRSTXXXXXX\z/ |
| )); |
| |
| # Is legal because 1-2k extra is allowed while |
| # searching for boundary |
| ok(run_sa( |
| "FIRST" . "X" x 1000 . "\nLAST", |
| 11, |
| qr/^FIRSTX{1000}\n\z/, |
| qr/^SUBJECT X\nFIRSTX{1000} \z/ |
| )); |
| |
| ok(run_sa( |
| "FIRST" . "X" x 3000 . "\nLAST", |
| 11, |
| qr/^FIRSTXXXXXX\z/, |
| qr/^SUBJECT X\nFIRSTXXXXXX\z/ |
| )); |
| |
