#!/usr/bin/perl
# <PRE>
# This document is in text, HTML, and perl script format.

sub __GNUC__ { 1 }
$|=1;  # prevent stderr/stdout conflicts; 

# /tmp cleaner script by zblaxell@myrus.com (Zygo Blaxell)
# Version 2.11, 96/05/08
# Added 'ADD_DATE' variable

# Version 2.1, 96/05/07
# Fixed long-standing stat_fs bug

# Version 2.0, 96/05/06
# Fairly major restructuring.  Now the children are forked on initial 
# startup, whether reaping is necessary or not.  The logging
# information is reorganized.
# The specification for threshold space levels is now one of:
# number	- percentage of disk
# number K	- kilobytes
# number M	- megabytes

# Version 1.31, 96/05/01
# Only print STDERR "Disk usage increased:" if QUIET is not set.

# Version 1.3, 96/04/26
# If we have a dangling symlink, ignore its atime.  We keep changing it
# with readlink().

# Version 1.24, 96/04/25
# Changes to constant strings in output and comments.  I was going to
# make a change, but then decided that the status quo is a feature.

# Version 1.23, 96/04/12
# Use 'localtime()' more often to print out dates.  No change in behavior.

# Version 1.22, 96/04/10
# Corrects a couple of reporting bugs (negative disk space and incorrect
# file size).  No change in behavior.

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

# No warranties express or implied; see the GNU GPL for copying
# restrictions.

# You may get a copy of the software licence from:

# ftp://ftp.gnu.ai.mit.edu/pub/gnu/COPYING

# This is filereaper, a stripped-down version of gfreaper.
# Actually, it's partly stripped-up too.

# This script is designed to maintain a particular amount of free
# disk space on a partition by deleting files in a directory structure.
# For example, if you wanted to always have 3% free space in /tmp, use:

# filereaper 3 /tmp

# Files are deleted in order approximated by "oldest files first".
# Actually, there are some anomalies where symbolic links and
# directories are concerned.  Directories are considered one second
# older than the oldest file in them.  Symbolic links are considered one
# second newer than the file that they point to, or their own age if they
# don't point to a file.  Directories can be maintained by typing 'ln -s
# . ...' in them--this will delete everything in the directory, of course,
# but never the directory itself (actually, filereaper never deletes the
# symlink, thus preserving the directory which never gets emptied).

# This program also maintains some state between reapings that allows it
# to run more efficiently.  It can begin deleting files within two
# seconds of low-disk-space conditions occurring.

# This program understands some security issues that many other programs
# (and some sysadmins) don't.  I don't know how many times I have seen:

# 0 * * * * find /tmp -mtime +1 -exec rm -f {} \;

# or, even worse:

# 0 * * * * find /tmp -mtime +1 -print | xargs rm -f

# in crontab files running as root.

# The problem with these is that they can be used by any hostile user
# with write access to /tmp to delete any file on the filesystem.  In the
# second case, the exploit is trivially easy.  To delete /etc/passwd and
# /etc/group:

# $ touch '/tmp/this filename contains whitespace and newlines
# /etc/passwd
# /etc/group'

# In the first case, you need to exploit a race condition between find
# and rm (which is exacerbated by xargs, I might add).  Consider a file
# named '/tmp/foo/bar/baz/a/b/c/d/e/etc/passwd'.  The race condition is
# exploited thus:

# [find feeds '/tmp/foo/bar/baz/a/b/c/d/e/etc/passwd' to 'rm']
# $ mv /tmp/foo/bar/baz/a/b/c/d/e/etc /tmp/e
# $ ln -s /etc /tmp/foo/bar/baz/a/b/c/d/e/etc
# [rm now deletes '/tmp/foo/bar/baz/a/b/c/d/e/etc/passwd', but the
# directory '/tmp/.../etc' is now a symlink to the real '/etc', so in fact
# rm will actually delete '/etc/passwd'.]

# With some creativity it is possible to make stat() calls take several
# minutes, so this race condition is not difficult to exploit.  Consider
# what happens when you call stat() on a path with 500 directory
# components, each of which is actually a symlink 8 levels deep through
# 500 other directory components.  Each.  We're talking about reading
# almost the entire inode table into memory here just to do ONE stat()
# call, and that can't be very fast.  The attacker just moves the first
# directory component aside and puts a symlink to '/etc/' (or wherever) in
# its place, so the actual unlink() call to the wrong file will be nice
# and fast.

