#!/usr/bin/perl
#
# The following script can be used to 'copy' executables to a chroot directory.
# Go to the directory that will be the new rootdirectory for Hiawatha
# (ServerRoot setting in httpd.conf) and run the script from there. The script
# takes a full path to an exectable as a parameter.
#
# Example: 'newroot /bin/bash' will hardlink bash and the libraries that bash
# needs, including their paths, to the current directory.
#
#--< newroot >-----------------------------------------------------------------

$method = 'ln'; # Change to 'cp' to copy the file.
chomp($cwd = `/bin/pwd`);

sub newroot() {
	my $file = @_[0];

	@field = split("/", $file);
	$filename = pop(@field);
	$path = join("/", @field);

	system("/bin/mkdir -p .".$path);
	if (-l $file) {
		$linkto = readlink($file);
		if (substr($linkto, 0, 1) eq "/") {
			$file = $linkto;
		} else {
			$file = $path."/".$linkto;
		}
		if (! -e ".".$file) {
			print $file." -> .".$file."\n";
			system("/bin/".$method." ".$file." .".$file);
		}
		if (! -e ".".$path."/".$filename) {
			print ".".$path."/".$filename." -> .".$path."/".$linkto."\n";
			chdir(".".$path);
			system("/bin/ln -s ".$linkto." ".$filename);
			chdir($cwd);
		}
	} else {
		if (! -e ".".$file) {
			print $file." -> .".$file."\n";
			system("/bin/".$method." ".$file." .".$file);
		}
	}
}

sub need_libs() {
	my $file = @_[0];

	@ldd = `/usr/bin/ldd $file`;
	for ($i = 0; $i <= $#ldd; $i++) {
		$ldd[$i] =~ s/^.*=> //;
		$ldd[$i] =~ s/ \(.*\n$//;
	}

	return @ldd;
}

sub process() {
	my $file = @_[0];

	&newroot($file);
	@libs = &need_libs($file);
	for $lib (@libs) {
		&newroot($lib);
	}
}

sub file_exists() {
	my $file = @_[0];

	if (open(FILE, $file)) {
		close(FILE);

		return 0;
	} else {
		return -1;
	}
}

sub main() {
	my @argv = @_;
	
	if ($#argv > 0) {
		if (substr($argv[1], 0, 1) eq '/') {
			if (&file_exists($argv[1]) == 0) {
				&process($argv[1]);
			} else {
				print("file not found.\n");
			}
		} else {
			print("enter complete path of file.\n");
		}
	} else {
		printf("Usage: %s <executable>\n", $argv[0]);
	}
}

&main($0, @ARGV);

#---------------------------------------------------------------------< EOS >--
