#!/usr/bin/perl

#
#  cvsmapfs - Maps arbitrary filesystem in and out of form that cvs can handle.
#  Copyright (C) 1995 Brian Bartholomew <bb@wv.com>
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
#  Please contact Working Version at http://www.wv.com for up-to-date
#  information on this code.
#
#  Usage:
#
#	cvsmapfs [-p | -c] [-w] [ '^\.\/ignore\/submodule$' [ ... ]]
#
#	'-p' means 'produce a cvsmapfs file'
#	'-c' means 'consume a cvsmapfs file'
#	'-w' means 'write to the disk';
#	     allows unlinks/chmods during produce,
#	     allows disk mods for consume
#
#  Version:
#
#	1.3
#
#  Commercial:
#
#	When you get fed up with the limitations of CVS, check out
#	Working Version's Host Factory at http://www.wv.com.  Host
#	Factory automates building Unix host configurations.  A
#	prototype host is created, then copies of it are sent to other
#	hosts with small automatic changes.  Hosts are built quickly,
#	automatically, and without human intervention.  Hosts perform
#	identically and are repairable with minimal skill.
#
#	Host Factory provides a place to store operating system
#	distributions under version control, a place to generate
#	configuration files that differ between hosts, and a method to
#	install these files onto running systems with minimum
#	interruption and maximum automation.  Components of Host
#	Factory include the Pgfs(TM) version control filesystem, a
#	Host Profile(TM) developed for your site, and the Pdist(TM)
#	filesystem replicator.
#
#	Working Version develops, sells, and supports the Host Factory
#	software.  We offer custom consulting packages to bring the
#	worst set of host version control problems under control.  We
#	have extensive experience automating host construction at
#	large financial trading firms.  Contact us today.
#
#  Purpose:
#
#	It would be extremely useful to store an entire UNIX under
#	cvs.  However, the only thing cvs promises to restore at
#	checkout is the contents of files, not owners, groups, modes,
#	symlinks, or devices.  Cvsmapfs records this extra information
#	so you can restore it after a checkout, and then deletes
#	non-files and non-dirs so cvs won't choke on them.  It
#	restores empty directories that cvs 'optimized away'.  It
#	deals transparently with funny characters in filenames, and
#	warns you when they might cause cvs or rcs to misbehave.  It
#	puts hard links back, even when they aren't in the same
#	directory.
#
#  Example:
#
#	First time importing arbitrary U*IX files into cvs:
#
#	     cd unices/bsdi-1.1/usr/bin
#	     cvsmapfs -p > /dev/null
#	     cvsmapfs: checkpoint ./gcc2/cc1plus/except.c
#	     cvsmapfs: checkpoint ./groff/devascii/DESC.proto
#	     cvsmapfs: checkpoint ./unifdef/Makefile
#	     cvsmapfs: cvs/rcs won't like name ./foo/my>favorite|shell`chars
#	     cvsmapfs: cvs/rcs won't like name ./foo/cut\nand\npaste\nerror\n
#	     mv my?favorite?shell?metachars shell-metachars
#	     rm cut?and?paste?error?
#	     cvsmapfs -pw > .cvsmapfs
#	     cvs import -I \! -I CVS usr-bin bsdi20 fromcd
#	     find $CVSROOT/usr-bin -type f -print | xargs rcs -ko
#	          # or use -ko on cvs import for recent cvs versions
#
#	Checkout:
#
#	     cvs co usr-bin
#	     cd usr-bin
#	     cvsmapfs -cw < .cvsmapfs
#
#	Local modifications:
#
#	     cp -p /bin/sh mklocale
#	     chown root.bin mklocale
#	     chmod 4555 mklocale
#
#	Checkin:
#
#	     cvsmapfs -pw > .cvsmapfs
#	     cvs commit usr-bin
#
#	I allow cvs to keep a seperate rcs file for each link name
#	instead of optimizing them into one, because there's no way to
#	guess which link name is least likely to be deleted.
#
#  Ignoring pathnames:
#
#	Ignores are regexp's matched against the entire pathname, so
#	they can be constructed to match specific pathnames from the
#	top of the cvsmapfs or filenames in each directory.  Every
#	pathname except the top-level directory starts with './'.
#	Unfortunately, forward slashes need to be quoted with
#	backslash.  So for example, this invocation ignores the
#	/usr/src directory and every file ending in tilde:
#
#		cd /usr ; cvsmapfs -p '^\.\/src$' '\/..*~$'
#
#	The purpose of ignores was to explore checking out a module
#	that contained a subset of the files in a cvsmapfs file.
#	Don't split cvsmapfs files across CVS modules, it gets ugly
#	fast.
#

require "getopts.pl";
$myname = "cvsmapfs";
&visinit;

######################################################################

#  Option processing

&Getopts('wcp');

