Update Archive-Extract to cpan version 0.38
Chris Williams [Sat, 9 Jan 2010 09:37:30 +0000 (09:37 +0000)]
  Changes for 0.38    Wed Jan  6 23:48:52 2010
  ============================================
  * Apply a patch from Michael G Schwern RT #53246
    extract() is vulnerable to print globals.

Porting/Maintainers.pl
cpan/Archive-Extract/lib/Archive/Extract.pm
cpan/Archive-Extract/t/01_Archive-Extract.t

index 5237d3a..fdde7f3 100755 (executable)
@@ -186,7 +186,7 @@ use File::Glob qw(:case);
     'Archive::Extract' =>
        {
        'MAINTAINER'    => 'kane',
-       'DISTRIBUTION'  => 'BINGOS/Archive-Extract-0.36.tar.gz',
+       'DISTRIBUTION'  => 'BINGOS/Archive-Extract-0.38.tar.gz',
        'FILES'         => q[cpan/Archive-Extract],
        'CPAN'          => 1,
        'UPSTREAM'      => 'cpan',
index 5baa79e..08676fb 100644 (file)
@@ -41,7 +41,7 @@ use vars qw[$VERSION $PREFER_BIN $PROGRAMS $WARN $DEBUG
             $_ALLOW_BIN $_ALLOW_PURE_PERL $_ALLOW_TAR_ITER
          ];
 
-$VERSION            = '0.36';
+$VERSION            = '0.38';
 $PREFER_BIN         = 0;
 $WARN               = 1;
 $DEBUG              = 0;
@@ -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;
index 52decf6..93c9026 100644 (file)
@@ -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]],