# Incidentally, since these examples use '-mtime', the file modification
# time is used to schedule file deletion.  Since the file modification
# time is entirely under the control of the user, the user can delete any
# file they want deleted, when they want it deleted, and they can
# prevent their own files from being deleted.  Use '-ctime' instead.  If
# your 'find' doesn't have this feature, 'rm -f /usr/bin/find' (in case
# someone else tries to use it) and get one of the freely-available
# replacements, or write your own.

# ONCE AGAIN:  DO NOT USE:
# 0 * * * * find /tmp -mtime +1 -exec rm -f {} \;
# IN ROOT'S CRONTAB.  YOU WILL ALLOW ANY USER TO DELETE ANY FILE ON THE
# SYSTEM.  THIS IS A SECURITY HOLE THAT IS EASY TO EXPLOIT.  There, that
# should place this document in a few full-text search engines.  :-)

# There are alternatives to this that work.  One is:
# 0 * * * * find /tmp -mtime +1 -exec safe_rm -f {} \;

# where 'safe_rm' implements an algorithm similar to 'ch_dir' in this
# program.  The algorithm is:

# If any system call below fails, exit.
# chdir("/");
# split name into a list of path components and a filename.  The
# filename must be non-empty and does not contain "/".
# for each member of list:
#	old1=lstat(member) (save the device and inode numbers in old1)
#	old2=lstat(".")    (save the device and inode numbers in old2)
#	chdir(member)
#	new1=lstat(".")
#       new2=lstat("..")
#       if (old1 != new1 || old2 != new2) exit
# next member
# unlink or rmdir (filename)

# This avoids the race condition by not following symlinks in the
# directory components of the path name.  Attempts to exploit the
# find/unlink race condition will fail because the ch_dir routine will
# fail if it encounters a symbolic link in the directory components of
# the path name.

# This is not perfect; however, it is necessary for the user to be able
# to write to parent directories in a path name in order to subvert files
# later in a path name.  For instance, consider:

# /tmp/user1/
# /tmp/foo/bar/root/user2

# where 'user1' is owned by user1, 'root' is owned by root and not
# writable, and 'user2' is a file owned by user2.  User1 cannot delete
# '/tmp/foo/bar/root/user2', because 'root' is not writable by user1.

# However, User1 can exploit the security vulnerabiltiies left in the
# algorithm above to cause the daemon to delete /tmp/foo/bar/root/user2 IF
# AND ONLY IF /tmp/foo and /tmp/foo/bar are writable by user2, as follows:

# 1.  Create files and directories such that '/tmp/user1/bar/root/user2'
#     exists.
# 2.  Wait for 'find' to output the name '/tmp/user1/root/user2'.
# 3.  'mv /tmp/user1/bar /tmp/user1/BAR'
# 4.  'mv /tmp/foo/bar /tmp/user1'.  This moves
#     '/tmp/foo/bar/root/user2' to '/tmp/user1/bar/root/user2'.
# 5.  The safe_rm will now delete '/tmp/user1/bar/root/user2'.  Because
#     there are no symlinks, no anomalies will be detected.

# This program has additional checks to try to prevent attacks like this.
# It can still be exploited if /tmp/user1/bar/root/user2 is a hard link
# to /tmp/foo/bar/root/user2.

# The moral of the story is:  if someone can write to your parent
# directory, all bets are off.

# Note that in real life, /tmp should be mode 1777, i.e. it has the
# sticky bit set.  In this case /tmp/foo has to be owned by user1 for
# the exploit to work.  RTFM chmod(1,2) if you want to know why.

# This program also does chroot() to the base of filesystems to be reaper,
# if run as root, for extra security.

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

# Here's a sample script to run from /etc/rc* at boot time.  Remove '### '
# from the beginning of every line.

