Skip Menu |

This queue is for tickets about the Archive-Extract CPAN distribution.

Report information
The Basics
Id: 84791
Status: new
Priority: 0/
Queue: Archive-Extract

People
Owner: Nobody in particular
Requestors: klwilliams [...] netscape.net
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: (no value)



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