Skip Menu |
 

This queue is for tickets about the libwww-perl CPAN distribution.

Report information
The Basics
Id: 40187
Status: resolved
Priority: 0/
Queue: libwww-perl

People
Owner: Nobody in particular
Requestors: cpan-070814 [...] bilteks.com
Cc:
AdminCc:

Bug Information
Severity: Critical
Broken in:
  • 5.815
  • 5.816
  • 5.817
  • 5.818
Fixed in: (no value)



Subject: URGENT! https problem starting from 5.816
Date: Mon, 20 Oct 2008 11:48:56 +0300
To: bug-libwww-perl [...] rt.cpan.org
From: "Alexander Kirpa" <cpan-070814 [...] bilteks.com>
Download (untitled) / with headers
text/plain 753b
Hi All! Last working edition 5.814 Perl 5.8.8/5.10.0 FreeBSD i386 5.3/7.0 Problem: data corruption (lost some characters) during processing https respond Workaround: downgrade libwww editions 5.818-5.816 to 5.814 edition. Test commands: lwp-download "https://rt.cpan.org/Public/Dist/Display.html?Name=libwww-perl" https- rt-cpan lwp-download "http://rt.cpan.org/Public/Dist/Display.html?Name=libwww- perl" http-rt-cpan Results for edition 5.814: -rw-r--r-- 1 root wheel 36441 Oct 20 11:32 http-rt-cpan -rw-r--r-- 1 root wheel 36441 Oct 20 11:32 https-rt-cpan Results for edition 5.818: -rw-r--r-- 1 root wheel 36441 Oct 20 11:33 http-rt-cpan -rw-r--r-- 1 root wheel 16746 Oct 20 11:33 https-rt-cpan Best regards, Alexander Kirpa
Download (untitled) / with headers
text/plain 214b
This was indeed an ugly one, but it's not really tied to https at all, but to memory allocation patterns. I've now applied the attached patch and uploaded 5.819 with this fix to CPAN. Thanks for catching this!
Download rt-40187.patch
text/x-diff 3.4k
commit af111a4327d4dfc4750e022c1a20adc803a75fbf Author: Gisle Aas <gisle@aas.no> Date: Mon Oct 20 13:14:48 2008 +0200 Wrong content handlers would sometimes be skipped [RT#40187] The handler filtering in LWP::Protocol::collect depends on stable handler hashes, but we did not provide that for handlers associated directly with the response object. The result was that handlers was skipped randomly based on memory allocation patterns. diff --git a/lib/LWP/Protocol.pm b/lib/LWP/Protocol.pm index b4ec93a..792e9a6 100644 --- a/lib/LWP/Protocol.pm +++ b/lib/LWP/Protocol.pm @@ -103,19 +103,25 @@ sub collect elsif (!ref($arg) && length($arg)) { open(my $fh, ">", $arg) || die "Can't write to '$arg': $!"; binmode($fh); - push(@{$response->{handlers}{response_data}}, sub { - print $fh $_[3] || die "Can't write to '$arg': $!"; - 1; - }); - push(@{$response->{handlers}{response_done}}, sub { - close($fh) || die "Can't write to '$arg': $!"; - undef($fh); + push(@{$response->{handlers}{response_data}}, { + callback => sub { + print $fh $_[3] || die "Can't write to '$arg': $!"; + 1; + }, }); + push(@{$response->{handlers}{response_done}}, { + callback => sub { + close($fh) || die "Can't write to '$arg': $!"; + undef($fh); + }, + }); } elsif (ref($arg) eq 'CODE') { - push(@{$response->{handlers}{response_data}}, sub { - &$arg($_[3], $_[0], $self); - 1; + push(@{$response->{handlers}{response_data}}, { + callback => sub { + &$arg($_[3], $_[0], $self); + 1; + }, }); } else { @@ -125,10 +131,12 @@ sub collect $ua->run_handlers("response_header", $response); if (delete $response->{default_add_content}) { - push(@{$response->{handlers}{response_data}}, sub { - $_[0]->add_content($_[3]); - 1; - }); + push(@{$response->{handlers}{response_data}}, { + callback => sub { + $_[0]->add_content($_[3]); + 1; + }, + }); } diff --git a/lib/LWP/UserAgent.pm b/lib/LWP/UserAgent.pm index 5fb3982..1ac12eb 100644 --- a/lib/LWP/UserAgent.pm +++ b/lib/LWP/UserAgent.pm @@ -618,10 +618,12 @@ sub parse_head { $parser->xml_mode(1) if $response->content_is_xhtml; $parser->utf8_mode(1) if $] >= 5.008 && $HTML::Parser::VERSION >= 3.40; - push(@{$response->{handlers}{response_data}}, sub { - return unless $parser; - $parser->parse($_[3]) or undef($parser); - }); + push(@{$response->{handlers}{response_data}}, { + callback => sub { + return unless $parser; + $parser->parse($_[3]) or undef($parser); + }, + }); } : undef, m_media_type => "html", @@ -770,7 +772,7 @@ sub handlers { my($self, $phase, $o) = @_; my @h; if ($o->{handlers} && $o->{handlers}{$phase}) { - push(@h, map +{ callback => $_ }, @{$o->{handlers}{$phase}}); + push(@h, @{$o->{handlers}{$phase}}); } if (my $conf = $self->{handlers}{$phase}) { push(@h, $conf->matching($o));


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.