### #!/bin/sh
### # Filereaper sample script by Zygo Blaxell (C) 1996
### # License: ftp://ftp.gnu.ai.mit.edu/pub/gnu/COPYING
### 
### # Prevent core dumps.  Those would be bad, even when chroot.
### ulimit -c 0
### # Set PATH so we can find filereaper
### PATH=/bin:/usr/bin:/usr/local/bin:/sbin:/usr/sbin:/usr/local/sbin
### 
### {
###     # Delete old files in spool and temp directories if <1% free space.
###     # The /*/windows/temp tries to get /[CD]/windows/temp on our systems.
###	# Yes, we've been forced to use Windows '95, hence /*/recycled.
###	# When we have multiple partitions, there is a /tmp on each.
###	# You probably want this at elevated priority to prevent disks
###	# from getting filled faster than they can be emptied, hence 'nice'.
### 
###     ADD_DATE=true QUIET=true INTERVAL=60 nice -n -20 filereaper 1 /*/tmp /tmp /*/recycled /*/windows/temp
### 
### } >>/var/log/filereaper 2>&1 &

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

# Variables:

# inode_info{inode} = age\0(parent_inode_number,name\0)+
#                    Information about an inode.

# oldest_age = oldest timestamp of files we let stand.

# root_inode = inode of highest-level directory to tmpclean (used to
#              stop searching backwards)

# root_dev = device number of root of filesystem (used to stop searching
#            other filesystems)

# root_path = string to prepend to all pathnames ("" if chroot,
#             "/foo/bar/baz" if not).

# min_spec = amount of space to keep free on filesystem (%, K, or M)

# ROOTAGE = minimum age of a file owned by root before we delete it.
# Use this if you have daemons writing stuff to /tmp that would be
# annoyed, destructive, or vulnerable if their /tmp files go away.

# Return values of ch_dir():
$CH_DIR_SUCCESS=0;
$CH_DIR_CROSS=1;
$CH_DIR_ERROR=2;

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

# Initialization
($min_spec,@given_filesystems)=@ARGV;
die <<USAGE unless ($min_spec =~ m/^\d+[%km]?$/i);
Usage:  $0 <space_to_keep_free> <filesystem> [<filesystem> [<filesystem> [...]]]
Deletes old files whenever the amount of free space on the filesystem drops
below <space_to_keep_free>.  The amount of space can be specified as one of
the following:

	<number>	- percentage of total disk space available to users
	<number>%	- same as <number>
	<number>K	- number of kilobytes
	<number>M	- number of megabytes

Environment Variables (set them if you want them):
TEST    - test only, don't actually delete any files
          (default of course is to really delete files)
DEBUG   - print STDERR debugging information
          (default is to print STDERR only warnings and fatal and non-fatal errors,
          as well as the name of every file we try to delete)
NOATIME - ignore the atime of files, use ctime only.
          (default is to use the later of atime and ctime for non-directories.
          mtime can be set by the file owner to any value, so it's ignored)
ROOTAGE - minimum age of files owned by root in seconds.
          (by default, any file is eligible for deletion unless that
          file is owned by root and it is less than $ROOTAGE seconds old)
MINAGE  - minimum age applies to all users, not just root (boolean).
	  (by default, files not owned by root are always eligible for
          deletion)
INTERVAL- interval, in seconds, between FS checks.  Default 60.
          Negative values mean run only once.
QUIET	- don't print STDERR messages that explain why we aren't doing something
NODIRS	- don't preserve directories using 'ln -s . ...'.  By default,
          if a directory contains the symlink '...' with target '.', 
          it will never be deleted by this program.
ADD_DATE- prefix each output line with date and time.
USAGE

srand();

$min_spec =~ s/\d$/$&\%/o;

$TEST=$ENV{'TEST'};
$DEBUG=$ENV{'DEBUG'};
$NOATIME=$ENV{'ATIME'};  
$ROOTAGE=$ENV{'ROOTAGE'} || 24*60*60;
$MINAGE=$ENV{'MINAGE'};
$INTERVAL=$ENV{'INTERVAL'} || 60;
$QUIET=$ENV{'QUIET'};
$NODIRS=$ENV{'NODIRS'};
$ADD_DATE=$ENV{'ADD_DATE'};

print STDERR "$0 - parameter dump at ".localtime(time()).":\n";
print STDERR $> ? "Running as uid $>--can't chroot, will try to manage without it\n" : "Running as root, can and will do chroot\n";
print STDERR $TEST ? "Running in test mode only\n" : "This is not a test.\n";
print STDERR "Debugging messages enabled\n" if $DEBUG;
print STDERR "Will maintain $min_spec free space\n";
print STDERR $NOATIME ? "Will ignore atime of files\n" : "Will honour atime of files\n";
print STDERR "Minimum age of files owned by ", $MINAGE ? "all users" : "root", " is $ROOTAGE seconds.\n";
print STDERR "Will check filesystems every $INTERVAL seconds.\n";
print STDERR $QUIET ? "Will suppress spurious filesystem status messages\n" : "Will print STDERR spurious filesystem status messages\n";
print STDERR $NOATIME ? "Will ignore symlinks to '.' named '...'\n" : "Will not delete directories containing symlinks to '.' named '...'\n";

print STDERR "Reading passwd and group files...\n";
setpwent();
while (
    ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$dir,$shell) = getpwent
    ) {
        $username_of{$uid}=$name unless defined($username_of{$uid});
}
endpwent();
setgrent();
while (
    ($name,$passwd,$gid,$members) = getgrent
    ) {
        $groupname_of{$gid}=$name unless defined($groupname_of{$gid});
}
endgrent();
print STDERR "Done reading passwd and group files.\n";

