pmirror: Avoid File::Find

File::Find can't handle the situation of a directory disappearing after it has been detected. So remove File::Find usage and walk the tree manually.
mariux64 · Aug 24, 2018 · 21b6a0c · 21b6a0c
1 parent 354592c
commit 21b6a0c
Showing 1 changed file with 55 additions and 99 deletions.
diff --git a/pmirror/pmirror b/pmirror/pmirror
@@ -151,7 +151,6 @@ use strict;
 use warnings;
 
 use File::FnMatch ':fnmatch';
-use File::Find;
 use Getopt::Long;
 use Sys::Hostname;
 use IO::File;
@@ -545,95 +544,6 @@ sub cksum {
 	return $sum;
 }
 
-sub master_wanted_func
-{
-	local $SIG{__WARN__};
-	delete $SIG{__WARN__};
-
-	my $filename=$File::Find::name;
-
-	# s(^\./)();	# remove "./" prefix
-
-	if (is_excepted($filename)) {
-		$File::Find::prune=1;
-		return;
-	}
-
-	my $st=My::FileInfo->lstat($filename);
-	unless ($st) {
-		warn "$filename : $!\n";
-		$File::Find::prune=1;
-		return;
-	}
-
-	if ( !exists $LOCAL_DEV{$st->dev} && !$allowremotefs && !($st->dev == -1 && $st->type eq 'P')) {  # osf bug: pipes show -1 as dev
-		warn "master_wanted_func: $filename : remote filesystem\n";
-		$File::Find::prune=1;
-		return;
-	}
-
-	if ($st->type eq 'D' && $filename =~ /\/(package|project|confidential|home|scratch|src)\/[^\/]+\.DELETEME$/ ) {
-		$File::Find::prune=1;
-		return;
-	}
-
-	my $hardlink='-';
-
-	if ($st->type ne 'D' && $st->nlink>1) {
-		my $tag=$st->dev.'.'.$st->ino;
-		if (exists $HARDLINK{$tag}) {
-			$hardlink=$HARDLINK{$tag}
-		} else {
-			$HARDLINK{$tag}=$st->name_escaped
-		}
-	}
-
-	my $sum= $cksum && $st->type eq 'F' ? cksum($filename) : '-';
-
-	$out->print($st->export_index,$hardlink,$sum);
-	if ($st->type eq 'F') {
-		my $reply=$in->getline;
-		defined $reply or die "client disconnected\n";
-		chomp($reply);
-		if ($reply eq 'SEND') {
-			if ($bandwidth && !$quiet) {
-				# note: we have $\ set, so use printf, not print
-				printf STDERR 'sending %s',$filename;
-				send_file($filename);
-				printf STDERR "\n";
-			} else {
-				$quiet or warn "sending $filename\n";
-				send_file($filename);
-			}
-		} elsif ($reply eq 'CONTINUE') {
-			;
-		} else {
-			die "unexpected client reply: $reply\n";
-		}
-	}
-
-	# File::Find might walk errornously into symlinks
-	#
-	# this is what happens:
-	# The parent directory is scanned, names are sorted, plain files processed and directories are queued.
-	# the the queued directories are processed in order. during the time, the first directories are processed,
-	# another one, which is still waiting in a queue, is replaced with a symlink to a directory. Now when
-	# File::Find pops this one from the queue and processes it, this wanted() function is called first with
-	# the (ex-directory, now symlink) name. We send the symlink information to the mirror destinatin. But
-	# when we return, File::Find will continue its directory processing and opendir() this File. This succeeds,
-	# but opens the directory pointed to by the symlink.
-	#
-	# so even, when our file here is not a directory, File::Find might think, it is. We don't want to
-	# follow symlinks and even dont want to attempt to opendir() anything else. The easy way out is to
-	# signal File::Find not to further process this supposed directory.
-	#
-	# So this is just for the exceptional case that File::Find thinks, this is a directory.
-	# If File::Find is not in directory processing, this is a noop.
-	#
-	$st->type ne 'D' and $File::Find::prune=1;
-
-}
-
 sub master
 {
 	my ($master_path,$slave_user,$slave,$slave_path)=@_;
@@ -737,15 +647,61 @@ sub master
 		$out->print('!',fn_escape($_));
 	}
 
-	local $SIG{__WARN__}=sub { die $_[0] };
-	find (
-		{
-			wanted => \&master_wanted_func,
-			no_chdir => 1,	# because we work from '.', so File::Find::Fullname ('./laa/bla') is invalid when chdired
-			preprocess => sub { return sort @_; } ,	# does not stop File::Find to process files before dirs
-		},
-		'.'
-	);
+	my @TODO='.';
+	while (@TODO) {
+		my $filename=shift @TODO;
+		next if is_excepted($filename);
+		my $st=My::FileInfo->lstat($filename);
+		unless ($st) {
+			warn "$filename : $!\n";
+			next;
+		}
+		if ( !exists $LOCAL_DEV{$st->dev} && !$allowremotefs && !($st->dev == -1 && $st->type eq 'P')) {  # osf bug: pipes show -1 as dev
+			warn "$filename : remote filesystem\n";
+			next;
+		}
+		if ($st->type eq 'D' && $filename =~ /\/(package|project|confidential|home|scratch|src)\/[^\/]+\.DELETEME$/ ) {
+			next;
+		}
+		my $hardlink='-';
+		if ($st->type ne 'D' && $st->nlink>1) {
+			my $tag=$st->dev.'.'.$st->ino;
+			if (exists $HARDLINK{$tag}) {
+				$hardlink=$HARDLINK{$tag}
+			} else {
+				$HARDLINK{$tag}=$st->name_escaped
+			}
+		}
+		my $sum= $cksum && $st->type eq 'F' ? cksum($filename) : '-';
+		$out->print($st->export_index,$hardlink,$sum);
+		if ($st->type eq 'F') {
+			my $reply=$in->getline;
+			defined $reply or die "client disconnected\n";
+			chomp($reply);
+			if ($reply eq 'SEND') {
+				if ($bandwidth && !$quiet) {
+					# note: we have $\ set, so use printf, not print
+					printf STDERR 'sending %s',$filename;
+					send_file($filename);
+					printf STDERR "\n";
+				} else {
+					$quiet or warn "sending $filename\n";
+					send_file($filename);
+				}
+			} elsif ($reply eq 'CONTINUE') {
+				;
+			} else {
+				die "unexpected client reply: $reply\n";
+			}
+		} elsif ($st->type eq 'D') {
+			my $dir;
+			unless (opendir $dir,$filename) {
+				next if $!==2 || $!==20;         # ENOENT,ENOTDIR
+				die "$filename: $!\n";
+			}
+			unshift @TODO,map("$filename/$_",sort grep !/^\.\.?$/,readdir $dir)
+		}
+	}
 	$out->print('%','complete');	# end tag, because truncated indices can be quite destructive
 
 	$in->close;