Subject: | Archive::Extract does not fail gracefully when trying to overwrite a read-only file on Windows |
Date: | Mon, 22 Apr 2013 15:48:34 -0400 (EDT) |
To: | bug-Archive-Extract [...] rt.cpan.org |
From: | "Keith Laten Williams (Laten Technical Services)" <klwilliams [...] netscape.net> |
Dear Author:
I noticed a problem when trying to trap an error condition in a zip file extraction. If a directory contains a read-only file and Archive::Extract is trying to write to that file (overwrite it) it crashes instead of raising an exception. I wrote a short script to
illustrate this issue. This script is presented below. This was noted on Perl distribution "ActivePerl 5.14.2 Build 1402" on Windows Vista (Home Edition). The Archive::Extract version used was 0.58.
The script below should have failed gracefully, but instead, gave the following messages:
C:\Users\Keith\development\bu\RCS>perl archive_extract_bug.pl
Set up gcc environment - 3.4.5 (mingw-vista special r3)
IO error: Can't open file C:\Users\Keith\development\bu\RCS\abc.txt for write : Permission d
enied
at archive_extract_bug.pl line 38
Extraction of 'abc.txt' from 'C:\Users\Keith\development\bu\RCS\abc.zip' failed at archive_e
xtract_bug.pl line 38
The error reported was: Extraction of 'abc.txt' from 'C:\Users\Keith\development\bu\RCS\abc.
zip' failed
Here is the script I used to recreate the problem:
use strict;
use warnings;
use utf8;
use Archive::Zip;
use Archive::Extract;
makeAFile("abc.txt");
zipTheFile("abc.zip", "abc.txt");
setTheFileReadOnly("abc.txt");
# Now demonstrate the bug
my $zip = Archive::Extract->new( archive => "abc.zip" );
# I believe the next line should cause the "Grateful failure"
# to appear in standard output
my $ok = $zip->extract || die "Graceful failure\n";
# Even if that does not happen, the following line should
# report an error and the script should exit with a zero
# error code
print "The error reported was: " . $zip->error() . "\n";
exit 0;
sub makeAFile {
my $fileToMake = shift;
open(FH, ">", $fileToMake);
print FH "abc\n";
close FH;
}
sub zipTheFile {
my($zipFile, $mbrFile) = @_;
my $zip = Archive::Zip->new();
my $mbr = $zip->addFile( $mbrFile );
$zip->writeToFileNamed( $zipFile );
}
sub setTheFileReadOnly {
my $fileToSet = shift;
chmod( 0444, $fileToSet );
}
Hope this helps,
Keith Laten Williams,
Laten Technical Services
helping technology keep its promises
(847) 208-3321
klwilliams@netscape.net