$last_ch_dir="\0";

# Really go to work now...

print STDERR "Entering main loop\n";
$SIG{'CHLD'}="IGNORE";

while (1) {
	#print STDERR "Reaping filesystems at ".localtime()."\n" unless $QUIET;

	undef @filesystems;
	foreach (@given_filesystems) {
		local($chdir_result)=&ch_dir($_);
		if ($chdir_result) {
			# Arguably, the status of paths on the command line may change...
			print STDERR "$_ could not be found or crossed symlinks--will not try again.\n";
			next;
		}
		push(@filesystems,$_);
		# Grim File Reaper...
		if ($fs_to_pid{$_}) {
			print STDERR "Still running: pid $fs_to_pid{$_}, fs $_\n" unless $QUIET;
			next;
		}
		$parent_pid=$$;
		$child=fork();
		unless (defined($child)) {
			warn "Didn't fork?  $!";
			next;
		}
		if (!($child)) {
			# Child of fork()
			$other_parent_id=$$;
			unless (open(STDERR ,"|-")) {
				# Child of open()
				die "Didn't fork?  $!" if ($$ == $other_parent_id);
				while ($in=<STDIN>) {
					if ($ADD_DATE) {
						print STDERR localtime()." $_: $in";
					} else {
						print STDERR "$_: $in";
					}
				}
				print STDERR "$_: Done\n" unless $QUIET;
				exit(0);
			} else {
				# parent of open()
				open(STDOUT,">&STDERR ") || die "Dup stderr: $!";
			}
			&reap($_);
			exit(0);
		} else {
			# Parent of fork()
			#print STDERR "Reaping $_ in pid $child\n";	# Hardly spurious...
			$pid_to_fs{$child}=$_;
			$fs_to_pid{$_}=$child;
		}
	}
	@given_filesystems=@filesystems;

	#print STDERR "Idle.\n" unless $QUIET;
	sleep($INTERVAL) if $INTERVAL>=1;

	for $child (keys(%pid_to_fs)) {
		next if kill(0,$child); # test for existence
		#print STDERR "Child $child no longer exists, free to clean $pid_to_fs{$child} again.\n";
		delete $fs_to_pid{$pid_to_fs{$child}};
		delete $pid_to_fs{$child};
	}
	last if $INTERVAL<0;
}
exit(0);

# reap(directory);
# Does the GFR bit in a given directory.  Sets up inodes, sets up state 
# for directory trees.

