In some situations LWP::UserAgent::mirror gives a bad error message in
the form "Transfer truncated: only out of ... bytes received". This
seems to happen if something calls die() while in the request callback.
This only sets X-Died, but nothing checks for this value. My attached
patch changes this to check X-Died, and if it is set, to die with that
value, which gives better error messages.
The second attached file is a test script which should work under Unix
systems (probably does not work under Windows) and shows the behavior
with and without the patch.
(The test script also reveals the problem that mirror() expects that the
directory containing the output file is writable. Maybe a workaround
could be to write to a temporary file under /tmp (or whatever File::Temp
uses), but unfortunately a rename() would not be anymore atomic if /tmp
is on another partition then the output file)
Regards,
Slaven
| Subject: | mirror_permissions.pl |
#!/usr/bin/perl
#
use strict;
use warnings;
use Test::More tests => 3;
use File::Temp qw(tempdir);
use LWP::UserAgent;
my $srcdir = tempdir(CLEANUP => 1);
my $destdir = tempdir(CLEANUP => 1);
open my $ofh, ">", "$srcdir/test" or die $!;
print $ofh "Test\n";
close $ofh;
utime 0, 0, "$srcdir/test";
my $ua = LWP::UserAgent->new;
{
my $resp = $ua->mirror("file://$srcdir", "$destdir/test");
ok($resp->is_success);
}
utime 0, 0, "$destdir/test";
utime time, time, "$srcdir/test";
chmod 0500, $destdir;
{
my $resp = eval { $ua->mirror("file://$srcdir", "$destdir/test") };
my $err = $@;
ok(!$resp);
like($err, qr{Can't write to});
}
__END__
| Subject: | LWP-mirror-permissions.patch |
From 5b220a82fb48a41d6c3dc327f7f8ce54600aceb4 Mon Sep 17 00:00:00 2001
From: Slaven Rezic <slaven@rezic.de>
Date: Mon, 27 Jul 2009 15:09:05 +0200
Subject: [PATCH] mirror should die in case X-Died is set
---
lib/LWP/UserAgent.pm | 3 +++
1 files changed, 3 insertions(+), 0 deletions(-)
diff --git a/lib/LWP/UserAgent.pm b/lib/LWP/UserAgent.pm
index d932085..3d1aecf 100644
--- a/lib/LWP/UserAgent.pm
+++ b/lib/LWP/UserAgent.pm
@@ -834,6 +834,9 @@ sub mirror
my $tmpfile = "$file-$$";
my $response = $self->request($request, $tmpfile);
+ if ( $response->header('X-Died') ) {
+ die $response->header('X-Died');
+ }
# Only fetching a fresh copy of the would be considered success.
# If the file was not modified, "304" would returned, which
--
1.6.3.3