| Subject: | [PATCH] handle ../ directory name on VMS |
Generally speaking A::T uses splitpath and splitdir on native paths and reassembles the pieces
using the Unix-specific concatenation routines to keep the result in Unix syntax. That
approach works fine with one exception (well, one I've found). When one of the directory
components is the double-dot directory rather than an actual directory name, splitdir returns
this as the VMS-native '-' (minus sign) rather than '..' and that does not produce a valid path
when pasted back onto the rest of the components.
The attached patch handles the above case in Arhive::Tar::File::_prefix_and_file and a related
problem with double dots in Archive::Tar::_extract_file. That allows the remaining TODO tests
in 04_resolved_issues.t to pass on VMS and also fixes a failure I'm currently seeing with
Archive::Extract in blead.
| Subject: | at_vms.patch |
--- lib/Archive/Tar.pm;-0 Wed Oct 1 11:54:30 2008
+++ lib/Archive/Tar.pm Fri Oct 3 16:58:50 2008
@@ -690,9 +690,9 @@ sub _extract_file {
}
- ### '.' is the directory delimiter, of which the first one has to
- ### be escaped/changed.
- map tr/\./_/, @dirs if ON_VMS;
+ ### '.' is the directory delimiter, so make it an underscore
+ ### except for the special case of C<../>.
+ map $_ ne '..' && tr/\./_/, @dirs if ON_VMS;
my ($cwd_vol,$cwd_dir,$cwd_file)
= File::Spec->splitpath( $cwd );
--- lib/Archive/Tar/File.pm;-0 Wed Oct 1 11:54:30 2008
+++ lib/Archive/Tar/File.pm Sun Oct 5 14:04:07 2008
@@ -393,6 +393,9 @@ sub _prefix_and_file {
### if it's a directory, then $file might be empty
$file = pop @dirs if $self->is_dir and not length $file;
+ ### splitting ../ gives you the relative path in native syntax
+ map { $_ = '..' if $_ eq '-' } @dirs if ON_VMS;
+
my $prefix = File::Spec::Unix->catdir(
grep { length } $vol, @dirs
);
--- t/04_resolved_issues.t;-0 Fri Sep 19 16:04:10 2008
+++ t/04_resolved_issues.t Sun Oct 5 11:36:54 2008
@@ -113,7 +113,7 @@ use_ok( $FileClass );
### absolute paths are already taken care of. Only relative paths
### matter
my $in_file = basename($0);
- my $out_file = '../' . $in_file . ".$$";
+ my $out_file = '../' . $in_file . "_$$";
ok( $tar->add_files( $in_file ),
" Added '$in_file'" );
@@ -121,7 +121,6 @@ use_ok( $FileClass );
" Renamed to '$out_file'" );
### first, test with strict extract permissions on
-TODO:
{ local $Archive::Tar::INSECURE_EXTRACT_MODE = 0;
### we quell the error on STDERR
@@ -136,19 +135,14 @@ TODO:
ok( $tar->error, " Error message stored" );
- local $TODO = 'Exposed unrelated filespec handling bugs on VMS' if $^O eq 'VMS';
-
like( $tar->error, qr/attempting to leave/,
" Proper violation detected" );
}
### now disable those
-TODO:
{ local $Archive::Tar::INSECURE_EXTRACT_MODE = 1;
ok( 1, " Extracting in insecure mode" );
- local $TODO = 'Exposed unrelated filespec handling bugs on VMS' if $^O eq 'VMS';
-
ok( $tar->extract_file( $out_file ),
" File extracted" );
ok( -e $out_file, " File '$out_file' exists" );