sub reap {
        ($root_path)=@_;
	local($begin_reaping)=time();                    # reference point to "now" - saves time() calls
        &ch_dir($root_path) && die "chdir '$root_path' failed.  Aborting.\n";
        if ($>) {
                print STDERR "Not root, so can't chroot.  Too bad.\n";
        } else {
                print STDERR "Running as root.  Doing chroot($root_path)..." unless $QUIET;
                local(@stat1)=(lstat("."))[0,1];
                die "Couldn't lstat '.' in '$root_path': $!\n" unless defined($stat1[0]);
                chroot(".") || die "chroot failed ($!).  Aborting.\n";
                chdir("/") || die "chdir '/' failed in chroot ($!).  Aborting.\n";
                local(@stat2)=(lstat("."))[0,1];
                die "Couldn't lstat '.' in '$root_path' after chroot: $!\n" unless defined($stat2[0]);
                local(@stat3)=(lstat(".."))[0,1];
                die "Couldn't lstat '..' in '$root_path' after chroot: $!\n" unless defined($stat3[0]);
                local(@stat4)=(lstat("/"))[0,1];
                die "Couldn't lstat '/' in '$root_path' after chroot: $!\n" unless defined($stat4[0]);
                # After chroot, '/' should be the same as '.' and '..',
                # which should be the same as '.' before chroot.
                die "I don't believe I have chrooted successfully.  Aborting.\n" if
                        (join(" ",@stat1) ne join(" ",@stat2) ||
                        join(" ",@stat2) ne join(" ",@stat3) ||
                        join(" ",@stat3) ne join(" ",@stat4));
                print STDERR "Successfully chroot($root_path)\n" unless $QUIET;
                $root_path='';
		$last_ch_dir="\0";
        }
        ($root_dev,$root_inode)=(lstat("."))[0,1];
	die "Couldn't lstat '.' in '$root_path': $!\n" unless defined($root_dev);

        print STDERR "Gathering filesystem information\n" unless $QUIET;
        &get_dir($root_path);

	local($want_before_reaping)=&stat_fs();

        $oldest_age=time();

	print STDERR "Waiting for go-ahead\n" unless $QUIET;
	local($want)=&stat_fs();
	local($lastwant)=$want;
	until ($want>0) {
		sleep(2);
		$want=&stat_fs();
		print STDERR (-$want)." bytes left\n" if ($want>$lastwant) && !$QUIET;
		$lastwant=$want if $lastwant<$want;
	}

	print STDERR "Now reaping files\n" unless $QUIET;

inode:
	for $inode (sort { $inode_info{$a} <=> $inode_info{$b} } keys(%inode_info)) {
		local($inode_age,@other_stuff)=split(/\0/,$inode_info{$inode});
		$oldest_age=$inode_age;
		
		local($want)=&stat_fs();
                if ($want<=0) {
			# We hang around until we run out of inodes,
			# Then our parent starts us again.
                        print STDERR "Want $want bytes...pausing...Oldest file is stamped ".localtime($oldest_age)."\n";
			local($lastwant)=$want;
			until ($want>0) {
				sleep(2);
				$want=&stat_fs();
				print STDERR (-$want)." bytes left\n" if ($want>$lastwant) && !$QUIET;
				$lastwant=$want if $lastwant<$want;
			}
                }

		$count=0;
name:
                foreach $file_name (&get_names($inode)) {
                        local($dir,$file)= $file_name =~ m!^(.*)/(.*)$!;

			($was_link,$link_target,$was_dir)=&get_inode_info($dir,$file);
			next name unless defined($was_link);

			unless ($count++) {
				print STDERR "Want $want bytes, reaping inode $inode, age ".localtime($inode_age).", owner " .
					($username_of{$ino_uid} || ":$ino_uid:") . ":" . 
					($groupname_of{$ino_gid} || ":$ino_gid:") . ", size " . ($link_blocks*512) . "\n";
				if ( ( ! $ino_uid || $MINAGE ) && $inode_age > time()) {
					print STDERR "skipping: Inode $inode name '$dir/$file' is owned by " .
						($username_of{$ino_uid} || ":$ino_uid:") . ":" . 
						($groupname_of{$ino_gid} || ":$ino_gid:") . " and not old enough (",time()-$inode_age,").\n";
					next inode;
				}
				# Timestamps of directories are changed by gfreaper.
				unless ($was_dir) {
					local($new_age);
					if ($ino_atime>$ino_ctime && !$NOATIME && $ino_atime < time()+1) {
						$new_age=$ino_atime;
					} else {
						$new_age=$ino_ctime;
					}
					$new_age+=$ROOTAGE if ( ( ! $link_uid || $MINAGE ));
					$new_age-- if $was_link;
					print STDERR "old age $inode_age, new age $new_age\n" if $DEBUG;
					if ($new_age > $inode_age) {
						print STDERR "skipping: Inode $inode name '$dir/$file' age is newer (".localtime($new_age)." > ".localtime($inode_age).")\n";
						next inode;
					}
				}
			}

			if ($link_dev != $root_dev) {
				warn "skipping: Inode $inode name '$dir/$file' is not on the correct filesystem ('$link_dev' should be '$root_dev').\n";
				next name;
			}
			if ($link_ino != $inode) {
				warn "skipping: Name '$dir/$file' is associated with new inode ('$link_ino' should be '$inode')\n";
				next name;
			}

			print STDERR "Reaping: $file_name\n";
                        if ($TEST) {
                                print STDERR "Pretending to unlink $dir/$file\n";
                        } else {
                                if ( $was_dir ) {
                                        unless (rmdir($file)) {
						warn "rmdir('$file') in '$dir' failed: $!\n";
						next name;
					}
                                } else {  # if -d _ ...
                                        unless (unlink($file)) {
						warn "unlink('$file') in '$dir' failed: $!\n";
						next name;
					}
                                }
                        } # if $TEST...
                } # foreach (&get_names...
        } # for $inode (...

	# Done reaping, print STDERR reapage stats
        printf STDERR ("All files deleted.  Run time (seconds):  User %d, Sys %d, Total %d, Real %d\n",
                (times)[0],(times)[1],(times)[0]+(times)[1],time()-$begin_reaping) unless $QUIET;
}