($opt_c && $opt_p) && die "$myname: -c and -p mutually exclusive, quitting\n";
(!$opt_c && !$opt_p) && die "$myname: must specify one of -c or -p, quitting\n";
(($#ARGV + 1 > 0) && $opt_c) && die "$myname: can't specify ignores with -c, quitting\n";
@ignores = @ARGV;

######################################################################

#  main()

#  Straight from the perl man page
$supports_symlinks = (eval 'symlink("","");', $@ eq '');

$myumask = umask;
$checkpoint_delay = 10;		# seconds

#  Set up checkpointing state
#  XXX The checkpointing fails with a race condition if the assignments
#  to $new_visname_valid aren't atomic.  I don't see any limitations on
#  what a signal handler can do in the perl man page.  If there are
#  really no limitations then the perl variables must be in a
#  consistant state.  It would be easiest to implement a consistant
#  state if the main perl program was only interrupted between
#  statements.  Therefore I'm *assuming* this simple numeric assignment
#  is atomic.
#  BZZZZZZTTT!!  observed NUL in visnames during produce, obviously
#  the signal is interrupting something I didn't think it was
#  replace alarm with something that counts files?
#  replace file count with time check?
#  try time check first, may double system calls per loop?
#  need profiler!

if ($opt_c) {
	&consume;
} else {
	&produce;
}

exit (0);

######################################################################

#  These are macros, not subroutines.

sub CHOWN {
	$opt_w && ( chown ($owner, $group, $name) ||
		warn "$myname: chown failed $visname\n" );
}

sub CHMOD {
	$opt_w && ( chmod (oct ($mode), $name) ||
		warn "$myname: chmod failed $visname\n" );
}

sub UTIME {
	$opt_w && ( utime (time, $mtime, $name) ||
		warn "$myname: utime failed $visname\n" );
}

sub UNLINK {
	$opt_w && ( unlink ($name) ||
		warn "$myname: unlink failed $visname\n" );
}

#  Delete any existing entry so that running a consume twice in a row
#  doesn't produce errors.  If some idiot put a directory where a file
#  was, perl will silently refuse to unlink it (see perl's -U option),
#  and the operation following the unlink such as symlink or mknod
#  will fail and alert us.

sub QUIETUNLINK {
	$opt_w && unlink ($name);
}

#  cvs 'optimizes away' empty directories.  Try to create a directory
#  in case it wasn't restored by cvs.

sub QUIETMKDIR {
	$opt_w && mkdir ($name, 0777);
}

sub LINK {
	$opt_w && ( link ($mastername, $name) ||
		warn "$myname: hard link failed $visname -> $vismastername\n" );
}

#  Can't chown, chmod, or utime symlinks because these system calls
#  traverse the link.  Might be able to get owner/group/mode right by
#  changing effective uid/gid/umask, but still can't get the times
#  right without changing system clock.  Therefore, don't attempt to
#  restore owner/group/mode/mtime of symlink but take what you get.

sub SYMLINK {
	if ($supports_symlinks) {
		$opt_w && ( symlink ($linkname, $name) ||
			warn "$myname: symlink failed $visname -> $vislinkname\n" );
	} else {
		warn "$myname: symlink failed $visname -> $vislinkname, no symlinks in this Unix\n";
	}
}

sub CKFIELDS {
	local ($count, $junk) = @_;

	($#fields == $count) ||
		die "$myname: wrong number of fields on line '$line', quitting\n";
}

### Splitting rdev into major/minor is extremely unportable, see
### further comments in &initMKNOD below.
###
### sub MKNOD {
### 	local ($char, $junk) = @_;
###
### 	$opt_w && ( !(system ('mknod', $name, $char, $major, $minor) / 256) ||
### 		warn "$myname: mknod failed $visname\n" );
### }

sub MKNOD {
 	local ($bits, $junk) = @_;

	($mknod_number) || &initMKNOD;

	$nummode = oct ("$bits$mode");
	$numrdev = $rdev + 0;
	$opt_w && ( !(syscall($mknod_number, $name, $nummode, $numrdev)) ||
 		warn "$myname: mknod failed $visname\n" );
}

#  Converting between major/minor device numbers and a stat(2) st_rdev
#  field is an intractable portability problem.  On a brief survey of
#  Unixes running on the x86, I've seen the stat(2) struct field
#  st_rdev defined as 16 or 32 bits, signed or unsigned, and short or
#  long.  Some systems support several flavors at once depending on
#  what filesystem or compilation environment you use.  On top of
#  that, bsdi-2.0 has the notion of "major, unit, subunit" as well as
#  "major, minor".  Places to explore for more details include the
#  macros makedev(), major(), and minor() and the typedev dev_t in
#  /usr/include/sys/types.h and /usr/include/sys/sysmacros.h.  As
#  always, your system source is definitive.  I've reluctantly taken
#  the viewpoint that what gnu tar does is good enough, so I transport
#  the st_rdev field as an opaque quantity.  This means you shouldn't
#  expect device entries to be portable across operating systems.

sub initMKNOD {

	if (require "sys/syscall.ph") {
		eval '$mknod_number = &SYS_mknod';
		if ($mknod_number == 0) {
			# Linux bogosity
			eval '$mknod_number = &SYS_prev_mknod';
		}
	} else {
		warn "$myname: require \"sys/syscall.ph\" failed, perhaps you need to create perl headers with h2ph\n";
	}

	if ($mknod_number == 0) {
		warn "$myname: trying to grep SYS_mknod from /usr/include/sys/syscall.h\n";
		open (SYSCALL, "/usr/include/sys/syscall.h");
		while (<SYSCALL>) {
			if (/SYS_mknod\s+(\d+)/) {
				$mknod_number = $1;
			}
		}
		close (SYSCALL);
	}
	if ($mknod_number == 0) {
		warn "$myname: trying to grep MKNOD from /usr/include/sys.s\n";
		open (SYSS, "/usr/include/sys.s");
		while (<SYSS>) {
			if (/MKNOD\s+(\d+)/) {
				$mknod_number = $1;
			}
		}
		close (SYSS);
	}
	if ($mknod_number == 0) {
		warn "$myname: punting, system call number of mknod(2) is historically 14\n";
		$mknod_number = 14;	# XXX punt
	}
}

sub MKFIFO {
	$opt_w && ( !(system ('mkfifo', $name) / 256) ||
		warn "$myname: mkfifo failed $visname\n" );
}

sub LINKS {
	if ($linklist{"$dev,$ino"} ne '') {
		$linklist{"$dev,$ino"} .= "\t$visname";
	} elsif ($links > 1) {
		$linklist{"$dev,$ino"} = "$links\t$visname";
	}
}

######################################################################

#
#  consume
#
#  With -w, read the previously-made output from this program and put
#  all the owner/group/modes/mtimes back the way they were, recreate
#  the devices and symlinks, etc.  Without -w it doesn't write to
#  disk, essentially only doing a syntax check on the input file.
#

sub consume {

	$nextcheckpoint = time + $checkpoint_delay;

	while (<>) {
		$line = $_;
		chop ($line);
		@fields = split ("\t", $line);
		$key = shift (@fields);

		if ($key eq 'file') {
			&CKFIELDS (4);
			($mode, $owner, $group, $mtime, $visname) = @fields;
			$name = &unvis ($visname);
			&CHOWN;
			&CHMOD;
			&UTIME;

		} elsif ($key eq 'dir') {
			&CKFIELDS (4);
			($mode, $owner, $group, $mtime, $visname) = @fields;
			$name = &unvis ($visname);
			&QUIETMKDIR;
			&CHOWN;
			&CHMOD;
			&UTIME;

		} elsif ($key eq 'symlink') {
			&CKFIELDS (5);
			($mode, $owner, $group, $mtime, $visname, $vislinkname) = @fields;
			$name = &unvis ($visname);
			$linkname = &unvis ($vislinkname);
			&QUIETUNLINK;
			&SYMLINK;

		} elsif ($key eq 'chardev') {
			&CKFIELDS (5);
			($mode, $owner, $group, $mtime, $visname, $rdev) = @fields;
			$name = &unvis ($visname);
			&QUIETUNLINK;
			&MKNOD ('02');
			&CHOWN;
			&CHMOD;
			&UTIME;

		} elsif ($key eq 'blkdev') {
			&CKFIELDS (5);
			($mode, $owner, $group, $mtime, $visname, $rdev) = @fields;
			$name = &unvis ($visname);
			&QUIETUNLINK;
			&MKNOD ('06');
			&CHOWN;
			&CHMOD;
			&UTIME;

		} elsif ($key eq 'pipe') {
			&CKFIELDS (4);
			($mode, $owner, $group, $mtime, $visname) = @fields;
			$name = &unvis ($visname);
			&QUIETUNLINK;
			&MKFIFO;
			&CHOWN;
			&CHMOD;
			&UTIME;

		} elsif ($key eq 'socket') {
			&CKFIELDS (4);
			($mode, $owner, $group, $mtime, $visname) = @fields;
			warn "$myname: can't recreate socket $visname\n";

		} elsif ($key eq 'linked') {
			($#fields >= 1) || die "$myname: too few fields on line '$line', quitting\n";
			$vismastername = shift (@fields);
			$mastername = &unvis ($vismastername);
			foreach $visname (@fields) {
				$name = &unvis ($visname);
				&UNLINK;
				&LINK;
			}

		} else {
			die "$myname: bad first field on line '$line', quitting\n";
		}

		$now = time;
		if ($now > $nextcheckpoint) {
			warn "$myname: checkpoint $visname\n";
			$nextcheckpoint = $now + $checkpoint_delay;
		}
	}
}

######################################################################

#
#  produce
#
#  Recursively walk the current directory and create tab-seperated
#  lines on stdout like:
#
#	file	0644	105	30	789528968	./testdir1/tab\tsepr
#	symlink	0777	0	30	803592516	./testdir1/symlink	foo/bar
#	blkdev	0644	0	30	789530535	./testdir1/blockdevice	123
#	chardev	0644	0	30	789530542	./testdir1/chardevice	456
#	pipe	0644	105	30	789528970	./testdir1/pipe
#	socket	0644	105	30	789528970	./testdir1/socket
#	dir	0755	105	30	803575878	./testdir1
#
#  The base fields are type, mode, numeric owner, numeric group,
#  mtime, and name.  For symlinks, add a field at the end for the
#  target of the link.  For devices, add two fields at the end for the
#  major and minor device numbers.  Quote non-printable and whitespace
#  characters in filenames, and warn about filenames cvs/rcs/sh might
#  choke on.  After the filesystem tree is walked, create lines like
#  this for each non-dir with multiple links found:
#
#	linked	./testdir1/link1a	./testdir1/link1b
#
#  With -w, delete all non-files and non-directories, so cvs won't be
#  confused by them.  Then chmod dirs to be 777 modified by the umask
#  and files to be 666 or 777 if any of the execute bits are set.
#

sub produce {

	$noexemask = sprintf ("%4o", 0666 & (~ $myumask));
	$exemask = sprintf ("%4o", 0777 & (~ $myumask));

	unshift (@ignores, '\/CVS$');

	($name, $dev, $ino, $mode, $links, $owner, $group, $rdev,
		$size, $atime, $mtime, $ctime, $blksize, $blocks) = &ftwstream (".", 1, @ignores);
	$nextcheckpoint = time + $checkpoint_delay;

	while ($name ne '') {

		$visname = &vis ($name);
		if ($name ne $visname || $name =~ /"#\$&'()\*;<>?\[\]\^`\{\|\}~/) {
			warn "$myname: cvs/rcs may misparse name $visname\n";
		}

		$type = substr ($mode, 0, 2);
		$mode = substr ($mode, 2, 4);

		if ($type eq '10') {		# file
			print "file\t$mode\t$owner\t$group\t$mtime\t$visname\n";
			&LINKS;
			if ($mode =~ /[751]..$|[751].$|[751]$/) {
				$mode = $exemask;
			} else {
				$mode = $noexemask;
			}
			&CHMOD;

		} elsif ($type eq '04') {	# dir
			print "dir\t$mode\t$owner\t$group\t$mtime\t$visname\n";
			$mode = $exemask;
			&CHMOD;

		} elsif ($type eq '12') {	# symlink
			$linkend = &vis (readlink ($name)) ||
				warn "$myname: readlink failed $visname\n";
			print "symlink\t$mode\t$owner\t$group\t$mtime\t$visname\t$linkend\n";
			&LINKS;
			&UNLINK;

		} elsif ($type eq '02') {	# char

###			Splitting st_rdev into major and minor device
###			numbers is extremely Unix-version-specific, so
###			I no longer try.  More details in &initMKNOD.
###
###			$major = ($rdev >> 8) & 0xff;		# 16-bits
###			$minor = $rdev & 0xff;
###			$major = ($rdev >> 20) & 0xfff;		# 32-bits
###			$minor = $rdev & 0xfff;

			print "chardev\t$mode\t$owner\t$group\t$mtime\t$visname\t$rdev\n";
			&LINKS;
			&UNLINK;

		} elsif ($type eq '06') {	# block
			print "blkdev\t$mode\t$owner\t$group\t$mtime\t$visname\t$rdev\n";
			&LINKS;
			&UNLINK;

		} elsif ($type eq '01') {	# pipe
			print "pipe\t$mode\t$owner\t$group\t$mtime\t$visname\n";
			&LINKS;
			&UNLINK;

		} elsif ($type eq '14') {	# socket
			print "socket\t$mode\t$owner\t$group\t$mtime\t$visname\n";
			warn "$myname: won't be able to recreate socket $visname later\n";
			&LINKS;
			&UNLINK;

		} else {
			die "$myname: unknown file type $type, quitting\n";;
		}

		$now = time;
		if ($now > $nextcheckpoint) {
			warn "$myname: checkpoint $visname\n";
			$nextcheckpoint = $now + $checkpoint_delay;
		}

		($name, $dev, $ino, $mode, $links, $owner, $group, $rdev,
			$size, $atime, $mtime, $ctime, $blksize, $blocks) = &ftwstream;
	}

#
#  Create lists of linked files for output after 'linked' keyword.
#  The intent is for the link output to be identical for identical
#  filesystems no matter what order the links are discovered or what
#  order they come out of the perl hash table, etc.  This makes rcs's
#  diffs produce the right results.  Each list should already be
#  sorted by virtue of the ordered filesystem traversal, but I'm not
#  completely convinced so I don't depend on it.  So we sort each list
#  internally, then sort the collection of lists.  We allow cvs to
#  keep a seperate rcs file for each link name instead of optimizing
#  them into one, because there's no way to guess which link name is
#  least likely to be deleted.
#

	foreach $key (keys (%linklist)) {
		@junk = split ("\t", $linklist{$key});
		$links = shift (@junk);
		@names = sort (@junk);	# should be already sorted by filesystem traverse order
		if ($links != ($#junk + 1)) {
			warn "$myname: claimed $links links but found ", ($#junk + 1), " for @names\n";
		}
		push (@lines, join ("\t", @names));
	}
	@slines = sort (@lines);

#  Output list of links

	foreach $line (@slines) {
		print "linked\t$line\n";
	}
}


#
#  visinit - Initializes private data for subroutines vis and unvis
#
#  Motivation
#
#	The natural way to get this initialization code run is to 'require'
#	vis at the top of the script using it instead of catting it in at the
#	bottom.  However I don't
#	want to distribute a program that requires things not in the
#	standard perl library.
#

sub visinit {
	package vis;

	$vis_intable[0] = '\0';
	$vis_intable[1] = '\^A';
	$vis_intable[2] = '\^B';
	$vis_intable[3] = '\^C';
	$vis_intable[4] = '\^D';
	$vis_intable[5] = '\^E';
	$vis_intable[6] = '\^F';
	$vis_intable[7] = '\a';
	$vis_intable[8] = '\b';
	$vis_intable[9] = '\t';
	$vis_intable[10] = '\n';
	$vis_intable[11] = '\v';
	$vis_intable[12] = '\f';
	$vis_intable[13] = '\r';
	$vis_intable[14] = '\^N';
	$vis_intable[15] = '\^O';
	$vis_intable[16] = '\^P';
	$vis_intable[17] = '\^Q';
	$vis_intable[18] = '\^R';
	$vis_intable[19] = '\^S';
	$vis_intable[20] = '\^T';
	$vis_intable[21] = '\^U';
	$vis_intable[22] = '\^V';
	$vis_intable[23] = '\^W';
	$vis_intable[24] = '\^X';
	$vis_intable[25] = '\^Y';
	$vis_intable[26] = '\^Z';
	$vis_intable[27] = '\e';
	$vis_intable[28] = '\^\\';
	$vis_intable[29] = '\^]';
	$vis_intable[30] = '\^^';
	$vis_intable[31] = '\^_';
	$vis_intable[32] = '\s';
	$vis_intable[33] = '!';
	$vis_intable[34] = '"';
	$vis_intable[35] = '#';
	$vis_intable[36] = '$';
	$vis_intable[37] = '%';
	$vis_intable[38] = '&';
	$vis_intable[39] = '\'';
	$vis_intable[40] = '(';
	$vis_intable[41] = ')';
	$vis_intable[42] = '*';
	$vis_intable[43] = '+';
	$vis_intable[44] = ',';
	$vis_intable[45] = '-';
	$vis_intable[46] = '.';
	$vis_intable[47] = '/';
	$vis_intable[48] = '0';
	$vis_intable[49] = '1';
	$vis_intable[50] = '2';
	$vis_intable[51] = '3';
	$vis_intable[52] = '4';
	$vis_intable[53] = '5';
	$vis_intable[54] = '6';
	$vis_intable[55] = '7';
	$vis_intable[56] = '8';
	$vis_intable[57] = '9';
	$vis_intable[58] = ':';
	$vis_intable[59] = ';';
	$vis_intable[60] = '<';
	$vis_intable[61] = '=';
	$vis_intable[62] = '>';
	$vis_intable[63] = '?';
	$vis_intable[64] = '@';
	$vis_intable[65] = 'A';
	$vis_intable[66] = 'B';
	$vis_intable[67] = 'C';
	$vis_intable[68] = 'D';
	$vis_intable[69] = 'E';
	$vis_intable[70] = 'F';
	$vis_intable[71] = 'G';
	$vis_intable[72] = 'H';
	$vis_intable[73] = 'I';
	$vis_intable[74] = 'J';
	$vis_intable[75] = 'K';
	$vis_intable[76] = 'L';
	$vis_intable[77] = 'M';
	$vis_intable[78] = 'N';
	$vis_intable[79] = 'O';
	$vis_intable[80] = 'P';
	$vis_intable[81] = 'Q';
	$vis_intable[82] = 'R';
	$vis_intable[83] = 'S';
	$vis_intable[84] = 'T';
	$vis_intable[85] = 'U';
	$vis_intable[86] = 'V';
	$vis_intable[87] = 'W';
	$vis_intable[88] = 'X';
	$vis_intable[89] = 'Y';
	$vis_intable[90] = 'Z';
	$vis_intable[91] = '[';
	$vis_intable[92] = '\\\\';
	$vis_intable[93] = ']';
	$vis_intable[94] = '^';
	$vis_intable[95] = '_';
	$vis_intable[96] = '`';
	$vis_intable[97] = 'a';
	$vis_intable[98] = 'b';
	$vis_intable[99] = 'c';
	$vis_intable[100] = 'd';
	$vis_intable[101] = 'e';
	$vis_intable[102] = 'f';
	$vis_intable[103] = 'g';
	$vis_intable[104] = 'h';
	$vis_intable[105] = 'i';
	$vis_intable[106] = 'j';
	$vis_intable[107] = 'k';
	$vis_intable[108] = 'l';
	$vis_intable[109] = 'm';
	$vis_intable[110] = 'n';
	$vis_intable[111] = 'o';
	$vis_intable[112] = 'p';
	$vis_intable[113] = 'q';
	$vis_intable[114] = 'r';
	$vis_intable[115] = 's';
	$vis_intable[116] = 't';
	$vis_intable[117] = 'u';
	$vis_intable[118] = 'v';
	$vis_intable[119] = 'w';
	$vis_intable[120] = 'x';
	$vis_intable[121] = 'y';
	$vis_intable[122] = 'z';
	$vis_intable[123] = '{';
	$vis_intable[124] = '|';
	$vis_intable[125] = '}';
	$vis_intable[126] = '~';
	$vis_intable[127] = '\^?';
	$vis_intable[128] = '\M^@';
	$vis_intable[129] = '\M^A';
	$vis_intable[130] = '\M^B';
	$vis_intable[131] = '\M^C';
	$vis_intable[132] = '\M^D';
	$vis_intable[133] = '\M^E';
	$vis_intable[134] = '\M^F';
	$vis_intable[135] = '\M^G';
	$vis_intable[136] = '\M^H';
	$vis_intable[137] = '\M^I';
	$vis_intable[138] = '\M^J';
	$vis_intable[139] = '\M^K';
	$vis_intable[140] = '\M^L';
	$vis_intable[141] = '\M^M';
	$vis_intable[142] = '\M^N';
	$vis_intable[143] = '\M^O';
	$vis_intable[144] = '\M^P';
	$vis_intable[145] = '\M^Q';
	$vis_intable[146] = '\M^R';
	$vis_intable[147] = '\M^S';
	$vis_intable[148] = '\M^T';
	$vis_intable[149] = '\M^U';
	$vis_intable[150] = '\M^V';
	$vis_intable[151] = '\M^W';
	$vis_intable[152] = '\M^X';
	$vis_intable[153] = '\M^Y';
	$vis_intable[154] = '\M^Z';
	$vis_intable[155] = '\M^[';
	$vis_intable[156] = '\M^\\';
	$vis_intable[157] = '\M^]';
	$vis_intable[158] = '\M^^';
	$vis_intable[159] = '\M^_';
	$vis_intable[160] = '\240';
	$vis_intable[161] = '\M-!';
	$vis_intable[162] = '\M-"';
	$vis_intable[163] = '\M-#';
	$vis_intable[164] = '\M-$';
	$vis_intable[165] = '\M-%';
	$vis_intable[166] = '\M-&';
	$vis_intable[167] = '\M-\'';
	$vis_intable[168] = '\M-(';
	$vis_intable[169] = '\M-)';
	$vis_intable[170] = '\M-*';
	$vis_intable[171] = '\M-+';
	$vis_intable[172] = '\M-,';
	$vis_intable[173] = '\M--';
	$vis_intable[174] = '\M-.';
	$vis_intable[175] = '\M-/';
	$vis_intable[176] = '\M-0';
	$vis_intable[177] = '\M-1';
	$vis_intable[178] = '\M-2';
	$vis_intable[179] = '\M-3';
	$vis_intable[180] = '\M-4';
	$vis_intable[181] = '\M-5';
	$vis_intable[182] = '\M-6';
	$vis_intable[183] = '\M-7';
	$vis_intable[184] = '\M-8';
	$vis_intable[185] = '\M-9';
	$vis_intable[186] = '\M-:';
	$vis_intable[187] = '\M-;';
	$vis_intable[188] = '\M-<';
	$vis_intable[189] = '\M-=';
	$vis_intable[190] = '\M->';
	$vis_intable[191] = '\M-?';
	$vis_intable[192] = '\M-@';
	$vis_intable[193] = '\M-A';
	$vis_intable[194] = '\M-B';
	$vis_intable[195] = '\M-C';
	$vis_intable[196] = '\M-D';
	$vis_intable[197] = '\M-E';
	$vis_intable[198] = '\M-F';
	$vis_intable[199] = '\M-G';
	$vis_intable[200] = '\M-H';
	$vis_intable[201] = '\M-I';
	$vis_intable[202] = '\M-J';
	$vis_intable[203] = '\M-K';
	$vis_intable[204] = '\M-L';
	$vis_intable[205] = '\M-M';
	$vis_intable[206] = '\M-N';
	$vis_intable[207] = '\M-O';
	$vis_intable[208] = '\M-P';
	$vis_intable[209] = '\M-Q';
	$vis_intable[210] = '\M-R';
	$vis_intable[211] = '\M-S';
	$vis_intable[212] = '\M-T';
	$vis_intable[213] = '\M-U';
	$vis_intable[214] = '\M-V';
	$vis_intable[215] = '\M-W';
	$vis_intable[216] = '\M-X';
	$vis_intable[217] = '\M-Y';
	$vis_intable[218] = '\M-Z';
	$vis_intable[219] = '\M-[';
	$vis_intable[220] = '\M-\\';
	$vis_intable[221] = '\M-]';
	$vis_intable[222] = '\M-^';
	$vis_intable[223] = '\M-_';
	$vis_intable[224] = '\M-`';
	$vis_intable[225] = '\M-a';
	$vis_intable[226] = '\M-b';
	$vis_intable[227] = '\M-c';
	$vis_intable[228] = '\M-d';
	$vis_intable[229] = '\M-e';
	$vis_intable[230] = '\M-f';
	$vis_intable[231] = '\M-g';
	$vis_intable[232] = '\M-h';
	$vis_intable[233] = '\M-i';
	$vis_intable[234] = '\M-j';
	$vis_intable[235] = '\M-k';
	$vis_intable[236] = '\M-l';
	$vis_intable[237] = '\M-m';
	$vis_intable[238] = '\M-n';
	$vis_intable[239] = '\M-o';
	$vis_intable[240] = '\M-p';
	$vis_intable[241] = '\M-q';
	$vis_intable[242] = '\M-r';
	$vis_intable[243] = '\M-s';
	$vis_intable[244] = '\M-t';
	$vis_intable[245] = '\M-u';
	$vis_intable[246] = '\M-v';
	$vis_intable[247] = '\M-w';
	$vis_intable[248] = '\M-x';
	$vis_intable[249] = '\M-y';
	$vis_intable[250] = '\M-z';
	$vis_intable[251] = '\M-{';
	$vis_intable[252] = '\M-|';
	$vis_intable[253] = '\M-}';
	$vis_intable[254] = '\M-~';
	$vis_intable[255] = '\M^?';

	$vis_outtable{'\0'} = 0;
	$vis_outtable{'\^A'} = 1;
	$vis_outtable{'\^B'} = 2;
	$vis_outtable{'\^C'} = 3;
	$vis_outtable{'\^D'} = 4;
	$vis_outtable{'\^E'} = 5;
	$vis_outtable{'\^F'} = 6;
	$vis_outtable{'\a'} = 7;
	$vis_outtable{'\b'} = 8;
	$vis_outtable{'\t'} = 9;
	$vis_outtable{'\n'} = 10;
	$vis_outtable{'\v'} = 11;
	$vis_outtable{'\f'} = 12;
	$vis_outtable{'\r'} = 13;
	$vis_outtable{'\^N'} = 14;
	$vis_outtable{'\^O'} = 15;
	$vis_outtable{'\^P'} = 16;
	$vis_outtable{'\^Q'} = 17;
	$vis_outtable{'\^R'} = 18;
	$vis_outtable{'\^S'} = 19;
	$vis_outtable{'\^T'} = 20;
	$vis_outtable{'\^U'} = 21;
	$vis_outtable{'\^V'} = 22;
	$vis_outtable{'\^W'} = 23;
	$vis_outtable{'\^X'} = 24;
	$vis_outtable{'\^Y'} = 25;
	$vis_outtable{'\^Z'} = 26;
	$vis_outtable{'\e'} = 27;
	$vis_outtable{'\^\\'} = 28;
	$vis_outtable{'\^]'} = 29;
	$vis_outtable{'\^^'} = 30;
	$vis_outtable{'\^_'} = 31;
	$vis_outtable{'\s'} = 32;
	$vis_outtable{'!'} = 33;
	$vis_outtable{'"'} = 34;
	$vis_outtable{'#'} = 35;
	$vis_outtable{'$'} = 36;
	$vis_outtable{'%'} = 37;
	$vis_outtable{'&'} = 38;
	$vis_outtable{'\''} = 39;
	$vis_outtable{'('} = 40;
	$vis_outtable{')'} = 41;
	$vis_outtable{'*'} = 42;
	$vis_outtable{'+'} = 43;
	$vis_outtable{','} = 44;
	$vis_outtable{'-'} = 45;
	$vis_outtable{'.'} = 46;
	$vis_outtable{'/'} = 47;
	$vis_outtable{'0'} = 48;
	$vis_outtable{'1'} = 49;
	$vis_outtable{'2'} = 50;
	$vis_outtable{'3'} = 51;
	$vis_outtable{'4'} = 52;
	$vis_outtable{'5'} = 53;
	$vis_outtable{'6'} = 54;
	$vis_outtable{'7'} = 55;
	$vis_outtable{'8'} = 56;
	$vis_outtable{'9'} = 57;
	$vis_outtable{':'} = 58;
	$vis_outtable{';'} = 59;
	$vis_outtable{'<'} = 60;
	$vis_outtable{'='} = 61;
	$vis_outtable{'>'} = 62;
	$vis_outtable{'?'} = 63;
	$vis_outtable{'@'} = 64;
	$vis_outtable{'A'} = 65;
	$vis_outtable{'B'} = 66;
	$vis_outtable{'C'} = 67;
	$vis_outtable{'D'} = 68;
	$vis_outtable{'E'} = 69;
	$vis_outtable{'F'} = 70;
	$vis_outtable{'G'} = 71;
	$vis_outtable{'H'} = 72;
	$vis_outtable{'I'} = 73;
	$vis_outtable{'J'} = 74;
	$vis_outtable{'K'} = 75;
	$vis_outtable{'L'} = 76;
	$vis_outtable{'M'} = 77;
	$vis_outtable{'N'} = 78;
	$vis_outtable{'O'} = 79;
	$vis_outtable{'P'} = 80;
	$vis_outtable{'Q'} = 81;
	$vis_outtable{'R'} = 82;
	$vis_outtable{'S'} = 83;
	$vis_outtable{'T'} = 84;
	$vis_outtable{'U'} = 85;
	$vis_outtable{'V'} = 86;
	$vis_outtable{'W'} = 87;
	$vis_outtable{'X'} = 88;
	$vis_outtable{'Y'} = 89;
	$vis_outtable{'Z'} = 90;
	$vis_outtable{'['} = 91;
	$vis_outtable{'\\\\'} = 92;
	$vis_outtable{']'} = 93;
	$vis_outtable{'^'} = 94;
	$vis_outtable{'_'} = 95;
	$vis_outtable{'`'} = 96;
	$vis_outtable{'a'} = 97;
	$vis_outtable{'b'} = 98;
	$vis_outtable{'c'} = 99;
	$vis_outtable{'d'} = 100;
	$vis_outtable{'e'} = 101;
	$vis_outtable{'f'} = 102;
	$vis_outtable{'g'} = 103;
	$vis_outtable{'h'} = 104;
	$vis_outtable{'i'} = 105;
	$vis_outtable{'j'} = 106;
	$vis_outtable{'k'} = 107;
	$vis_outtable{'l'} = 108;
	$vis_outtable{'m'} = 109;
	$vis_outtable{'n'} = 110;
	$vis_outtable{'o'} = 111;
	$vis_outtable{'p'} = 112;
	$vis_outtable{'q'} = 113;
	$vis_outtable{'r'} = 114;
	$vis_outtable{'s'} = 115;
	$vis_outtable{'t'} = 116;
	$vis_outtable{'u'} = 117;
	$vis_outtable{'v'} = 118;
	$vis_outtable{'w'} = 119;
	$vis_outtable{'x'} = 120;
	$vis_outtable{'y'} = 121;
	$vis_outtable{'z'} = 122;
	$vis_outtable{'{'} = 123;
	$vis_outtable{'|'} = 124;
	$vis_outtable{'}'} = 125;
	$vis_outtable{'~'} = 126;
	$vis_outtable{'\^?'} = 127;
	$vis_outtable{'\M^@'} = 128;
	$vis_outtable{'\M^A'} = 129;
	$vis_outtable{'\M^B'} = 130;
	$vis_outtable{'\M^C'} = 131;
	$vis_outtable{'\M^D'} = 132;
	$vis_outtable{'\M^E'} = 133;
	$vis_outtable{'\M^F'} = 134;
	$vis_outtable{'\M^G'} = 135;
	$vis_outtable{'\M^H'} = 136;
	$vis_outtable{'\M^I'} = 137;
	$vis_outtable{'\M^J'} = 138;
	$vis_outtable{'\M^K'} = 139;
	$vis_outtable{'\M^L'} = 140;
	$vis_outtable{'\M^M'} = 141;
	$vis_outtable{'\M^N'} = 142;
	$vis_outtable{'\M^O'} = 143;
	$vis_outtable{'\M^P'} = 144;
	$vis_outtable{'\M^Q'} = 145;
	$vis_outtable{'\M^R'} = 146;
	$vis_outtable{'\M^S'} = 147;
	$vis_outtable{'\M^T'} = 148;
	$vis_outtable{'\M^U'} = 149;
	$vis_outtable{'\M^V'} = 150;
	$vis_outtable{'\M^W'} = 151;
	$vis_outtable{'\M^X'} = 152;
	$vis_outtable{'\M^Y'} = 153;
	$vis_outtable{'\M^Z'} = 154;
	$vis_outtable{'\M^['} = 155;
	$vis_outtable{'\M^\\'} = 156;
	$vis_outtable{'\M^]'} = 157;
	$vis_outtable{'\M^^'} = 158;
	$vis_outtable{'\M^_'} = 159;
	$vis_outtable{'\240'} = 160;
	$vis_outtable{'\M-!'} = 161;
	$vis_outtable{'\M-"'} = 162;
	$vis_outtable{'\M-#'} = 163;
	$vis_outtable{'\M-$'} = 164;
	$vis_outtable{'\M-%'} = 165;
	$vis_outtable{'\M-&'} = 166;
	$vis_outtable{'\M-\''} = 167;
	$vis_outtable{'\M-('} = 168;
	$vis_outtable{'\M-)'} = 169;
	$vis_outtable{'\M-*'} = 170;
	$vis_outtable{'\M-+'} = 171;
	$vis_outtable{'\M-,'} = 172;
	$vis_outtable{'\M--'} = 173;
	$vis_outtable{'\M-.'} = 174;
	$vis_outtable{'\M-/'} = 175;
	$vis_outtable{'\M-0'} = 176;
	$vis_outtable{'\M-1'} = 177;
	$vis_outtable{'\M-2'} = 178;
	$vis_outtable{'\M-3'} = 179;
	$vis_outtable{'\M-4'} = 180;
	$vis_outtable{'\M-5'} = 181;
	$vis_outtable{'\M-6'} = 182;
	$vis_outtable{'\M-7'} = 183;
	$vis_outtable{'\M-8'} = 184;
	$vis_outtable{'\M-9'} = 185;
	$vis_outtable{'\M-:'} = 186;
	$vis_outtable{'\M-;'} = 187;
	$vis_outtable{'\M-<'} = 188;
	$vis_outtable{'\M-='} = 189;
	$vis_outtable{'\M->'} = 190;
	$vis_outtable{'\M-?'} = 191;
	$vis_outtable{'\M-@'} = 192;
	$vis_outtable{'\M-A'} = 193;
	$vis_outtable{'\M-B'} = 194;
	$vis_outtable{'\M-C'} = 195;
	$vis_outtable{'\M-D'} = 196;
	$vis_outtable{'\M-E'} = 197;
	$vis_outtable{'\M-F'} = 198;
	$vis_outtable{'\M-G'} = 199;
	$vis_outtable{'\M-H'} = 200;
	$vis_outtable{'\M-I'} = 201;
	$vis_outtable{'\M-J'} = 202;
	$vis_outtable{'\M-K'} = 203;
	$vis_outtable{'\M-L'} = 204;
	$vis_outtable{'\M-M'} = 205;
	$vis_outtable{'\M-N'} = 206;
	$vis_outtable{'\M-O'} = 207;
	$vis_outtable{'\M-P'} = 208;
	$vis_outtable{'\M-Q'} = 209;
	$vis_outtable{'\M-R'} = 210;
	$vis_outtable{'\M-S'} = 211;
	$vis_outtable{'\M-T'} = 212;
	$vis_outtable{'\M-U'} = 213;
	$vis_outtable{'\M-V'} = 214;
	$vis_outtable{'\M-W'} = 215;
	$vis_outtable{'\M-X'} = 216;
	$vis_outtable{'\M-Y'} = 217;
	$vis_outtable{'\M-Z'} = 218;
	$vis_outtable{'\M-['} = 219;
	$vis_outtable{'\M-\\'} = 220;
	$vis_outtable{'\M-]'} = 221;
	$vis_outtable{'\M-^'} = 222;
	$vis_outtable{'\M-_'} = 223;
	$vis_outtable{'\M-`'} = 224;
	$vis_outtable{'\M-a'} = 225;
	$vis_outtable{'\M-b'} = 226;
	$vis_outtable{'\M-c'} = 227;
	$vis_outtable{'\M-d'} = 228;
	$vis_outtable{'\M-e'} = 229;
	$vis_outtable{'\M-f'} = 230;
	$vis_outtable{'\M-g'} = 231;
	$vis_outtable{'\M-h'} = 232;
	$vis_outtable{'\M-i'} = 233;
	$vis_outtable{'\M-j'} = 234;
	$vis_outtable{'\M-k'} = 235;
	$vis_outtable{'\M-l'} = 236;
	$vis_outtable{'\M-m'} = 237;
	$vis_outtable{'\M-n'} = 238;
	$vis_outtable{'\M-o'} = 239;
	$vis_outtable{'\M-p'} = 240;
	$vis_outtable{'\M-q'} = 241;
	$vis_outtable{'\M-r'} = 242;
	$vis_outtable{'\M-s'} = 243;
	$vis_outtable{'\M-t'} = 244;
	$vis_outtable{'\M-u'} = 245;
	$vis_outtable{'\M-v'} = 246;
	$vis_outtable{'\M-w'} = 247;
	$vis_outtable{'\M-x'} = 248;
	$vis_outtable{'\M-y'} = 249;
	$vis_outtable{'\M-z'} = 250;
	$vis_outtable{'\M-{'} = 251;
	$vis_outtable{'\M-|'} = 252;
	$vis_outtable{'\M-}'} = 253;
	$vis_outtable{'\M-~'} = 254;
	$vis_outtable{'\M^?'} = 255;
}


#
#  vis - Maps binary string to invertable text representation
#
#  Motivation:
#
#	Turns binary string into invertable text representation that's
#	safe to print.  Good for filenames that might have binary junk
#	in them.
#
#  Usage:
#
#	$visresult = &vis ($binarystring);
#
#  Sample binary input:
#
#     $ dd bs=16 count=1 if=/bsd 2> /dev/null | od -c
#     0000000   \b 001  \0  \0 240 254  \b  \0   | 231  \0  \0 270   c 001  \0
#     0000020
#     $
#
#  Sample vis output:
#
#     $ dd bs=16 count=1 if=/bsd 2> /dev/null | ./vis -
#     \b\^A\0\0\240\M-,\b\0|\M^Y\0\0\M-8c\^A\0$
#

sub vis {
	package vis;

	local ($buf, $junk) = @_;
	local ($i, $outbuf);

	$outbuf = '';
	for ($i = 0; $i < length ($buf); $i++) {
		$outbuf .= $vis_intable[unpack ("C", substr ($buf, $i, 1))];
	}
	return $outbuf;
}


#
#  unvis - Reverses the effects of vis.
#
#  Usage:
#
#	$binaryresult = &unvis ($visstring);
#

sub unvis {
	package vis;

	local ($buf, $junk) = @_;
	local ($outbuf);

	$outbuf = '';
	while (length ($buf) > 0) {
		if ($buf =~ /(\\(\\|[abefnrstv]|0|240|\^[A-FN-Z\\-_?]|M\^[\@A-_?]|M-[!-~]))|[!-~]/) {
			substr ($buf, 0, length ($&)) = '';
			$outbuf .= pack ("C", $vis_outtable{$&});
		} else {
			die "unvis: protocol error\n";
		}
	}
	return $outbuf;
}


#
#  ftwstream
#
#  Motivation:
#
#	perl's ftw's output is produced as callbacks of &wanted.  I
#	wanted another piece of code in control that would shift the
#	next filename off a queue from several places inside of it.
#	&ftwstream wanted to be a thread executing a recursive
#	algorithm talking out a circular buffer accessed like an
#	infinite list of filenames, empty-name-terminated.  perl
#	doesn't have threads.  Windows or the Mac isn't likely to
#	support an implementation of two perl scripts talking to each
#	other over a pipe.  This is an adaptation of the recursive
#	algorithm shown below.  Simple variables are stored in arrays
#	indexed by "stack level" instead of recursively putting them
#	on the real stack.  There is a fsm state corresponding to each
#	print statement or recursion depth change in the original.
#	The finite state machinery allows the procedure to start
#	executing in the middle after it takes time off to return a
#	value to the user.
#
#  Reference recursive implementation:
#
#	$dirslast = 0;
#
#	#  If first call is &doit (".") then dot is listed first time
#	#  through because dot isn't excluded in the following line.
#	#  however they are excluded from subsequent opendirs so you
#	#  will only see the top dot.
#
#	sub doit {
#
#		local ($name, $junk) = @_;
#		local ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size);
#		local ($atime,$mtime,$ctime,$blksize,$blocks);
#		local (@dirlist);
#
#		if ($name =~ /(\.\.|\/gzip-1.2.4|\/perl-4.036)$/) {
#			print "exclude	$name\n";
#		} else {
#			($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
#				$atime,$mtime,$ctime,$blksize,$blocks) = lstat($name);
#			$mode = sprintf ("%06o", $mode);
#
#			if ($mode =~ /^04/) {
#				if (opendir (FTWSTREAM, $name)) {
#					@dirlist = sort (grep (!/^\.\.?$/, readdir (FTWSTREAM)));
#					closedir (FTWSTREAM);
#				} else {
#					warn "failed	opendir $name, continuing\n";
#					@dirlist = ();
#				}
#
#				(!$dirslast) && print "dirfir	owner $uid group $gid mode $mode name $name\n";
#				foreach $entry (@dirlist) {
#					&doit ("$name/$entry");
#				}
#				($dirslast) && print "dirlast	owner $uid group $gid mode $mode name $name\n";
#			} else {
#				print "nondir	owner $uid group $gid mode $mode name $name\n";
#			}
#		}
#	}
#
#	&doit ("/usr/bin");
#	&doit (".");
#
#  Usage:
#
#	The first call of ftwstream has args of starting path, boolean
#	true if dirs are to be returned before or after dir contents
#	(preorder or postorder), and list of entries to ignore.
#	Ignore entries are regexp's matched against the entire
#	pathname.  As such, they may be constructed to match filenames
#	in each directory or filenames from the root of the search.
#	Ignored entries are not returned and ignored directories are
#	not traversed:
#
#	     &ftwstream ("/etc", 0, ('\/DEPOT\..*$', '^\/etc\/namedb$'));
#
#	Giving a new set of arguments before a walk finishes starts a
#	new walk.  Subsequent calls to ftwstream during a filesystem
#	walk have no args:
#
#	     &ftwstream;
#
#	ftwstream returns a list.  The mode is the string representation of
#	the octal, for example "100644".  When the last file is processed
#	subsequent calls return with all values empty.  Entries are
#	sorted by directory and returned in order:
#
#	     (pathname, dev, ino, mode, nlink, uid, gid, rdev, size,
#		     atime, mtime, ctime, blksize, blocks)
#
#	Starting pathnames are return in the same form as they are given,
#	except that a trailing slash is stripped if the pathname isn't "/".
#	Do not put dotdot in a starting pathname:
#
#	     call				 returns for pathname
#	     ----------------------------------  --------------------
#	     &ftwstream ("/usr/bin", 0, ());	 /usr/bin
#	     &ftwstream;			 /usr/bin/Install_TeX
#
#	     #  Trailing slash on starting path
#	     &ftwstream ("/usr/bin/", 0, ());	 /usr/bin
#	     &ftwstream;			 /usr/bin/Install_TeX
#
#	     &ftwstream ("a", 0, ());		 a
#	     &ftwstream;			 a/CVS
#
#	     &ftwstream (".", 0, ());		 .
#	     &ftwstream;			 ./DEPOT.src
#
#	     &ftwstream ("/", 0, ());		 /
#	     &ftwstream;			 /.NeXT
#
#  Example Use:
#
#	@result = &ftwstream (".", 0, ());
#	while ($result[0] ne "") {
#		print "@result\n";
#		@result = &ftwstream;
#	}
#

sub ftwstream {
	package ftwstream;

	local ($newname, $newdirslast, @stoplist) = @_;

	#  First time setup for a particular walk
	if ($newname ne "") {
		#  Clean up trailing slashes on starting path except when pathname is "/"
		$newname =~ s/(.)\/$/\1/;

		#  Build ignore list; used to filter dotdot as well as any user stuff
		unshift (@stoplist, '\/\.\.$');
		$stopregexp = join ("|", @stoplist);

		#  Copy parameter into a static variable in ftwstream package
		$dirslast = $newdirslast;

		#  Initialize recursion-faking variable stacks and thread-faking fsm.  Muck about
		#  with subscripted variables directly rather than with easier to read non-
		#  subscripted variables because splitting, joining, and copying the dirlist for a
		#  big directory between a list and the array stack is slow.
		$level = 1;
		$name[$level] = $newname;
		$dirlist[$level] = "";
		$state[$level] = 1;
	}

	#  Exits when returning output to user
	for (;;) {

		#  Finished walk, no more entries to return
		if ($level == 0) {
			return (undef, undef, undef, undef, undef, undef, undef, undef, undef,
				undef, undef, undef, undef, undef);
		}

		if ($state[$level] == 1) {
			if ($name[$level] =~ /$stopregexp/) {
###				warn "ftwstream: excluded $name[$level], continuing\n";
				$level--;
			} else {
				$state[$level] = 2;
			}
		} elsif ($state[$level] == 2) {
			($dev[$level], $ino[$level], $mode[$level], $nlink[$level], $uid[$level], $gid[$level],
				$rdev[$level], $size[$level], $atime[$level], $mtime[$level], $ctime[$level],
				$blksize[$level], $blocks[$level]) = lstat($name[$level]);
			$mode[$level] = sprintf ("%06o", $mode[$level]);

			if ($mode[$level] =~ /^04/) {
				$state[$level] = 3;
			} else {
				#  Note "--" on last $level
				return ($name[$level], $dev[$level], $ino[$level], $mode[$level], $nlink[$level],
					$uid[$level], $gid[$level], $rdev[$level], $size[$level], $atime[$level],
					$mtime[$level], $ctime[$level], $blksize[$level], $blocks[$level--]);
			}
		} elsif ($state[$level] == 3) {
			#  If the starting path is "." then dot is listed the first time through.  Dot
			#  is never listed for subdirs because it is filtered from this readdir().

			if (opendir (FTWSTREAM, $name[$level])) {
				#  Filter out dot and dotdot.  Can't make an array of lists in
				#  perl4, so do it by hand with separators, bleah

				$dirlist[$level] = join ("\000", sort (grep (!/^\.\.?$/, readdir (FTWSTREAM))));
				closedir (FTWSTREAM);
			} else {
				warn "ftwstream: failed to opendir $name[$level], continuing\n";
				$dirlist[$level] = "";
			}

			$state[$level] = 4;
			if (!$dirslast) {
				return ($name[$level], $dev[$level], $ino[$level], $mode[$level], $nlink[$level],
					$uid[$level], $gid[$level], $rdev[$level], $size[$level], $atime[$level],
					$mtime[$level], $ctime[$level], $blksize[$level], $blocks[$level]);
			}
		} elsif ($state[$level] == 4) {
			#  Only mess with the front of the list.  If the directory is big messing
			#  with the whole list is slow.

			if (($theindex = index ($dirlist[$level], "\000")) >= 0) {
				#  Separator found
				$entry = substr ($dirlist[$level], 0, $theindex);
				substr ($dirlist[$level], 0, $theindex + 1) = "";
			} else {
				#  No separator found, may be last entry or no entries left
				$entry = $dirlist[$level];
				$dirlist[$level] = "";
			}

			if ($entry ne "") {
				$state[$level] = 4;
				if (substr ($name[$level], -1, 1) eq "/") {
					$name[$level + 1] = "$name[$level]$entry";
				} else {
					$name[$level + 1] = "$name[$level]/$entry";
				}
				$state[++$level] = 1;
			} else {
				$state[$level] = 5;
			}
		} elsif ($state[$level] == 5) {
			$state[$level] = 6;
			if ($dirslast) {
				return ($name[$level], $dev[$level], $ino[$level], $mode[$level], $nlink[$level],
					$uid[$level], $gid[$level], $rdev[$level], $size[$level], $atime[$level],
					$mtime[$level], $ctime[$level], $blksize[$level], $blocks[$level]);
			}
		} elsif ($state[$level] == 6) {
			$level--;
		} else {
			die "ftwstream: unknown state $state[$level]";
		}
	}
	die "ftwstream: should never reach this statement";
}
