#!/usr/bin/perl

###############################################################################
#
# dirTest.pl - Directory tests for _AClassCreate
#
# AUTHOR:	Shawn Stepper, wiTHinc Inc.
# AUTHOR:	George Toye, wiTHinc Inc.
# DATE:		$Date: 2001/09/07 00:56:41 $ (last modified)
# COPYRIGHT:	1998, 1999, 2000, 2001 wiTHinc Inc. All Rights Reserved.
#
###############################################################################

$FileRevision = '$Id: dirTest.pl,v 1.1.2.4 2001/09/07 00:56:41 stepper Exp $';
$Version = '1.4.0';

if (@ARGV[0] eq "-v" || @ARGV[0] eq "--version") {
	print "File:		$0\n";
	print "Revision:	$FileRevision\n";
	print "Version:	$Version\n";
	exit();
}

1;

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

sub printDirTest {
	my($CGIQuery) = @_;
	my(%created, $retval, $FontGreen, $sep);
	
	use Socket;
	
	# Turn off buffering
	$| = 1;
	
	$FontGreen = "<font color=\"#339900\">";
	
	my($C_rootpath, $C_rooturl, $C_photodir, $C_photourl, $C_listdir) = &cleanDirData($CGIQuery);
	
	&checkEmpties($CGIQuery, $C_rootpath, $C_rooturl, $C_photodir, $C_photourl, $C_listdir);

	&showHeaderBackHTML("Directory and URL Tests", "<br>");

	# Start by doing directory existence/creation tests
	print "<b>Testing $CorF Directory: $C_rootpath</b><br>\n";
	if (-e $C_rootpath) {
		if (-w $C_rootpath) {
			print $FontRed, "Warning: </font>\n";
			print "The $CorF Directory ($C_rootpath) already exists. Please double check to make sure this is the directory you want to use.<p>\n";
		} else {
			print $FontRed, $FontSize2, "ERROR: </font></font>\n";
			print "Cannot write to $CorF Directory ($C_rootpath). The directory exists, but is not writable by the web server. Please choose a different directory or modify the file permissions for the directory.";
			exit();
		}
	} else {
		@newdirs = &makeTestDir($C_rootpath);
		if ($newdirs[0] =~ /^The directory/) {
			print $FontRed, $FontSize2, "ERROR: </font></font>\n";
			print $newdirs[0];
			print "<br><br><br>\n";
			&dirTestExit(%created);
		}
		$created{"C_rootpath"} = [ @newdirs ];
	}
	print $FontGreen, $CorF, " Directory Test Successful!</font><br><br><br>\n";
	
	# Photo Directory
	print "<b>Testing Photo Directory: $C_photodir</b><br>\n";
	if (-e $C_photodir) {
		if (-w $C_photodir) {
			print $FontRed, "Warning: </font>\n";
			print "The Photo Directory ($C_photodir) already exists. Please double check to make sure this is the directory you want to use.<p>\n";
		} else {
			print $FontRed, $FontSize2, "ERROR: </font></font>\n";
			print "Cannot write to Photo Directory ($C_photodir). The directory exists, but is not writable by the web server. Please choose a different directory or modify the file permissions for the directory.\n";
			print "<br><br><br>\n";
			&dirTestExit(%created);
		}
	} else {
		@newdirs = &makeTestDir($C_photodir);
		if ($newdirs[0] =~ /^The directory/) {
			print $FontRed, $FontSize2, "ERROR: </font></font>\n";
			print $retval;
			print "<br><br><br>\n";
			&dirTestExit(%created);
		}
		$created{"C_photodir"} = [ @newdirs ];
	}
	print $FontGreen, "Photo Directory Test Successful!</font><br><br><br>\n";
	
	print "<b>Testing Mailing List Directory: $C_listdir</b><br>\n";
	if (-e $C_listdir) {
		if (-w $C_listdir) {
			print $FontRed, "Warning: </font>\n";
			print "The Mailing List Directory ($C_listdir) already exists. Please double check to make sure this is the directory you want to use.<p>\n";
		} else {
			print $FontRed, $FontSize2, "ERROR: </font></font>\n";
			print "Cannot write to Mailing List Directory ($C_listdir). The directory exists, but is not writable by the web server. Please choose a different directory or modify the file permissions for the directory.\n";
			print "<br><br><br>\n";
			&dirTestExit(%created);
		}
	} else {
		@newdirs = &makeTestDir($C_listdir);
		if ($newdirs[0] =~ /^The directory/) {
			print $FontRed, $FontSize2, "ERROR: </font></font>\n";
			print $retval;
			print "<br><br><br>\n";
			&dirTestExit(%created);
		}
		$created{"C_listdir"} = [ @newdirs ];
	}
	print $FontGreen, "Mailing List Directory Test Successful!</font><br><br><br>\n";

	###############################################################
	# Create files to test
	$testFile = "dirTest.html";
	
	$sep = "/";
	if ($C_rootpath =~ /\\/ && $isWin) {
		$C_rootpath =~ s/\\/\//g;
	}
	
	print "<b>Testing Root URL: $C_rooturl</b><br>";
	$rootTest = $C_rootpath . $sep . $testFile;
	if (!open(testf, ">$rootTest")) {
		print $FontRed, $FontSize2, "ERROR: </font></font>\n";
		print "Unable to create a file (", $rootTest, ") in Root ";
		print $CorF, " Directory ($C_rootpath). Please choose a different ";
		print "directory or modify the file permissions for the ";
		print "directory.<br><br><br>\n";
		&dirTestExit(%created);
	}
	print testf "DIRTEST OK";
	close(testf);
	
	$created{"rootTest"} = $rootTest;
	
	# Socket Initializations
	$proto = getprotobyname('tcp');
	
	if (($port = $ENV{"SERVER_PORT"}) eq "") {
		$port = 80;
	}
	
	if ($ENV{'SERVER_ADDR'} ne "") {
		$sin = sockaddr_in($port,inet_aton($ENV{'SERVER_ADDR'}));
	} elsif ($ENV{'SERVER_NAME'} ne "") {
		$sin = sockaddr_in($port,inet_aton($ENV{'SERVER_NAME'}));
	} else {
		$sin = sockaddr_in($port,INADDR_LOOPBACK);
	}
	
	# Test rooturl
	socket(Socket_Handle, PF_INET, SOCK_STREAM, $proto);
	connect(Socket_Handle,$sin);
	$msg = "GET " . $C_rooturl . "/" . $testFile . " HTTP/1.0\r\n\r\n";
	send(Socket_Handle, $msg, "");
	
	if (defined(recv(Socket_Handle, $rec, 2048, ""))) {
		if ($rec =~ /DIRTEST OK/) {
			print $FontGreen, "Root URL Test Successful!</font>\n";
		} else {
			print $FontRed, $FontSize2, "ERROR: </font></font>\n";
			print "Root URL is incorrect. Please make sure that the Root URL ";
			print "corresponds correctly to the $CorF Root Directory. ";
			print "Contact your system administrator if you are having ";
			print "trouble determining the appropriate Root URL.";
			print "<br><br><br>\n";
			&dirTestExit(%created);
		}
	} else {
		print $FontRed, $FontSize2, "Socket Error</font></font>: ";
		print "Maybe you are missing Socket.pm? Unable ";
		print "to verify Root URL.\n";
	}
	
	print "<br><br><br>\n";
	close(Socket_Handle);
	
	# Test photourl
	$sep = "/";
	if ($C_photodir =~ /\\/ && $isWin) {
		$C_photodir =~ s/\\/\//g;
	}
	
	print "<b>Testing Photo URL: $C_photourl</b><br>";
	$photoTest = $C_photodir . $sep . $testFile;
	if (!open(testf, ">$photoTest")) {
		print $FontRed, $FontSize2, "ERROR: </font></font>\n";
		print "Unable to create a file (", $photoTest, ") in Photo ";
		print "Directory ($C_photodir). Please choose a different ";
		print "directory or modify the file permissions for the ";
		print "directory.<br><br><br>\n";
		&dirTestExit(%created);
	}
	print testf "DIRTEST OK";
	close(testf);
	
	$created{"photoTest"} = $photoTest;
	
	socket(Socket_Handle, PF_INET, SOCK_STREAM, $proto);
	connect(Socket_Handle,$sin);
	$msg = "GET " . $C_photourl . "/" . $testFile . " HTTP/1.0\r\n\r\n";
	send(Socket_Handle, $msg, "");
	
	if (defined(recv(Socket_Handle, $rec, 2048, ""))) {
		if ($rec =~ /DIRTEST OK/) {
			print $FontGreen, "Photo URL Test Successful!</font>\n";
		} else {
			print $FontRed, $FontSize2, "ERROR: </font></font>\n";
			print "Photo URL is incorrect. Please make sure that the Photo URL ";
			print "corresponds correctly to the Photo Directory. ";
			print "Contact your system administrator if you are having ";
			print "trouble determining the appropriate Photo URL.";
			print "<br><br><br>\n";
			&dirTestExit(%created);
		}
	} else {
		print $FontRed, $FontSize2, "Socket Error</font></font>: ";
		print "Maybe you are missing Socket.pm? Unable ";
		print "to verify Photo URL.\n";
	}

	print "<br><br><br>\n";
	close(Socket_Handle);

	print $FontGreen, $FontSize2, "<b>All Tests Successful!</b></font></font><p>\n";

	&dirTestExit(%created);
}