# get_names(inode); 
# Finds the full pathnames of all links to the given inode, and appends
# all of the names in basename.  

sub get_names {
        local($inode)=@_;

        # The inode has a list of parents, and a separate list of names
        # under each parent.  We must find each parent, and prepend its
        # name to all the names of the inode under that parent.

        # There are no parents of the root inode.

	# This is a little bogus in perl.  Infinite loops are possible
	# here if you can rewrite the directory structure a bit, 
	# particularly if you can change the parent/child relationships
	# on directories.

        print STDERR "get_names called on $inode (root=$root_inode)\n" if $DEBUG;

        return ($root_path) if ($inode==$root_inode);

	if (!($inode_info{$inode})) {
		die "WARNING:  get_names called on unknown inode $inode";
	}
	
	local($age,@names)=split(/\0/,$inode_info{$inode});
	local(%my_names);
	foreach (@names) {
		local($parent_inode,$name)=m/^(\d+),([\000-\377]+)$/;
		warn "WARNING:  parent_inode is null?" unless $parent_inode;
		foreach (&get_names($parent_inode)) {
			$my_names{"$_/$name"}++;
		}
	}

        warn "WARNING:  No names found for '$inode'" unless keys(%my_names);
	print STDERR "get_names($inode)=".join(" ",keys(%my_names))."\n" if $DEBUG;
	return sort(keys(%my_names));
}
        
# get_dir(directory,parent_inode);
# Incorporates information about all files in the directory into the
# global database.  Returns the age of the newest file in the directory.

sub get_dir {
        local($directory)=@_;
	local($newest_child_age)=0;
        print STDERR "get_dir($directory)\n" if $DEBUG;
	($was_link,$link_target,$was_dir)=&get_inode_info($directory,".");
	unless (defined($was_link)) {
                warn "Could not lstat '.' in '$directory': $!\n";
                return;
        }
        local($parent_inode)=$ino_ino;
        unless (opendir(DIR,".")) {
                warn "Couldn't opendir '.' in '$directory': $!\n";
                return;
        }
        local(@dirfiles)=readdir(DIR);
        closedir(DIR);
        foreach (@dirfiles) {
                next if /^\.\.?$/;  # Ignore '.' and '..'
		($was_link,$link_target,$was_dir)=&get_inode_info($directory,$_);
                next unless (defined($was_link));
                if ($link_dev != $root_dev) {
                        warn "Not crossing device in '$directory/$_' (root is $root_dev, $_ is $link_dev)\n";
                        # Not likely to be able to delete it, either...
                        # I guess we could explicitly umount it... ;-)
                        next;
                }
		local($inode)=$link_ino;
		local($inode_age,@parents)=split(/\0/,$inode_info{$inode});
		# file, fifo, block device, char device, socket...
		if ($ino_atime>$ino_ctime && !$NOATIME && $ino_atime < time()+1) {
			$inode_age=$ino_atime;
		} else {
			$inode_age=$ino_ctime;
		}
                if ( $was_link ) { # symlink to extant file
			$inode_age--;	# guarantee symlink goes away before file does
		}
                $inode_age+=$ROOTAGE if ( ( ! $link_uid || $MINAGE ));
		if ($was_link && !$NODIRS && $link_target eq '.' && $_ eq '...') {
			# Omit this from inode list
			$inode_age=time();
		} else {
			if ( $was_dir ) { # directory
				$inode_age=$ino_ctime;
				local($subdir_age)=&get_dir("$directory/$_");
				$inode_age=$subdir_age if ($subdir_age>$inode_age);
			} 
			$inode_info{$inode}=join("\0",$inode_age,@parents,"$parent_inode,$_");
		}
		$newest_child_age=$inode_age if $inode_age>$newest_child_age;
		#print STDERR "$inode_info{$inode}\n";
        }
        return $newest_child_age+1;
}

