patch-src__3.4.5-multi-casesensitive-headers-check.patch by Victor Ustugov diff -urN ../Mail-SpamAssassin-3.4.5.orig/lib/Mail/SpamAssassin/Conf/Parser.pm ./lib/Mail/SpamAssassin/Conf/Parser.pm --- ../Mail-SpamAssassin-3.4.5.orig/lib/Mail/SpamAssassin/Conf/Parser.pm 2021-03-20 12:04:32.000000000 +0200 +++ ./lib/Mail/SpamAssassin/Conf/Parser.pm 2021-03-29 20:18:27.610277000 +0300 @@ -1255,7 +1255,8 @@ $conf->{test_opt_exists}->{$name} = 1; } else { # $hdr used in eval text, validate carefully - if ($text !~ /^([\w.-]+(?:\:|(?:\:[a-z]+){1,2})?)\s*([=!]~)\s*(.+)$/) { +# if ($text !~ /^([\w.-]+(?:\:|(?:\:[a-z]+){1,2})?)\s*([=!]~)\s*(.+)$/) { + if ($text !~ /^([\w.-]+(?:\:|(?:\:[a-z]+){1,2})?(?:\|[\w.-]+(?:\:|(?:\:[a-z]+){1,2})?)*)\s*([=!]~)\s*(.+)$/) { $self->lint_warn("config: invalid head test $name: $text"); return; } diff -urN ../Mail-SpamAssassin-3.4.5.orig/lib/Mail/SpamAssassin/Message/Node.pm ./lib/Mail/SpamAssassin/Message/Node.pm --- ../Mail-SpamAssassin-3.4.5.orig/lib/Mail/SpamAssassin/Message/Node.pm 2021-03-20 12:04:32.000000000 +0200 +++ ./lib/Mail/SpamAssassin/Message/Node.pm 2021-03-29 20:15:29.397566000 +0300 @@ -66,6 +66,8 @@ my $self = { headers => {}, raw_headers => {}, + headers_case => {}, + raw_headers_case => {}, header_order => [] }; @@ -163,13 +165,13 @@ return unless defined $rawkey; + # Trim whitespace off of the header keys + $rawkey =~ s/^\s+//; + $rawkey =~ s/\s+$//; + # we're going to do things case insensitively my $key = lc($rawkey); - # Trim whitespace off of the header keys - $key =~ s/^\s+//; - $key =~ s/\s+$//; - if (@_) { my $raw_value = shift; return unless defined $raw_value; @@ -188,6 +190,13 @@ push @{ $self->{'raw_headers'}->{$key} }, $raw_value; + if ( !exists $self->{'headers_case'}->{$rawkey} ) { + $self->{'headers_case'}->{$rawkey} = []; + $self->{'raw_headers_case'}->{$rawkey} = []; + } + push @{ $self->{'headers_case'}->{$rawkey} }, _decode_header($dec_value,$key); + push @{ $self->{'raw_headers_case'}->{$rawkey} }, $raw_value; + return $self->{'headers'}->{$key}->[-1]; } @@ -201,6 +210,24 @@ } } +sub header_case { + my $self = shift; + my $key = shift; + + # Trim whitespace off of the header keys + $key =~ s/^\s+//; + $key =~ s/\s+$//; + + if (wantarray) { + return unless exists $self->{'headers_case'}->{$key}; + return @{ $self->{'headers_case'}->{$key} }; + } + else { + return '' unless exists $self->{'headers_case'}->{$key}; + return $self->{'headers_case'}->{$key}->[-1]; + } +} + =item raw_header() Retrieves the raw version of headers from a specific MIME part. The only @@ -236,6 +263,24 @@ } } +sub raw_header_case { + my $self = shift; + my $key = shift; + + # Trim whitespace off of the header keys + $key =~ s/^\s+//; + $key =~ s/\s+$//; + + if (wantarray) { + return unless exists $self->{'raw_headers_case'}->{$key}; + return @{ $self->{'raw_headers_case'}->{$key} }; + } + else { + return '' unless exists $self->{'raw_headers_case'}->{$key}; + return $self->{'raw_headers_case'}->{$key}->[-1]; + } +} + =item add_body_part() Adds a Node child object to the current node object. @@ -844,6 +889,8 @@ foreach ( grep(/^${hdr}$/i, keys %{$self->{'headers'}}) ) { delete $self->{'headers'}->{$_}; delete $self->{'raw_headers'}->{$_}; + delete $self->{'headers_case'}->{$_}; + delete $self->{'raw_headers_case'}->{$_}; } my @neworder = grep(!/^${hdr}$/i, @{$self->{'header_order'}}); @@ -951,6 +998,35 @@ } else { if (@hdrs = $self->header($hdr)) { + $_ .= "\n" for @hdrs; + } + } + + if (wantarray) { + return @hdrs; + } + else { + return @hdrs ? $hdrs[-1] : undef; + } +} + +sub get_header_case { + my ($self, $hdr, $raw) = @_; + $raw ||= 0; + + # And now pick up all the entries into a list + # This is assumed to include a newline at the end ... + # This is also assumed to have removed continuation bits ... + + # Deal with the possibility that header() or raw_header() returns undef + my @hdrs; + if ( $raw ) { + if (@hdrs = $self->raw_header_case($hdr)) { + s/\015?\012\s+/ /gs for @hdrs; + } + } + else { + if (@hdrs = $self->header_case($hdr)) { $_ .= "\n" for @hdrs; } } diff -urN ../Mail-SpamAssassin-3.4.5.orig/lib/Mail/SpamAssassin/PerMsgStatus.pm ./lib/Mail/SpamAssassin/PerMsgStatus.pm --- ../Mail-SpamAssassin-3.4.5.orig/lib/Mail/SpamAssassin/PerMsgStatus.pm 2021-03-20 12:04:32.000000000 +0200 +++ ./lib/Mail/SpamAssassin/PerMsgStatus.pm 2021-03-29 20:15:29.398811000 +0300 @@ -1983,10 +1983,26 @@ sub _get { my ($self, $request) = @_; + if ($request =~ /\|/) { + my($res); + foreach my $subrequest (split(/\|/, $request)) { + my $getcase = ($subrequest =~ s/:case//); + my $getraw = ($subrequest eq 'ALL' || $subrequest =~ s/:raw$//); + if ($getcase) { + $res .= '|'.join ("\n", $self->{msg}->get_header_case($subrequest, $getraw)); + } else { + $res .= '|'.join ("\n", $self->{msg}->get_header($subrequest, $getraw)); + } + } + $res =~ s/^\|//; + return($res); + } + my $result; my $getaddr = 0; my $getname = 0; my $getraw = 0; + my $getcase = 0; # special queries - process and strip modifiers if (index($request,':') >= 0) { # triage @@ -1995,6 +2011,7 @@ if ($1 eq 'raw') { $getraw = 1 } elsif ($1 eq 'addr') { $getaddr = $getraw = 1 } elsif ($1 eq 'name') { $getname = 1 } + elsif ($1 eq 'case') { $getcase = 1 } } } my $request_lc = lc $request; @@ -2074,8 +2091,18 @@ } # a conventional header else { - my @results = $getraw ? $self->{msg}->raw_header($request) - : $self->{msg}->get_header($request); +# my @results = $getraw ? $self->{msg}->raw_header($request) +# : $self->{msg}->get_header($request); + my(@results); + if ($getcase and $getraw) { + @results = $self->{msg}->raw_header_case($request); + } elsif ($getcase and !$getraw) { + @results = $self->{msg}->get_header_case($request); + } elsif (!$getcase and $getraw) { + @results = $self->{msg}->raw_header($request); + } elsif (!$getcase and !$getraw) { + @results = $self->{msg}->get_header($request); + } # dbg("message: get(%s)%s = %s", # $request, $getraw?'raw':'', join(", ",@results)); if (@results) {