sub dirTestExit {
	my(%created) = @_;

	&delTestCreated(%created);

	print "<a href=javascript:window.close()>";
	print $BtnClose;
	print "</a>\n";
	print "</body></html>\n";

	exit();
}

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

sub cleanDirData {
	my($CGIQuery) = @_;
	my($C_rootpath, $C_rooturl, $C_photodir, $C_photourl, $C_listdir);

	# Read in absolute directories
	$C_rootpath = $CGIQuery->param("C_rootpath");
	$C_rooturl = $CGIQuery->param('C_rooturl');
	$C_photodir = $CGIQuery->param('C_photodir');
	$C_photourl = $CGIQuery->param('C_photourl');
	$C_listdir = $CGIQuery->param('C_listdir');
	
	# Remove any trailing slashes
	$C_rootpath =~ s/\/$//;
	$C_rooturl =~ s/\/$//;
	$C_photodir =~ s/\/$//;
	$C_photourl =~ s/\/$//;
	$C_listdir =~ s/\/$//;

	# Paths have to be handled differently for Windows
	# Allow : in path for windows
	# Allow ~ in URL
	# Swap \ with / in URL
	if ($isWin) {
		$C_rootpath = &cleanWinPath($C_rootpath);
		$C_photodir = &cleanWinPath($C_photodir);
		$C_listdir = &cleanWinPath($C_listdir);
	} else {
		$C_rootpath = &replaceNonAlpha($C_rootpath);
		$C_photodir = &replaceNonAlpha($C_photodir);
		$C_listdir = &replaceNonAlpha($C_listdir);
	}
	# For urls. swap slashes, then URL escape any other weird characters
	$C_rooturl = &escapeAllButSlashesAndTilde(&swapSlashes($C_rooturl));
	$C_photourl = &escapeAllButSlashesAndTilde(&swapSlashes($C_photourl));
	
	return($C_rootpath, $C_rooturl, $C_photodir, $C_photourl, $C_listdir);
}

