Server IP : 85.214.239.14 / Your IP : 13.59.91.59 Web Server : Apache/2.4.62 (Debian) System : Linux h2886529.stratoserver.net 4.9.0 #1 SMP Tue Jan 9 19:45:01 MSK 2024 x86_64 User : www-data ( 33) PHP Version : 7.4.18 Disable Function : pcntl_alarm,pcntl_fork,pcntl_waitpid,pcntl_wait,pcntl_wifexited,pcntl_wifstopped,pcntl_wifsignaled,pcntl_wifcontinued,pcntl_wexitstatus,pcntl_wtermsig,pcntl_wstopsig,pcntl_signal,pcntl_signal_get_handler,pcntl_signal_dispatch,pcntl_get_last_error,pcntl_strerror,pcntl_sigprocmask,pcntl_sigwaitinfo,pcntl_sigtimedwait,pcntl_exec,pcntl_getpriority,pcntl_setpriority,pcntl_async_signals,pcntl_unshare, MySQL : OFF | cURL : OFF | WGET : ON | Perl : ON | Python : ON | Sudo : ON | Pkexec : OFF Directory : /usr/share/perl5/Mail/SpamAssassin/Plugin/ |
Upload File : |
# <@LICENSE> # Licensed to the Apache Software Foundation (ASF) under one or more # contributor license agreements. See the NOTICE file distributed with # this work for additional information regarding copyright ownership. # The ASF licenses this file to you under the Apache License, Version 2.0 # (the "License"); you may not use this file except in compliance with # the License. You may obtain a copy of the License at: # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # </@LICENSE> =head1 NAME Mail::SpamAssassin::Plugin::MIMEEval - perform various tests against MIME structure and body =head1 SYNOPSIS loadplugin Mail::SpamAssassin::Plugin::MIMEEval body NAME_OF_RULE eval:check_for_mime body NAME_OF_RULE eval:check_for_mime_html body NAME_OF_RULE eval:check_for_mime_html_only body NAME_OF_RULE eval:check_mime_multipart_ratio body NAME_OF_RULE eval:check_msg_parse_flags body NAME_OF_RULE eval:check_for_ascii_text_illegal body NAME_OF_RULE eval:check_abundant_unicode_ratio body NAME_OF_RULE eval:check_for_faraway_charset body NAME_OF_RULE eval:check_for_uppercase body NAME_OF_RULE eval:check_ma_non_text body NAME_OF_RULE eval:check_base64_length body NAME_OF_RULE eval:check_qp_ratio =head1 DESCRIPTION Perform various tests against MIME structure and body. =cut package Mail::SpamAssassin::Plugin::MIMEEval; use strict; use warnings; # use bytes; use re 'taint'; use Mail::SpamAssassin::Plugin; use Mail::SpamAssassin::Locales; use Mail::SpamAssassin::Constants qw(:sa CHARSETS_LIKELY_TO_FP_AS_CAPS); use Mail::SpamAssassin::Util qw(untaint_var); use Mail::SpamAssassin::Logger; our @ISA = qw(Mail::SpamAssassin::Plugin); # constructor: register the eval rule sub new { my $class = shift; my $mailsaobject = shift; # some boilerplate... $class = ref($class) || $class; my $self = $class->SUPER::new($mailsaobject); bless ($self, $class); # the important bit! $self->register_eval_rule("check_for_mime", $Mail::SpamAssassin::Conf::TYPE_BODY_EVALS); $self->register_eval_rule("check_for_mime_html", $Mail::SpamAssassin::Conf::TYPE_BODY_EVALS); $self->register_eval_rule("check_for_mime_html_only", $Mail::SpamAssassin::Conf::TYPE_BODY_EVALS); $self->register_eval_rule("check_mime_multipart_ratio", $Mail::SpamAssassin::Conf::TYPE_BODY_EVALS); $self->register_eval_rule("check_msg_parse_flags", $Mail::SpamAssassin::Conf::TYPE_HEADER_EVALS); $self->register_eval_rule("check_for_ascii_text_illegal", $Mail::SpamAssassin::Conf::TYPE_BODY_EVALS); $self->register_eval_rule("check_abundant_unicode_ratio", $Mail::SpamAssassin::Conf::TYPE_BODY_EVALS); $self->register_eval_rule("check_for_faraway_charset", $Mail::SpamAssassin::Conf::TYPE_BODY_EVALS); $self->register_eval_rule("check_for_uppercase", $Mail::SpamAssassin::Conf::TYPE_BODY_EVALS); $self->register_eval_rule("check_ma_non_text", $Mail::SpamAssassin::Conf::TYPE_BODY_EVALS); $self->register_eval_rule("check_base64_length", $Mail::SpamAssassin::Conf::TYPE_BODY_EVALS); $self->register_eval_rule("check_qp_ratio", $Mail::SpamAssassin::Conf::TYPE_BODY_EVALS); return $self; } ########################################################################### sub are_more_high_bits_set { my ($self, $str) = @_; my $numhis = $str =~ tr/\x00-\x7F//c; # number of non-ASCII chars my $numlos = length($str) - $numhis; ($numlos <= $numhis && $numhis > 3); } =over 4 =item has_check_for_ascii_text_illegal Adds capability check for "if can()" for check_for_ascii_text_illegal =cut sub has_check_for_ascii_text_illegal { 1 } =item check_for_ascii_text_illegal If a MIME part claims to be text/plain or text/plain;charset=us-ascii and the Content-Transfer-Encoding is 7bit (either explicitly or by default), then we should enforce the actual text being only TAB, NL, SPACE through TILDE, i.e. all 7bit characters excluding NO-WS-CTL (per RFC-2822). All mainstream MTA's get this right. =cut sub check_for_ascii_text_illegal { my ($self, $pms) = @_; $self->_check_attachments($pms) unless exists $pms->{mime_checked_attachments}; return 0 unless exists $pms->{mime_ascii_text_illegal}; return ($pms->{mime_ascii_text_illegal} > 0); } =item has_check_abundant_unicode_ratio Adds capability check for "if can()" for check_abundant_unicode_ratio =cut sub has_check_abundant_unicode_ratio { 1 } =item check_abundant_unicode_ratio A MIME part claiming to be text/plain and containing Unicode characters must be encoded as quoted-printable or base64, or use UTF data coding (typically with 8bit encoding). Any message in 7bit or 8bit encoding containing (HTML) Unicode entities will not render them as Unicode, but literally. Thus a few such sequences might occur on a mailing list of developers discussing such characters, but a message with a high density of such characters is likely spam. =cut sub check_abundant_unicode_ratio { my ($self, $pms, undef, $ratio) = @_; # validate ratio? return 0 unless ($ratio =~ /^\d{0,3}\.\d{1,3}$/); $self->_check_attachments($pms) unless exists $pms->{mime_checked_attachments}; return 0 unless exists $pms->{mime_text_unicode_ratio}; return ($pms->{mime_text_unicode_ratio} >= $ratio); } sub check_for_faraway_charset { my ($self, $pms, $body) = @_; my $type = $pms->get('Content-Type',undef); my @locales = Mail::SpamAssassin::Util::get_my_locales($self->{main}->{conf}->{ok_locales}); return 0 if grep { $_ eq "all" } @locales; $type = get_charset_from_ct_line($type) if defined $type; if (defined $type && !Mail::SpamAssassin::Locales::is_charset_ok_for_locales ($type, @locales)) { # sanity check. Some charsets (e.g. koi8-r) include the ASCII # 7-bit charset as well, so make sure we actually have a high # number of 8-bit chars in the body text first. $body = join("\n", @$body); if ($self->are_more_high_bits_set ($body)) { return 1; } } 0; } =item check_for_mime Check for various MIME properties. Use in rules such as: rawbody MIME_BASE64 eval:check_for_mime('mime_base64_count') describe MIME_BASE64 Includes a base64 attachment mime_base64_count mime_base64_encoded_text mime_body_html_count mime_body_text_count mime_faraway_charset mime_missing_boundary mime_multipart_alternative mime_multipart_ratio mime_qp_count mime_qp_long_line mime_qp_ratio mime_ascii_text_illegal mime_text_unicode_ratio =cut sub check_for_mime { my ($self, $pms, undef, $test) = @_; $self->_check_attachments($pms) unless exists $pms->{mime_checked_attachments}; return 0 unless exists $pms->{$test}; return $pms->{$test} ? 1 : 0; } # any text/html MIME part sub check_for_mime_html { my ($self, $pms) = @_; my $ctype = $pms->get('Content-Type'); return 1 if $ctype =~ m{^text/html}i; $self->_check_attachments($pms) unless exists $pms->{mime_checked_attachments}; return 0 unless exists $pms->{mime_body_html_count}; return ($pms->{mime_body_html_count} > 0); } =item check_for_mime_html_only Check for messages containing only text/html body parts =cut sub check_for_mime_html_only { my ($self, $pms) = @_; my $ctype = $pms->get('Content-Type'); return 1 if $ctype =~ m{^text/html}i; $self->_check_attachments($pms) unless exists $pms->{mime_checked_attachments}; return 0 unless exists $pms->{mime_body_html_count}; return 0 unless exists $pms->{mime_body_text_count}; return ($pms->{mime_body_html_count} > 0 && $pms->{mime_body_text_count} == 0); } sub check_mime_multipart_ratio { my ($self, $pms, undef, $min, $max) = @_; $self->_check_attachments($pms) unless exists $pms->{mime_checked_attachments}; return 0 unless exists $pms->{mime_multipart_ratio}; return ($pms->{mime_multipart_ratio} >= $min && $pms->{mime_multipart_ratio} < $max); } sub _check_mime_header { my ($self, $pms, $ctype, $cte, $cd, $charset, $name) = @_; $charset ||= ''; if ($ctype eq 'text/html') { $pms->{mime_body_html_count}++; } elsif ($ctype =~ m@^text@i) { $pms->{mime_body_text_count}++; } if (index($cte, 'base64') >= 0) { $pms->{mime_base64_count}++; } elsif (index($cte, 'quoted-printable') >= 0) { $pms->{mime_qp_count}++; } if ($cd && index($cd, 'attachment') >= 0) { $pms->{mime_attachment}++; } if ($ctype =~ /^text/ && index($cte, 'base64') >= 0 && (!$charset || $charset =~ /(?:us-ascii|ansi_x3\.4-1968|iso-ir-6|ansi_x3\.4-1986|iso_646\.irv:1991|ascii|iso646-us|us|ibm367|cp367|csascii)/) && !($cd && $cd =~ /^(?:attachment|inline)/)) { $pms->{mime_base64_encoded_text} = 1; } if ($charset =~ /iso-\S+-\S+\b/i && $charset !~ /iso-(?:8859-\d{1,2}|2022-(?:jp|kr))\b/) { $pms->{mime_bad_iso_charset} = 1; } # MIME_BASE64_LATIN: now a zero-hitter # if (!$name && # $cte =~ /base64/ && # $charset =~ /\b(?:us-ascii|iso-8859-(?:[12349]|1[0345])|windows-(?:125[0247]))\b/) # { # $pms->{mime_base64_latin} = 1; # } # MIME_QP_NO_CHARSET: now a zero-hitter # if ($cte =~ /quoted-printable/ && $cd =~ /inline/ && !$charset) { # $pms->{mime_qp_inline_no_charset} = 1; # } # MIME_HTML_NO_CHARSET: now a zero-hitter # if ($ctype eq 'text/html' && # !(defined($charset) && $charset) && # !($cd && $cd =~ /^(?:attachment|inline)/)) # { # $pms->{mime_html_no_charset} = 1; # } if ($charset =~ /[a-z]/i) { if (defined $pms->{mime_html_charsets}) { $pms->{mime_html_charsets} .= " ".$charset; } else { $pms->{mime_html_charsets} = $charset; } if (! $pms->{mime_faraway_charset}) { my @l = Mail::SpamAssassin::Util::get_my_locales($self->{main}->{conf}->{ok_locales}); if (!(grep { $_ eq "all" } @l) && !Mail::SpamAssassin::Locales::is_charset_ok_for_locales($charset, @l)) { dbg ("mimeeval: $charset is not ok for @l"); $pms->{mime_faraway_charset} = 1; } } } } sub _check_attachments { my ($self, $pms) = @_; # MIME status my $where = -1; # -1 = start, 0 = nowhere, 1 = header, 2 = body my $qp_bytes = 0; # total bytes in QP regions my $qp_count = 0; # QP-encoded bytes in QP regions my @part_bytes; # MIME part total bytes my @part_type; # MIME part types my $normal_chars = 0; # MIME text bytes that aren't encoded my $unicode_chars = 0; # MIME text bytes that are unicode entities # MIME header information my $part = -1; # MIME part index # indicate the scan has taken place $pms->{mime_checked_attachments} = 1; # results # $pms->{mime_base64_blanks} = 0; # expensive to determine, no longer avail $pms->{mime_base64_count} = 0; $pms->{mime_base64_encoded_text} = 0; # $pms->{mime_base64_illegal} = 0; # $pms->{mime_base64_latin} = 0; $pms->{mime_body_html_count} = 0; $pms->{mime_body_text_count} = 0; $pms->{mime_faraway_charset} = 0; # $pms->{mime_html_no_charset} = 0; $pms->{mime_missing_boundary} = 0; $pms->{mime_multipart_alternative} = 0; $pms->{mime_multipart_ratio} = 1.0; $pms->{mime_qp_count} = 0; # $pms->{mime_qp_illegal} = 0; # $pms->{mime_qp_inline_no_charset} = 0; $pms->{mime_qp_long_line} = 0; $pms->{mime_qp_ratio} = 0; $pms->{mime_ascii_text_illegal} = 0; $pms->{mime_text_unicode_ratio} = 0; # Get all parts ... foreach my $p ($pms->{msg}->find_parts(qr/./)) { # message headers my ($ctype, $boundary, $charset, $name) = Mail::SpamAssassin::Util::parse_content_type($p->get_header("content-type")); if ($ctype eq 'multipart/alternative') { $pms->{mime_multipart_alternative} = 1; } my $cte = $p->get_header('Content-Transfer-Encoding') || ''; chomp($cte = defined($cte) ? lc $cte : ""); my $cd = $p->get_header('Content-Disposition') || ''; chomp($cd = defined($cd) ? lc $cd : ""); $charset = lc $charset if ($charset); $name = lc $name if ($name); $self->_check_mime_header($pms, $ctype, $cte, $cd, $charset, $name); # If we're not in a leaf node in the tree, there will be no raw # section, so skip it. if (! $p->is_leaf()) { next; } $part++; $part_type[$part] = $ctype; $part_bytes[$part] = 0 if index($cd, 'attachment') == -1; my $cte_is_base64 = index($cte, 'base64') >= 0; my $previous = ''; foreach (@{$p->raw()}) { # if ($cte_is_base64) { # if ($previous =~ /^\s*$/ && /^\s*$/) { # expensive, avoid! # $pms->{mime_base64_blanks} = 1; # never used, don't bother # } # # MIME_BASE64_ILLEGAL: now a zero-hitter # # if (m@[^A-Za-z0-9+/=\n]@ || /=[^=\s]/) { # # $pms->{mime_base64_illegal} = 1; # # } # } # if ($pms->{mime_html_no_charset} && $ctype eq 'text/html' && defined $charset) { # $pms->{mime_html_no_charset} = 0; # } if ($pms->{mime_multipart_alternative} && index($cd, 'attachment') == -1 && ($ctype eq 'text/plain' || $ctype eq 'text/html')) { $part_bytes[$part] += length; } if ($where != 1 && $cte eq "quoted-printable" && index($_, 'SPAM: ') != 0) { # RFC 5322: Each line SHOULD be no more than 78 characters, # excluding the CRLF. # RFC 2045: The Quoted-Printable encoding REQUIRES that # encoded lines be no more than 76 characters long. # Bug 5491: 6% of email classified as HAM by SA triggered the # MIME_QP_LONG_LINE rule. Apple Mail can generate a QP-line # that is 2 chars too long. Same goes for Outlook Web Access. # lines include one trailing \n character # if (length > 76+1) { # conforms to RFC 5322 and RFC 2045 if (length > 78+1) { # conforms to RFC 5322 only, not RFC 2045 $pms->{mime_qp_long_line} = 1; } $qp_bytes += length; # MIME_QP_DEFICIENT: zero-hitter now # check for illegal substrings (RFC 2045), hexadecimal values 7F-FF and # control characters other than TAB, or CR and LF as parts of CRLF pairs # if (!$pms->{mime_qp_illegal} && /[\x00-\x08\x0b\x0c\x0e-\x1f\x7f-\xff]/) # { # $pms->{mime_qp_illegal} = 1; # } # count excessive QP bytes if (index($_, '=') >= 0) { ## no critic (Perlsecret) # whoever wrote this next line is an evil hacker -- jm my $qp = () = m/=(?:09|3[0-9ABCEF]|[2456][0-9A-F]|7[0-9A-E])/g; ## use critic if ($qp) { $qp_count += $qp; # tabs and spaces at end of encoded line are okay. Also, multiple # whitespace at the end of a line are OK, like ">=20=20=20=20=20=20". my ($trailing) = m/((?:=09|=20)+)\s*$/g; if ($trailing) { $qp_count -= (length($trailing) / 3); } } } } # if our charset is ASCII, this should only contain 7-bit characters # except NUL or a free-standing CR. anything else is a violation of # the definition of charset="us-ascii". if ($ctype eq 'text/plain' && (!defined $charset || $charset eq 'us-ascii')) { # no re "strict"; # since perl 5.21.8: Ranges of ASCII printables... if (m/[\x00\x0d\x80-\xff]+/) { if (would_log('dbg', 'eval')) { my $str = $_; $str =~ s/([\x00\x0d\x80-\xff]+)/'<' . unpack('H*', $1) . '>'/eg; dbg("check: ascii_text_illegal: matches " . $str . "\n"); } $pms->{mime_ascii_text_illegal}++; } } # if we're text/plain, we should never see unicode escapes in this # format, especially not for 7bit or 8bit. if ($ctype eq 'text/plain' && ($cte eq '' || $cte eq '7bit' || $cte eq '8bit')) { my ($text, $subs) = $_; $subs = $text =~ s/&#x[0-9A-F]{4};//g; $normal_chars += length($text); $unicode_chars += $subs; if ($subs && would_log('dbg', 'eval')) { my $str = $_; $str = substr($str, 0, 512) . '...' if (length($str) > 512); dbg("check: abundant_unicode: " . $str . " (" . $subs . ")\n"); } } $previous = $_; } } if ($qp_bytes) { $pms->{mime_qp_ratio} = $qp_count / $qp_bytes; $pms->{mime_qp_count} = $qp_count; $pms->{mime_qp_bytes} = $qp_bytes; } if ($normal_chars) { $pms->{mime_text_unicode_ratio} = $unicode_chars / $normal_chars; } if ($pms->{mime_multipart_alternative}) { my $text; my $html; # bug 4207: we want the size of the last parts for (my $i = $part; $i >= 0; $i--) { next if !defined $part_bytes[$i]; if (!defined($html) && $part_type[$i] eq 'text/html') { $html = $part_bytes[$i]; } elsif (!defined($text) && $part_type[$i] eq 'text/plain') { $text = $part_bytes[$i]; } last if (defined($html) && defined($text)); } if (defined($text) && defined($html) && $html > 0) { $pms->{mime_multipart_ratio} = ($text / $html); } } # Look to see if any multipart boundaries are not "balanced" foreach my $val (values %{$pms->{msg}->{mime_boundary_state}}) { if ($val != 0) { $pms->{mime_missing_boundary} = 1; last; } } } =item has_check_qp_ratio Adds capability check for "if can()" for check_qp_ratio =cut sub has_check_qp_ratio { 1 } =item check_qp_ratio Takes a min ratio to use in eval to see if there is an spamminess to the ratio of quoted printable to total bytes in an email. =back =cut sub check_qp_ratio { my ($self, $pms, undef, $min) = @_; $self->_check_attachments($pms) unless exists $pms->{mime_checked_attachments}; return 0 unless exists $pms->{mime_qp_ratio}; my $qp_ratio = $pms->{mime_qp_ratio}; dbg("eval: qp_ratio - %s - check for min of %s", $qp_ratio, $min); return (defined $qp_ratio && $qp_ratio >= $min) ? 1 : 0; } sub check_msg_parse_flags { my($self, $pms, $type, $type2) = @_; $type = $type2 if ref($type); return defined $pms->{msg}->{$type}; } sub check_for_uppercase { my ($self, $pms, $body, $min, $max) = @_; local ($_); if (exists $pms->{uppercase}) { return ($pms->{uppercase} > $min && $pms->{uppercase} <= $max); } if ($self->body_charset_is_likely_to_fp($pms)) { $pms->{uppercase} = 0; return 0; } # Dec 20 2002 jm: trade off some speed for low memory footprint, by # iterating over the array computing sums, instead of joining the # array into a giant string and working from that. my $len = 0; my $lower = 0; my $upper = 0; foreach (@{$body}) { # examine lines in the body that have an intermediate space next unless /\S\s+\S/; # strip out lingering base64 (currently possible for forwarded messages) next if /^(?:[A-Za-z0-9+\/=]{60,76} ){2}/; my $line = $_; # copy so we don't muck up the original # remove shift-JIS charset codes $line =~ s/\x1b\$B.*\x1b\(B//gs; $len += length($line); # count numerals as lower case, otherwise 'date|mail' is spam $lower += ($line =~ tr/a-z0-9//d); $upper += ($line =~ tr/A-Z//); } # report only on mails above a minimum size; otherwise one # or two acronyms can throw it off if ($len < 200) { $pms->{uppercase} = 0; return 0; } if (($upper + $lower) == 0) { $pms->{uppercase} = 0; } else { $pms->{uppercase} = ($upper / ($upper + $lower)) * 100; } return ($pms->{uppercase} > $min && $pms->{uppercase} <= $max); } sub body_charset_is_likely_to_fp { my ($self, $pms) = @_; # check for charsets where this test will FP -- iso-2022-jp, gb2312, # koi8-r etc. # $self->_check_attachments($pms) unless exists $pms->{mime_checked_attachments}; my @charsets; my $type = $pms->get('Content-Type',undef); $type = get_charset_from_ct_line($type) if defined $type; push (@charsets, $type) if defined $type; if (defined $pms->{mime_html_charsets}) { push (@charsets, split(' ', $pms->{mime_html_charsets})); } my $CHARSETS_LIKELY_TO_FP_AS_CAPS = CHARSETS_LIKELY_TO_FP_AS_CAPS; foreach my $charset (@charsets) { if ($charset =~ /^${CHARSETS_LIKELY_TO_FP_AS_CAPS}$/) { return 1; } } return 0; } sub get_charset_from_ct_line { my $type = shift; if (!defined $type) { return; } if ($type =~ /charset="([^"]+)"/i) { return $1; } if ($type =~ /charset='([^']+)'/i) { return $1; } if ($type =~ /charset=(\S+)/i) { return $1; } return; } # came up on the users@ list, look for multipart/alternative parts which # include non-text parts -- skip certain types which occur normally in ham sub check_ma_non_text { my($self, $pms) = @_; foreach my $map ($pms->{msg}->find_parts(qr@^multipart/alternative$@)) { foreach my $p ($map->find_parts(qr/./, 1, 0)) { next if (lc $p->{'type'} eq 'multipart/related'); next if (lc $p->{'type'} eq 'application/rtf'); next if ($p->{'type'} =~ m@^text/@i); return 1; } } return 0; } sub check_base64_length { my $self = shift; my $pms = shift; shift; # body array, unnecessary my $min = shift; my $max = shift; if (!defined $pms->{base64_length}) { $pms->{base64_length} = $self->_check_base64_length($pms->{msg}); } return 0 if (defined $max && $pms->{base64_length} > $max); return $pms->{base64_length} >= $min; } sub _check_base64_length { my $self = shift; my $msg = shift; my $result = 0; foreach my $p ($msg->find_parts(qr@.@, 1)) { my $ctype= Mail::SpamAssassin::Util::parse_content_type($p->get_header('content-type')); # FPs from Google Calendar invites, etc. # perhaps just limit to test, and image? next if ($ctype eq 'application/ics'); my $cte = lc($p->get_header('content-transfer-encoding') || ''); next if ($cte !~ /^base64$/); foreach my $l ( @{$p->raw()} ) { $result = length $l if length $l > $result; } } return $result; } 1;