The attached patch file_path_pm.gdiff handles a special case of a
filename named "." on VMS that is not a directory. If rmtree() is
called on a directory with this present, it causes an infinite recursion.
As failed Perl tests on VMS tend to leave a file named "." behind as a
result of a file conversion error, a special case is set up to remove it.
It looks like this could be done more efficiently by moving the common
code into a subroutine, but this gets the the immediate problem fixed.
The longer patch file file_path_pm_ws.gdiff is one that has the patch
and converts the tabs to spaces while retaining the correct indenting,
and also fixes a few indenting issues.
-John
[EMAIL PROTECTED]
Personal Opinion Only
--- /rsync_root/perl/lib/File/Path.pm Thu Jun 28 00:46:16 2007
+++ lib/File/Path.pm Wed Aug 29 20:12:51 2007
@@ -570,6 +570,57 @@
closedir $d;
}
+ if ($Is_VMS && ($files[0] eq '.' )) {
+ # If '.' is present on VMS, it means that the file '.;'
+ # is present, not the directory.
+ # This will need to be changed if the VMS C library
+ # in UNIX report mode starts returning '.' for the
+ # current directory.
+
+ # The file '.;' must be handled as a special case as it
+ # can only be accessed in VMS syntax.
+
+ # Force the path to VMS syntax as it could be in UNIX syntax.
+ my $vms_root = VMS::Filespec::vmspath($root);
+
+ # Get rid of '.' from the list
+ shift @files;
+
+ my $vms_file = File::Spec->catfile($vms_root,'.;');
+
+ print "unlink $vms_file\n" if $arg->{verbose};
+ # delete all versions under VMS
+ for (;;) {
+ if (unlink $vms_file) {
+ push @{${$arg->{result}}}, $vms_file if $arg->{result};
+ }
+ else {
+ if ($arg->{error}) {
+ push @{${$arg->{error}}},
+ {$vms_file => "unlink: $!"};
+ }
+ else {
+ _carp ("Can't unlink file $vms_file: $!");
+ }
+ if ($Force_Writeable) {
+ if (!chmod $rp, $vms_file) {
+ my $mask = sprintf("0%o",$rp);
+ if ($arg->{error}) {
+ push @{${$arg->{error}}},
+ {$vms_file => "restore chmod: $!"};
+ }
+ else {
+ _carp
+ ("and can't restore permissions to
$mask\n");
+ }
+ }
+ last;
+ }
+ ++$count;
+ last unless $Is_VMS && lstat $vms_file;
+ }
+ }
+ }
# Deleting large numbers of files from VMS Files-11 filesystems
# is faster if done in reverse ASCIIbetical order
@files = reverse @files if $Is_VMS;
--- /rsync_root/perl/lib/File/Path.pm Thu Jun 28 00:46:16 2007
+++ lib/File/Path.pm Wed Aug 29 20:12:51 2007
@@ -381,7 +381,7 @@
# These OSes complain if you want to remove a file that you have no
# write permission to:
my $Force_Writeable = ($^O eq 'os2' || $^O eq 'dos' || $^O eq 'MSWin32' ||
- $^O eq 'amigaos' || $^O eq 'MacOS' || $^O eq 'epoc');
+ $^O eq 'amigaos' || $^O eq 'MacOS' || $^O eq 'epoc');
sub _carp {
require Carp;
@@ -436,26 +436,26 @@
my(@created,$path);
foreach $path (@$paths) {
next unless length($path);
- $path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT
- # Logic wants Unix paths, so go with the flow.
- if ($Is_VMS) {
- next if $path eq '/';
- $path = VMS::Filespec::unixify($path);
- }
- next if -d $path;
- my $parent = File::Basename::dirname($path);
- unless (-d $parent or $path eq $parent) {
+ $path .= '/' if $^O eq 'os2' and $path =~ /^\w:\z/s; # feature of CRT
+ # Logic wants Unix paths, so go with the flow.
+ if ($Is_VMS) {
+ next if $path eq '/';
+ $path = VMS::Filespec::unixify($path);
+ }
+ next if -d $path;
+ my $parent = File::Basename::dirname($path);
+ unless (-d $parent or $path eq $parent) {
push(@created,_mkpath($arg, [$parent]));
}
print "mkdir $path\n" if $arg->{verbose};
if (mkdir($path,$arg->{mode})) {
push(@created, $path);
- }
+ }
else {
my $save_bang = $!;
my ($e, $e1) = ($save_bang, $^E);
- $e .= "; $e1" if $e ne $e1;
- # allow for another process to have created it meanwhile
+ $e .= "; $e1" if $e ne $e1;
+ # allow for another process to have created it meanwhile
if (!-d $path) {
$! = $save_bang;
if ($arg->{error}) {
@@ -464,8 +464,8 @@
else {
_croak("mkdir $path: $e");
}
- }
- }
+ }
+ }
}
return @created;
}
@@ -518,20 +518,20 @@
my($count) = 0;
my (@files, $root);
foreach $root (@$paths) {
- if ($Is_MacOS) {
- $root = ":$root" if $root !~ /:/;
+ if ($Is_MacOS) {
+ $root = ":$root" if $root !~ /:/;
$root =~ s/([^:])\z/$1:/;
}
else {
- $root =~ s#/\z##;
- }
+ $root =~ s#/\z##;
+ }
my $rp = (lstat $root)[2] or next;
- $rp &= 07777; # don't forget setuid, setgid, sticky bits
- if ( -d _ ) {
- # notabene: 0700 is for making readable in the first place,
- # it's also intended to change it to writable in case we have
- # to recurse in which case we are better than rm -rf for
- # subtrees with strange permissions
+ $rp &= 07777; # don't forget setuid, setgid, sticky bits
+ if ( -d _ ) {
+ # notabene: 0700 is for making readable in the first place,
+ # it's also intended to change it to writable in case we have
+ # to recurse in which case we are better than rm -rf for
+ # subtrees with strange permissions
if (!chmod($rp | 0700,
($Is_VMS ? VMS::Filespec::fileify($root) : $root))
) {
@@ -558,25 +558,76 @@
@files = ();
}
else {
- no strict 'refs';
- if (!defined ${"\cTAINT"} or ${"\cTAINT"}) {
+ no strict 'refs';
+ if (!defined ${"\cTAINT"} or ${"\cTAINT"}) {
# Blindly untaint dir names if taint mode is
# active, or any perl < 5.006
@files = map { /\A(.*)\z/s; $1 } readdir $d;
}
else {
- @files = readdir $d;
- }
- closedir $d;
- }
-
- # Deleting large numbers of files from VMS Files-11 filesystems
- # is faster if done in reverse ASCIIbetical order
- @files = reverse @files if $Is_VMS;
- ($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS;
- if ($Is_MacOS) {
- @files = map("$root$_", @files);
- }
+ @files = readdir $d;
+ }
+ closedir $d;
+ }
+
+ if ($Is_VMS && ($files[0] eq '.' )) {
+ # If '.' is present on VMS, it means that the file '.;'
+ # is present, not the directory.
+ # This will need to be changed if the VMS C library
+ # in UNIX report mode starts returning '.' for the
+ # current directory.
+
+ # The file '.;' must be handled as a special case as it
+ # can only be accessed in VMS syntax.
+
+ # Force the path to VMS syntax as it could be in UNIX syntax.
+ my $vms_root = VMS::Filespec::vmspath($root);
+
+ # Get rid of '.' from the list
+ shift @files;
+
+ my $vms_file = File::Spec->catfile($vms_root,'.;');
+
+ print "unlink $vms_file\n" if $arg->{verbose};
+ # delete all versions under VMS
+ for (;;) {
+ if (unlink $vms_file) {
+ push @{${$arg->{result}}}, $vms_file if $arg->{result};
+ }
+ else {
+ if ($arg->{error}) {
+ push @{${$arg->{error}}},
+ {$vms_file => "unlink: $!"};
+ }
+ else {
+ _carp ("Can't unlink file $vms_file: $!");
+ }
+ if ($Force_Writeable) {
+ if (!chmod $rp, $vms_file) {
+ my $mask = sprintf("0%o",$rp);
+ if ($arg->{error}) {
+ push @{${$arg->{error}}},
+ {$vms_file => "restore chmod: $!"};
+ }
+ else {
+ _carp
+ ("and can't restore permissions to
$mask\n");
+ }
+ }
+ last;
+ }
+ ++$count;
+ last unless $Is_VMS && lstat $vms_file;
+ }
+ }
+ }
+ # Deleting large numbers of files from VMS Files-11 filesystems
+ # is faster if done in reverse ASCIIbetical order
+ @files = reverse @files if $Is_VMS;
+ ($root = VMS::Filespec::unixify($root)) =~ s#\.dir\z## if $Is_VMS;
+ if ($Is_MacOS) {
+ @files = map("$root$_", @files);
+ }
else {
my $updir = File::Spec->updir();
my $curdir = File::Spec->curdir();
@@ -590,10 +641,10 @@
$arg->{depth}--;
if ($arg->{depth} or !$arg->{keep_root}) {
if ($arg->{safe} &&
- ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
+ ($Is_VMS ? !&VMS::Filespec::candelete($root) : !-w $root)) {
print "skipped $root\n" if $arg->{verbose};
- next;
- }
+ next;
+ }
if (!chmod $rp | 0700, $root) {
if ($Force_Writeable) {
if ($arg->{error}) {
@@ -606,25 +657,25 @@
}
}
print "rmdir $root\n" if $arg->{verbose};
- if (rmdir $root) {
+ if (rmdir $root) {
push @{${$arg->{result}}}, $root if $arg->{result};
- ++$count;
- }
- else {
+ ++$count;
+ }
+ else {
if ($arg->{error}) {
push @{${$arg->{error}}}, {$root => "rmdir: $!"};
}
else {
_carp ("Can't remove directory $root: $!");
- }
+ }
if (!chmod($rp,
($Is_VMS ? VMS::Filespec::fileify($root) : $root))
) {
my $mask = sprintf("0%o",$rp);
if ($arg->{error}) {
push @{${$arg->{error}}}, {$root => "restore
chmod: $!"};
- }
- else {
+ }
+ else {
_carp("and can't restore permissions to $mask\n");
}
}
@@ -633,12 +684,12 @@
}
else {
if ($arg->{safe} &&
- ($Is_VMS ? !&VMS::Filespec::candelete($root)
- : !(-l $root || -w $root)))
- {
+ ($Is_VMS ? !&VMS::Filespec::candelete($root)
+ : !(-l $root || -w $root)))
+ {
print "skipped $root\n" if $arg->{verbose};
- next;
- }
+ next;
+ }
if (!chmod $rp | 0600, $root) {
if ($Force_Writeable) {
if ($arg->{error}) {
@@ -651,8 +702,8 @@
}
}
print "unlink $root\n" if $arg->{verbose};
- # delete all versions under VMS
- for (;;) {
+ # delete all versions under VMS
+ for (;;) {
if (unlink $root) {
push @{${$arg->{result}}}, $root if $arg->{result};
}
@@ -674,13 +725,13 @@
_carp("and can't restore permissions to
$mask\n");
}
}
- }
- last;
- }
- ++$count;
- last unless $Is_VMS && lstat $root;
- }
- }
+ }
+ last;
+ }
+ ++$count;
+ last unless $Is_VMS && lstat $root;
+ }
+ }
}
return $count;