sub checkEmpties {
	my($CGIQuery, $C_rootpath, $C_rooturl, $C_photodir, $C_photourl, $C_listdir) = @_;
	
	if ($C_rootpath eq "") {
		&showErrorBackHTML("The <b>$CorF Directory</b> was left blank. Please enter a valid location for the $CorF Directory.");
		exit();
	}
	if ($C_rooturl eq "") {
		&showErrorBackHTML("The <b>Top Level URL</b> was left blank. Please enter a valid location for the Top Level URL.");
		exit();
	}
	if ($C_photodir eq "") {
		&showErrorBackHTML("The <b>Photo Directory</b> was left blank. Please enter a valid location for the Photo Directory.");
		exit();
	}
	if ($C_photourl eq "") {
		&showErrorBackHTML("The <b>Photo URL</b> was left blank. Please enter a valid location for the Photo URL.");
		exit();
	}
	if ($C_listdir eq "") {
		&showErrorBackHTML("The <b>Mailing List Directory</b> was left blank. Please enter a valid location for the Mailing List Directory.");
		exit();
	}
	
	# Check some variables
	if ($isWin) {
		if ($C_rootpath !~ /^\\|\/|^\w\:/ || $C_rooturl !~ /^\// || $C_photodir !~ /^\\|\/|^\w\:/ || $C_photourl !~ /^\//) {
			# These variables must have a preceding /, \ or \w:
			&showErrorBackHTML("The $CorF Directory, Top Level URL, Photo Directory and Photo URL must all be absolute, starting with a \"/\", \"\\\", or drive letter specification.");
			exit();
		}	
	} else {
		if ($C_rootpath !~ /^\// || $C_rooturl !~ /^\// || $C_photodir !~ /^\// || $C_photourl !~ /^\//) {
			# These variables must have a preceding /
			&showErrorBackHTML("The $CorF Directory, Top Level URL, Photo Directory and Photo URL must all be absolute, starting with a \"/\".");
			exit();
		}
	}
}