$foo=<<TEST_HARNESS_FOR_GET_DIR; # actually for get_names too...
foreach (@ARGV) {
        print STDERR "get_dir($_)...\n";
        ($root_dev,$root_inode)=(stat($_))[0,1];
        $root_path=$_;
        $retval=&get_dir($_);
        foreach (keys(%parent_of)) {
                print STDERR "Names of inode $_ are:\n",join("\n\t",&get_names($_)),"\n";
        }
}
print STDERR "Exiting...\n";
exit(0);
TEST_HARNESS_FOR_GET_DIR

# stat_fs(percentage)
# Returns number of bytes left to be freed, assuming that percentage% of
# the space available to non-superuser is to be kept free.
# 
# On some systems you have to do sync() before statfs.  It's not portable:
# Solaris has stat_vfs, your mileage may vary.

# Linux only!  Port to your own operating system!
sub SYS_statfs { 99 }

sub stat_fs {
        local($struct_statfs)="III III II2I I6";
        local($param)=pack($struct_statfs,0);
	local($dir)="$root_path/";
        if (syscall(&SYS_statfs,$dir,$param) == -1) {
                warn "statfs($dir) failed: $!\n";
                return 0;
        }
        local($f_ftype,$f_bsize,$f_blocks,$f_bfree,$f_bavail,$f_files,
                $f_ffree,$f_fsid1,$f_fsid2,$f_namelen,
                @f_spare)=unpack($struct_statfs,$param);
        print STDERR "statfs: ",join(",",unpack($struct_statfs,$param)),"\n" if $DEBUG;
        local($root_saved)=($f_bfree-$f_bavail);
	local($required_user_free);
	if ($min_spec =~ /^(\d+)\%$/o) {
		$required_user_free=int(($f_blocks-$root_saved)*($1)/100);
	} elsif ($min_spec =~ /^(\d+)k$/io) {
		$required_user_free=$1;
	} elsif ($min_spec =~ /^(\d+)m$/io) {
		$required_user_free=($1)*1024;
	}
        print STDERR "root_saved=$root_saved, required_user_free=$required_user_free\n" if $DEBUG;
        return ($required_user_free-$f_bavail)*1024;
}

$foo=<<TEST_HARNESS_FOR_STAT_FS;
foreach (@ARGV) {
        print STDERR "statfs($_)...\n";
        &ch_dir($_) && warn "ch_dir error\n";
        $retval=&stat_fs();
        print STDERR "statfs($_) returned $retval\n";
}
exit(0);
TEST_HARNESS_FOR_STAT_FS
        
# ch_dir(directory);
# Changes to the directory specified, checking for symlinks.
# Returns:  0 if successful
#           1 if a symlink was crossed
#           2 for other error
# In the event of a non-success, the current directory is untrustworthy.

