| Subject: | extract() is vulnerable to print globals (with patch) |
I finally tracked down mysterious corruption of my files to Archive::Extract. I use -l a lot which sets $\ the output record separator. Archive::Extract uses unguarded prints so this causes newlines to appear in extracted files.
The attached patch adds a safe print method which guards against the things which might effect print and uses them in the places where print is being used to output extracted data.
In the course of trying to test this I noticed flipping on $\ and friends in the tests had no effect. Looking into it further, it appears the test files in t/src all contain empty files. Is this correct? That doesn't exercise the code well.
The attached patch adds a safe print method which guards against the things which might effect print and uses them in the places where print is being used to output extracted data.
In the course of trying to test this I noticed flipping on $\ and friends in the tests had no effect. Looking into it further, it appears the test files in t/src all contain empty files. Is this correct? That doesn't exercise the code well.
| Subject: | 0001-Defend-against-print-globals-like-effecting-extracti.patch |
From d273a91b842fe6724f5fb37d70b2fe115e8f5bfe Mon Sep 17 00:00:00 2001
From: Michael G. Schwern <schwern@pobox.com>
Date: Wed, 30 Dec 2009 20:32:29 -0800
Subject: [PATCH] Defend against print globals like $\ effecting extraction.
---
lib/Archive/Extract.pm | 21 +++++++++++++++------
t/01_Archive-Extract.t | 5 +++++
2 files changed, 20 insertions(+), 6 deletions(-)
diff --git a/lib/Archive/Extract.pm b/lib/Archive/Extract.pm
index 5baa79e..e75bb2a 100644
--- a/lib/Archive/Extract.pm
+++ b/lib/Archive/Extract.pm
@@ -899,7 +899,7 @@ sub _gunzip_bin {
$self->_error( $self->_no_buffer_content( $self->archive ) );
}
- print $fh $buffer if defined $buffer;
+ $self->_print($fh, $buffer) if defined $buffer;
close $fh;
@@ -929,7 +929,7 @@ sub _gunzip_cz {
$self->_gunzip_to, $! ));
my $buffer;
- $fh->print($buffer) while $gz->gzread($buffer) > 0;
+ $self->_print($fh, $buffer) while $gz->gzread($buffer) > 0;
$fh->close;
### set what files where extract, and where they went ###
@@ -974,7 +974,7 @@ sub _uncompress_bin {
$self->_error( $self->_no_buffer_content( $self->archive ) );
}
- print $fh $buffer if defined $buffer;
+ $self->_print($fh, $buffer) if defined $buffer;
close $fh;
@@ -1190,7 +1190,7 @@ sub _bunzip2_bin {
$self->_error( $self->_no_buffer_content( $self->archive ) );
}
- print $fh $buffer if defined $buffer;
+ $self->_print($fh, $buffer) if defined $buffer;
close $fh;
@@ -1292,7 +1292,7 @@ sub _unlzma_bin {
$self->_error( $self->_no_buffer_content( $self->archive ) );
}
- print $fh $buffer if defined $buffer;
+ $self->_print($fh, $buffer) if defined $buffer;
close $fh;
@@ -1324,7 +1324,7 @@ sub _unlzma_cz {
$self->archive, $@));
}
- print $fh $buffer if defined $buffer;
+ $self->_print($fh, $buffer) if defined $buffer;
close $fh;
@@ -1341,6 +1341,15 @@ sub _unlzma_cz {
#
#################################
+# For printing binaries that avoids interfering globals
+sub _print {
+ my $self = shift;
+ my $fh = shift;
+
+ local( $\, $", $, ) = ( undef, ' ', '' );
+ return print $fh @_;
+}
+
sub _error {
my $self = shift;
my $error = shift;
diff --git a/t/01_Archive-Extract.t b/t/01_Archive-Extract.t
index 52decf6..93c9026 100644
--- a/t/01_Archive-Extract.t
+++ b/t/01_Archive-Extract.t
@@ -65,6 +65,11 @@ $Archive::Extract::WARN = $Archive::Extract::WARN = $Debug;
diag( "\n\n*** DEBUG INFORMATION ENABLED ***\n\n" ) if $Debug;
+# Be as evil as possible to print
+$\ = "ORS_FLAG";
+$, = "OFS_FLAG";
+$" = "LISTSEP_FLAG";
+
my $tmpl = {
### plain files
'x.bz2' => { programs => [qw[bunzip2]],
--
1.6.5.3