sub delTestCreated {
	my(%created) = @_;
	my($dir);
	
	if ($created{"photoTest"} ne "") {
		if ($isWin && $] >= 5.006) {
			unlink("./" . $Class . "photoTest.html");
			rename($created{"photoTest"}, "./" . $Class . "photoTest.html");
			unlink("./" . $Class . "photoTest.html");
		} else {
			unlink($created{"photoTest"});
		}
	}
	
	if ($created{"rootTest"} ne "") {
		if ($isWin && $] >= 5.006) {
			unlink("./" . $Class . "rootTest.html");
			rename($created{"rootTest"}, "./" . $Class . "rootTest.html");
			unlink("./" . $Class . "rootTest.html");
		} else {
			unlink($created{"rootTest"});
		}
	}
	
	if (@{$created{"C_listdir"}} > 0) {
		foreach $dir (@{$created{"C_listdir"}}) {
			&recursiveDelete($dir);
			# rmdir($dir);
		}
	}
	if (@{$created{"C_photodir"}} > 0) {
		foreach $dir (@{$created{"C_photodir"}}) {
			&recursiveDelete($dir);
			# rmdir($dir);
		}
	}
	if (@{$created{"C_rootpath"}} > 0) {
		foreach $dir (@{$created{"C_rootpath"}}) {
			&recursiveDelete($dir);
			# rmdir($dir);
		}
	}
}

# Build directory and file lists. recursive
sub recursiveDelete {
	my(@mydirs) = @_;
	my($i, @getdirs, $dir, @dirs, $sep);
	
	$sep = "/";
	if ($path =~ /\\/ && $isWin) {
		$path =~ s/\\/\//g;
	}
	
	for ($i=0; $i < @mydirs; $i++) {
		if ((-e $mydirs[$i] && -d $mydirs[$i])
						&& $mydirs[$i] !~ /$sep\.$|$sep\.\./) {
			push(@dirs, $mydirs[$i]);
			if ($isWin) {
				@getdirs = glob($mydirs[$i] . $sep . "*");
				push(@getdirs, glob($mydirs[$i] . $sep . ".*"));
			} else {
				if ($] >= 5.6 || $] >= 5.006) {
					@getdirs = glob($mydirs[$i] . $sep . "*");
					push(@getdirs, glob($mydirs[$i] . $sep . ".*"));
				} else {
					@getdirs = glob("\"$mydirs[$i]" . $sep . "\"*");
					push(@getdirs, glob("\"$mydirs[$i]" . $sep . "\".*"));
				}
			}
			chomp(@getdirs);
			&recursiveDelete(@getdirs);
		} elsif (-e $mydirs[$i] && $mydirs[$i] !~ /$sep\.$|$sep\.\./) {
			unlink($mydirs[$i]);
		}
	}
	
	# Delete directories - All files in directories have been deleted
	@dirs = reverse(@dirs);
	foreach $dir (@dirs) {
		if (-e $dir) {
			rmdir($dir);
		}
	}
}

sub makeTestDir {
	my($path) = @_;
	my($i, @pregetdir, @getdir, $checkdir, $prevdir, $errmsg, @made, $sep);

	# Remove any naughty characters from the path
	# already done before...
	# &pathClean($path);

	$sep = "/";
	if ($path !~ /\// && $path =~ /\\/ && $isWin) {
		$sep = "\\";
	} else {
		$path =~ s/\\/\//g;
	}

	@pregetdir = split(/$sep+/, $path);
	splice(@getdir,0);
	$checkdir = "";
	if ($isWin && $pregetdir[0] =~ /^\w\:/) {
		$prevdir = $pregetdir[0];
	} else {
		$prevdir = $sep;
	}
	for ($i=0; $i < @pregetdir; $i++) {
		if ($pregetdir[$i] ne "" && $pregetdir[$i] ne $sep) {
			push(@getdir, $pregetdir[$i]);
		}
	}
	
	for ($i=0; $i < @getdir; $i++) {
		if ($i == 0 && $isWin && $getdir[$i] =~ /^\w\:/) {
			$checkdir = $getdir[$i];
			next;
		} else {
			$checkdir .= $sep . $getdir[$i];
		}
		if (!(-e $checkdir &&  (-d $checkdir || -l $checkdir))) {
			# Directory does not exist, or is not a directory. Try to make it
			if (!-w $prevdir) {
				# Can't write to the directory
				$errmsg = "The directory chosen, $checkdir, could not be created because the parent directory, $prevdir, could not be created or is not writable. Please make the directory writable by the web server (world writable is OK).";

				return($errmsg);
			} else {
				if (!mkdir($checkdir, 0775)) {
					# Couldn't make directory for some reason
					$errmsg = "The directory, $checkdir, could not be created. Either the parent directory does not exist or is not writable by the web server.";

					return($errmsg);
				}
				
				push(@made, $checkdir);
			}
		}
		
		# Update the previous directory
		$prevdir = $checkdir;
	}
	
	@made = reverse(@made);
	
	return(@made);
}