sub ch_dir {
        local($directory)=@_;
        chdir("/") || return $CH_DIR_ERROR;
        local($path_so_far)='';
        foreach (split(/\//,$directory)) {
                next unless length($_);
                local(@prev_dot_stat)=(lstat("."))[0,1];
                unless (defined($prev_dot_stat[0])) {
                        warn "Could not lstat '.' in '$path_so_far': $!\n";
                        return $CH_DIR_ERROR;
                }
                local(@prev_dir_stat)=(lstat($_))[0,1];
                unless (defined($prev_dir_stat[0])) {
                        warn "Could not lstat '$_' in '$path_so_far': $!\n";
                        return $CH_DIR_ERROR;
                }
                chdir($_) || return $CH_DIR_ERROR;
                local(@dot_dot_stat)=(lstat(".."))[0,1];
                unless (defined($dot_dot_stat[0])) {
                        warn "Could not lstat '..' in '$path_so_far/$_': $!\n";
                        return $CH_DIR_ERROR;
                }
                local(@dot_stat)=(lstat("."))[0,1];
                return $CH_DIR_ERROR unless defined($dot_stat[0]);
                unless (defined($dot_stat[0])) {
                        warn "Could not lstat '.' in '$path_so_far/$_': $!\n";
                        return $CH_DIR_ERROR;
                }
                # Strictly speaking, you really only need check '.' before
                # = '..' after.  I'm paranoid...
                if (join(" ",@dot_stat) ne join(" ",@prev_dir_stat)) {
                        warn "Crossed symlink entering '$path_so_far/$_':  '.' != '$path_so_far/$_'\n";
                        return $CH_DIR_CROSS;
                }
                if (join(" ",@dot_dot_stat) ne join(" ",@prev_dot_stat)) {
                        warn "Crossed symlink entering '$path_so_far/$_':  '..' != '$path_so_far'\n";
                        return $CH_DIR_CROSS;
                }
                $path_so_far.="/$_";
        }
        return $CH_DIR_SUCCESS;
}

$foo=<<TEST_HARNESS_FOR_CH_DIR;
foreach (@ARGV) {
        print STDERR "ch_dir($_)...";
        $retval=&ch_dir($_);
        print STDERR "ch_dir($_) returned $retval\n";
}
exit(0);
TEST_HARNESS_FOR_CH_DIR

sub get_inode_info {
	local($dir,$name)=(@_);
	print STDERR "get_inode_info($dir,$name)...\n" if $DEBUG;
	if ($last_ch_dir ne $dir) {
		if (&ch_dir($dir)) {
			warn "ch_dir '$dir' unsuccessful: $!\n";
			return undef;
		} else {
			$last_ch_dir=$dir;
		}
	}
	($link_dev,$link_ino,$link_mode,$link_nlink,$link_uid,$link_gid,$link_rdev,$link_size,$link_atime,
		$link_mtime,$link_ctime,$link_blksize,$link_blocks)=lstat($name);
	$inode_was_dir=(-d _);
	$inode_was_link=(-l _);
	if ($inode_was_link) {
		($ino_dev,$ino_ino,$ino_mode,$ino_nlink,$ino_uid,$ino_gid,$ino_rdev,$ino_size,$ino_atime,
			$ino_mtime,$ino_ctime,$ino_blksize,$ino_blocks)=stat($name);
		if (defined($ino_dev)) {
			$link_target=readlink($name);
			warn "Could not readlink '$name' in '$dir': $!\n" if (!defined($link_target));
		} else {
			warn "Could not stat (yes, stat) '$name' in '$dir': $!\n";
			( $ino_dev,  $ino_ino,  $ino_mode,  $ino_nlink,  $ino_uid,  $ino_gid,  $ino_rdev,  $ino_size,  $ino_atime,  $ino_mtime,  $ino_ctime,  $ino_blksize,  $ino_blocks)=
			($link_dev, $link_ino, $link_mode, $link_nlink, $link_uid, $link_gid, $link_rdev, $link_size, $link_atime, $link_mtime, $link_ctime, $link_blksize, $link_blocks);
			$ino_atime=$ino_ctime;
			$link_atime=$link_ctime;
		}
	} else {
		( $ino_dev,  $ino_ino,  $ino_mode,  $ino_nlink,  $ino_uid,  $ino_gid,  $ino_rdev,  $ino_size,  $ino_atime,  $ino_mtime,  $ino_ctime,  $ino_blksize,  $ino_blocks)=
		($link_dev, $link_ino, $link_mode, $link_nlink, $link_uid, $link_gid, $link_rdev, $link_size, $link_atime, $link_mtime, $link_ctime, $link_blksize, $link_blocks);
	}
	if (!defined($ino_dev)) {
		warn "Could not lstat '$name' in '$dir': $!\n";
		return undef;
	}
	return $inode_was_link,$link_target,$inode_was_dir;
}
# </PRE>