Bug #77902 for Mail-DKIM: DKIM signature computation very long on large messages

Show quoted text
This is not the case in a normal situation, the stored buffer should not be growing. Each call to PRINT should process whatever it can in the buffer and leave there only the last unterminated line - a leftover to be processed with the next call. Your situation can only arise if you are feeding chunks of a huge line, piece by piece. Seems the problem here is that the application forgot to convert newlines to CRLF pairs, so that a whole message looks to Mail::DKIM as one huge line, and calls to PRINT could not process anything (no full line so far) until a CLOSE, so could only keep collecting the text. Show quoted text
This is also wrong: whatever leftover remains in $self->{buf} should stay there for the next call, which should concatenate the leftover with newly supplied arguments. Nevertheless I do agree that the PRINT subroutine performs some unnecessary copying. Avoiding this could save a little bit of resources. I did some benchmarking and I'll attach a replacement MessageParser.pm, which accesses the buffer indirectly through a ref, avoiding copying or accessing it through a hash. If an application passes a message in large chunks to PRINT the speedup is very small, while an application that does so inefficiently by calling PRINT line-by-line can see some improvement in speed.

#!/usr/bin/perl # Copyright 2005 Messiah College. All rights reserved. # Jason Long <jlong@messiah.edu> # Copyright (c) 2004 Anthony D. Urso. All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. use strict; use warnings; package Mail::DKIM::MessageParser; use Carp; sub new_object { my $class = shift; return $class->TIEHANDLE(@_); } sub new_handle { my $class = shift; local *TMP; tie *TMP, $class, @_; return *TMP; } sub TIEHANDLE { my $class = shift; my %args = @_; my $self = bless \%args, $class; $self->init; return $self; } sub init { my $self = shift; my $buf = ""; $self->{buf_ref} = \$buf; $self->{in_header} = 1; } sub PRINT { my $self = shift; my $buf_ref = $self->{buf_ref}; $$buf_ref .= @_ == 1 ? $_[0] : join("", @_) if @_; if ($self->{in_header}) { local $1; # avoid polluting a global $1 while ($$buf_ref ne '') { if (substr($$buf_ref,0,2) eq "\015\012") { substr($$buf_ref, 0, 2) = ''; $self->finish_header(); $self->{in_header} = 0; last; } if ($$buf_ref !~ /^(.+?\015\012)[^\ \t]/s) { last; } my $header = $1; $self->add_header($header); substr($$buf_ref, 0, length($header)) = ''; } } if (!$self->{in_header}) { my $j = rindex($$buf_ref,"\015\012"); if ($j >= 0) { $self->add_body(substr($$buf_ref, 0, $j+2)); substr($$buf_ref, 0, $j+2) = ''; } } return 1; } sub CLOSE { my $self = shift; my $buf_ref = $self->{buf_ref}; if ($self->{in_header}) { if ($$buf_ref ne '') { # A line of header text ending CRLF would not have been # processed yet since before we couldn't tell if it was # the complete header. Now that we're in CLOSE, we can # finish the header... $$buf_ref =~ s/\015\012\z//s; $self->add_header("$$buf_ref\015\012"); } $self->finish_header; $self->{in_header} = 0; } else { if ($$buf_ref ne '') { $self->add_body($$buf_ref); } } $$buf_ref = ""; $self->finish_body; return 1; } sub add_header { die "add_header not implemented"; } sub finish_header { die "finish_header not implemented"; } sub add_body { die "add_body not implemented"; } sub finish_body { # do nothing by default } sub reset { carp "reset not implemented"; } 1;

While at it... Here is a refinement of my previous attachment, this time in a form of a patch. In addition to what the previous code did, this one also avoids one more copying of a buffer, shaving off another millisecond or two (out of 50 ms) on larger mail (3 MB) with larger buffers (32 kB or 64 kB).

--- lib/Mail/DKIM/MessageParser.pm~ 2008-08-26 00:10:56.000000000 +0200 +++ lib/Mail/DKIM/MessageParser.pm 2012-11-07 19:30:01.127433685 +0100 @@ -41,6 +41,7 @@ my $self = shift; + my $buf = ''; + $self->{buf_ref} = \$buf; $self->{in_header} = 1; - $self->{buf} = ""; } @@ -48,18 +49,19 @@ { my $self = shift; - my $buf = $self->{buf}; - $buf .= @_ == 1 ? $_[0] : join("", @_) if @_; + my $buf_ref = $self->{buf_ref}; + $$buf_ref .= @_ == 1 ? $_[0] : join("", @_) if @_; if ($self->{in_header}) { - while (length $buf) + local $1; # avoid polluting a global $1 + while ($$buf_ref ne '') { - if (substr($buf,0,2) eq "\015\012") + if (substr($$buf_ref,0,2) eq "\015\012") { - $buf = substr($buf, 2); + substr($$buf_ref, 0, 2) = ''; $self->finish_header(); $self->{in_header} = 0; last; } - if ($buf !~ /^(.+?\015\012)[^\ \t]/s) + if ($$buf_ref !~ /^(.+?\015\012)[^\ \t]/s) { last; @@ -67,17 +69,21 @@ my $header = $1; $self->add_header($header); - $buf = substr($buf, length($header)); + substr($$buf_ref, 0, length($header)) = ''; } } if (!$self->{in_header}) { - my $j = rindex($buf,"\015\012"); + my $j = rindex($$buf_ref,"\015\012"); if ($j >= 0) { - $self->add_body(substr($buf, 0, $j+2)); - substr($buf, 0, $j+2) = ''; + # avoid copying a large buffer: the unterminated + # last line is typically short compared to the rest + + my $carry = substr($$buf_ref, $j+2); + substr($$buf_ref, $j+2) = ''; # shrink to last CRLF + $self->add_body($$buf_ref); # must end on CRLF + $$buf_ref = $carry; # restore unterminated last line } } - $self->{buf} = $buf; return 1; } @@ -86,9 +92,9 @@ { my $self = shift; - my $buf = $self->{buf}; + my $buf_ref = $self->{buf_ref}; if ($self->{in_header}) { - if (length $buf) + if ($$buf_ref ne '') { # A line of header text ending CRLF would not have been @@ -96,6 +102,6 @@ # the complete header. Now that we're in CLOSE, we can # finish the header... - $buf =~ s/\015\012$//s; - $self->add_header("$buf\015\012"); + $$buf_ref =~ s/\015\012\z//s; + $self->add_header("$$buf_ref\015\012"); } $self->finish_header; @@ -104,10 +110,10 @@ else { - if (length $buf) + if ($$buf_ref ne '') { - $self->add_body($buf); + $self->add_body($$buf_ref); } } - $self->{buf} = ""; + $$buf_ref = ''; $self->finish_body; return 1;