#!/usr/bin/perl

###############################################################################
#
# F_Init.pl - an include file for perl...
#
# AUTHOR:	Shawn Stepper, wiTHinc Inc.
# AUTHOR:	George Toye, wiTHinc Inc.
# DATE:		$Date: 2001/08/21 17:50:51 $ (last modified)
# COPYRIGHT:	1998, 1999, 2000, 2001 wiTHinc Inc. All Rights Reserved.
#
###############################################################################

$FileRevision = '$Id: F_Init.pl,v 1.48.2.3 2001/08/21 17:50:51 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();
}

# Choose the type of installation: Educational or Other
# This changes Class<=>Forum, Faculty<=>Moderator etc.
# $Edu = 1; => Educational
# $Edu = 0; => Non-Educational
$Edu = 0;

# Demo Mode
# Turn on Demo mode for Admin Interface
# Just touch a file called .Demo in the main panFora directory to enable demo
# $Demo = 1; => Demo Mode
# $Demo = 0; => Normal Admin
$Demo = 0;
if (-e "./.Demo") {
	$Demo = 1;
}

#################### Signal Handling ########################################
# Trap TERM and PIPE signals? This needs to be turned on to enable trapping.
$trapSignals = 0;
# Has a signal been received?
$gotSignal = 0;

# Load Signal Handler module
# Only trap PIPE, TERM, INT and HUP
use sigtrap qw/handler sig_trap normal-signals/;

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

# Backup Deleted messages, or really delete them?
$MsgBackup = 0;

# First pull in other include files
require "_STR.pl";
require "_CGI.pl";
require "_HTML.pl";
require "ClassDef.pl";

# Tech Support Email
# What is the email address to send tech cupport requests?
$TechSupport = 'techsupp@withinc.com';

if ($Edu) {
	$CorF = "Class";
	$corf = "class";
	$CorFs = "Classes";
	$corfs = "classes";
	
	$ForM = "Faculty";
	$form = "faculty";
	$ForMs = "Faculty";
	$forms = "faculty";
	
	$SorG = "Section";
	$sorg = "section";
	$SorGs = "Sections";
	$sorgs = "sections";
} else {
	$CorF = "Forum";
	$corf = "forum";
	$CorFs = "Forums";
	$corfs = "forums";
	
	$ForM = "Moderator";
	$form = "moderator";
	$ForMs = "Moderators";
	$forms = "moderators";
	
	$SorG = "Group";
	$sorg = "group";
	$SorGs = "Groups";
	$sorgs = "groups";
}

# What OS is this? Pull in extra modules as needed
$isWin = 0;
$isNT = 0;
if (($ENV{'COMSPEC'} ne "" && $ENV{'WINDIR'} ne "") || $^O =~ /Win32/) {
	# This is a windows machine
	require Win32;
	$isWin = 1;
	$isNT = Win32::IsWinNT();
}

# Set up a path separator
$PS = '/';
$PSMatch = $PS;
if ($isWin) {
	$PS = '\\';
	$PSMatch = '\\\\';
}

# Redefine DIR_CGI in Windows (cannot softlink panFora dir as cgi-bin dir)
if ($isWin) {
	$panForaURL = $ENV{'SCRIPT_NAME'};
	@full = split(/\//, $panForaURL);
	$panForaURL =~ s/\/@full[$#full]$//;
	$DIR_CGI = $panForaURL;
}

# What web server is this?
$isApache = 0;
if ($ENV{'SERVER_SOFTWARE'} =~ /Apache/i) {
	$isApache = 1;
}

$fh = 'fh'; # Lock file handle

# Frame Names
$FRAME_FORUMSUBJECTS = "FSubjects";
$FRAME_FORUMTHREADS = "FThreads";
$FRAME_FORUMMSGTHREAD = "FMessages";
$FRAME_FORUMHOME = "FHome";

# MAx length of fields
$MAX_TOPIC_LENGTH = 60;

# Files
$FILE_NEXTID = ".nextid";
$FILE_FNOTIF = "Notif.def";
$FILE_TYPEMAP = "Filetype.map";
$FILE_DISABLED = "Disabled.txt";

$DBFILE_ANNPRE = "ann_";
$DBFILE_FSUBJ = "subjects.db";
$DBFILE_FDELSUBJ = "delsubjects.db";
$DBFILE_FTHREAD = "threads.db";
$DBFILE_FAUTHOR = "authors.db";
$DBFILE_FNEW = "new.db";
$DBFILE_FALL = "all.db";
$DBFILE_CLASSID = "classes.db";
$DBFILE_CLASSINFO = "class.db";
$DBFILE_COLORS = "colors.db";
$DBFILE_COLORS_SRC = "colors.src";
$DBFILE_USERINFO = "users.db";
$DBFILE_STATS = "stats.db";
$DBFILE_LICENSE = ".license.db";

############################
# Artificial new date!!!!! #
############################

# Well, not really artificial. Based on the last 24  hours, instead of the
# user's last visit.

$TMinus24Hrs = time() - (3600 * 24);

# Set up Permissions
$BIT_ADMIN = 8;
$BIT_FAC = 4;
$BIT_READ = 2;
$BIT_WRITE = 1;

# End of initializations
#
###############################################################################

# When you use require, the required file must return true, as in 1;

1;

###############################################################################
#
# Signal Handler
#
###############################################################################

sub sig_trap {
	my($sig) = @_;
	
	# Do we want to trap signals, or just exit?
	if ($trapSignals) {
		# Redirect STDOUT (what to do in Win32?)
		open(DEVNULL, ">/dev/null");
		select(DEVNULL);
		
		# Don't buffer output to DEVNULL (Do we care???)
		$| = 1;
	
		$gotSignal = 1;
	} else {
		exit($sig);
	}
}

###############################################################################
#
# Subroutines
#
###############################################################################

sub copy {
	# copy a file
	local($src, $target) = @_;
	if (!open(sf, $src)) {
		&showErrorBackHTML("Couldn't open the file, $src, for reading. Does it exist?",1);
		exit();
	}
	binmode(sf);
	@sd = <sf>;
	close(sf);
	
	if (!open(tf, ">$target")) {
		&showErrorBackHTML("Couldn't write to file, $target. Check file permissions and try again.",1);
		exit();
	}
	binmode(tf);
	print tf @sd;
	close(tf);
}

# Used by confmakedir
sub pathClean {
	local($path) = @_;
	return(&replaceNonAlpha($path));
}

sub confmakedir {
	my($path, $noExit) = @_;
	my($i, @pregetdir, @getdir, $checkdir, $prevdir, $errmsg);

	# Remove any naughty characters from the path
	&pathClean($path);

	@pregetdir = split(/\/+/, $path);
	splice(@getdir,0);
	$checkdir = "";
	if ($isWin) {
		if (@pregetdir[0] =~ /^\w\:/) {
			$prevdir = @pregetdir[0];
		} else {
			$prevdir = "/";
		}
	} else {
		$prevdir = "/";
	}
	for ($i=0; $i < @pregetdir; $i++) {
		if (@pregetdir[$i] ne "" && @pregetdir[$i] ne "/") {
			push(@getdir, @pregetdir[$i]);
		}
	}
	
	for ($i=0; $i < @getdir; $i++) {
		if ($i == 0 && $isWin && @getdir[$i] =~ /^\w\:/) {
			$checkdir = @getdir[$i];
			next;
		} else {
			$checkdir .= "/" . @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).";
				if ($noExit) {
					return($errmsg);
				} else {
					&showErrorBackHTML($errmsg, 1);
					exit();
				}
			} 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.";
					if ($noExit) {
						return($errmsg);
					} else {
						&showErrorBackHTML($errmsg, 1);
						exit();
					}
				}
			}
		}
		
		# Update the previous directory
		$prevdir = $checkdir;
	}
	
	return("");
}

sub unique {
	# Remove duplicates and nulls from an array
	local(@tmp) = @_;
	local($i, $j, $f, @del);
	for ($i=0; $i < @tmp; $i++) {
		$f=0;
		for ($j=0; $j < @del; $j++) {
			if (@del[$j] eq @tmp[$i]) {
				$f = 1;
			}
		}	
		if ($f == 0 && @tmp[$i] ne "" && @tmp[$i] ne "\n") {
			push(@del, @tmp[$i]);
		}
	}
	return @del;
}

# Program finder, on Unix

sub findProg {
	local($prog) = @_;
	local($i, $p);
	local(@path) = split(/\:/, $ENV{'PATH'});
	
	for ($i=0; $i < @path; $i++) {
		$p = @path[$i] . "/" . $prog;
		if (-e $p && -x $p) {
			return($p);
		}
	}
	
	return ("");
}

# where is sendmail?
sub lookupSendMail {
	local($sendmail);
	if (-e ".conf") {
		open (conf, ".conf");
		while (<conf>) {
			$line = $_;
			chomp($line);
			if ($line =~ /^sendmail/i) {
				($junk, $sendmail) = split(/\t/, $line);
			}
		}
		close(conf);
	}
	if ($sendmail eq "") {
		if ($isWin) {
			$sendmail = "./util/sendmail.exe";
		} else {
			$sendmail = "/usr/lib/sendmail";
		}
	}
	
	$sendmail .= " -t -oi";
	
	return($sendmail);
}

# what is the root panFora URL?
sub lookuppanForaURL {
	local($url);
	if (-e ".conf") {
		open (conf, ".conf");
		while (<conf>) {
			$line = $_;
			chomp($line);
			if ($line =~ /^panForaURL/i) {
				($junk, $url) = split(/\t/, $line);
			}
		}
		close(conf);
	}
	
	return($url);
}

# Parse html templates
sub parseTemplate {
	local($fname) = @_;
	local($i);
	
	open (f, "$fname");
	@fcont = <f>;
	close (f);
	
	for ($i=0; $i < @fcont; $i++) {
		if (@fcont[$i] =~ /ForumSubjectBgImageAttrib/) {
			$replace = "background=" . $DIR_CGI . "/" . $FSbgimage;
			if ($FSbgimage eq "") {
				$replace = "";
			}
			@fcont[$i] =~ s/ForumSubjectBgImageAttrib/$replace/;
		}
	
		@fcont[$i] =~ s/DIR_CGI/$DIR_CGI/;
		@fcont[$i] =~ s/CLASS_TITLE/$C_title/;
		@fcont[$i] =~ s/CLASS_ID/$Class/;
		@fcont[$i] =~ s/SELF_ADD_SCRIPT/$CGI_ForumUserAddSelf/;
		@fcont[$i] =~ s/FORUM_DEMO/$CGI_ForumDemo/;
		@fcont[$i] =~ s/FORUM_HELP/$CGI_ForumHelp/;
		@fcont[$i] =~ s/FORUM_MAIN/$CGI_Forum/;
		@fcont[$i] =~ s/FONT_FACE/$FontFace/;
		@fcont[$i] =~ s/ForumSubjectBgImage/$FSbgimage/;
		@fcont[$i] =~ s/ForumSubjectBg/$FSbg/;
		@fcont[$i] =~ s/ForumSubjectLink/$FSlink/;
		@fcont[$i] =~ s/ForumSubjectVLink/$FSvlink/;
		@fcont[$i] =~ s/ForumSubjectText/$FStext/;
		@fcont[$i] =~ s/ForumSubjectHeaderBack/$FSheaderback/;
		@fcont[$i] =~ s/ForumSubjectHeaderText/$FSheadertext/;
		if (@fcont[$i] =~ /FORUM_ADD_SELF/) {
			if ($C_authtype =~ /cookie/i && $C_Public) {
										
				$addself = "<a href=$DIR_CGI/$CGI_ForumUserAddSelf";
				$addself .= "?fid=$Class target=Main>";
				$addself .= "<img src=$DIR_CGI/images/RegisterButton.gif ";
				$addself .= "border=0 width=53 height=17 align=middle ";
				$addself .= "alt='Register for an Account'></a>&nbsp;\n";	
			} else {
				$addself = "";
			}
			@fcont[$i] =~ s/FORUM_ADD_SELF/$addself/;
		}
		if (@fcont[$i] =~ /FORUM_LOGIN/) {
			if ($C_authtype =~ /cookie/i) {
				$loginout = "<a href=$DIR_CGI/$CGI_ForumCookieLogin?";
				$loginout .= "fid=$Class target=Main>";
				$loginout .= "<img src=$DIR_CGI/images/login.gif border=0 ";
				$loginout .= "width=39 height=17 align=middle alt='Login'></a>";
				$loginout .= "&nbsp;";
				$loginout .= "<a href=$DIR_CGI/$CGI_ForumCookieLogin?";
				$loginout .= "fid=$Class&func=dologout target=Main>";
				$loginout .= "<img src=$DIR_CGI/images/logout.gif border=0 ";
				$loginout .= "width=39 height=17 align=middle alt='Logout'>";
				$loginout .= "</a>&nbsp;\n";
			} else {
				$loginout = "";
			}
			@fcont[$i] =~ s/FORUM_LOGIN/$loginout/;
		}
		if (@fcont[$i] =~ /WHO_AM_I/) {
			if ($C_authtype =~ /cookie/i) {
				# Need to put in javascript to read the cookie, and code to
				# output it. It hink that can wait...
				$whoami = "";
			} else {
				$whoami = "";
			}
			@fcont[$i] =~ s/WHO_AM_I/$whoami/;
		}
	}
		
	return @fcont;
}

# Generate a file from a template
sub genFile {
	local($src, $targ) = @_;
	@contents = &parseTemplate($src);
	
	open(f, ">$targ");
	for ($i=0; $i < @contents; $i++) {
		print f @contents[$i];
	}
	close(f);
}

# Generate a list of directories recursively
sub genDirList {
	local(@mydirs) = @_;
	my($i);
	local(@getdirs);
	
	for ($i=0; $i < @mydirs; $i++) {
		if (-d @mydirs[$i]) {
			push(@dirs, @mydirs[$i]);
			if ($isWin) {
				@getdirs = glob(@mydirs[$i] . $PS . "*");
			} else {
				if ($] >= 5.6 || $] >= 5.006) {
					@getdirs = glob(@mydirs[$i] . $PS . "*");
				} else {
					@getdirs = glob("\"@mydirs[$i]" . $PS . "\"*"); 
				}
			}
			chomp(@getdirs);
			&genDirList(@getdirs);
		}
	}
	return(@dirs);
}

# Permissions

sub IS_ADMIN {
	local($x) = @_;
	($x & $BIT_ADMIN);
}
sub IS_FAC {
	local($x) = @_;
	($x & $BIT_FAC);
}
sub HAS_READ {
	local($x) = @_;
	($x & $BIT_READ);
}
sub HAS_WRITE {
	local($x) = @_;
	($x & $BIT_WRITE);
}

sub formatDate {

	# This function takes 2 arguments. The first is the time, in seconds
	# since 1970. The second is the format. "date" returns just the date,
	# "time" returns just the time, and null or anything else returns
	# date and time.

	local($posttime, $what) = @_;
	
	($sec, $min, $hr, $day, $mon, $yr, $dow, $doy, $dls) = localtime($posttime);
	$mon += 1;
	if ($yr >= 100) { $yr = $yr - 100; }
	$postdate = sprintf("%02d-%02d-%02d", $mon, $day, $yr);
	
	@days = ("Sun", "Mon", "Tues", "Wed", "Thurs", "Fri", "Sat");
	
	# $posttime = @days[$dow] . " " . $mon . "/" . $day . "/" . $yr;
	# $postdate = $mon . "." . $day . "." . $yr;
	
	# What is today's date?
	($sec2, $min2, $hr2, $day2, $mon2, $yr2, $dow2, $doy2, $dls2) = localtime(time());
	$mon2 += 1;
	if ($yr2 >= 100) { $yr2 = $yr2 - 100; }
	
	if ($mon == $mon2 && $day == $day2 && $yr == $yr2 && $what ne "fulldate") {
		$postdate = "Today";
	}
	
	# Put the time in 12 hour time
	if ($hr >= 12) {
		$hr -= 12;
		if ($hr == 0) { $hr = 12; }
		
		$ampm = "PM";
	} else {
		if ($hr == 0) {$hr = 12; }
		
		$ampm = "AM";
	}
	
	# Minutes are not preceded by a zero
	if (length($min) != 2) {
		$min = "0" . $min;
	}
	
	# Add the time to the date
	$posttime = "$hr:$min $ampm";
	
	# This should not be used anywhere any more.
	$postdaytime = $postdate . " - " . $posttime;
	
	if ($what =~ /date/i && $what ne "fulldate") {
		$retval = $postdate;
	} elsif ($what =~ /time/i) {
		$retval = $posttime;
	} else {
		$retval = $postdaytime;
	}
	
	return $retval;
}

sub dbErrorCheck {
	local($retval, $text) = @_;
	
	if ($retval != 0) {
		# An error occurred
		# if ($text =~ /^ERROR/) {
		if ($text ne "") {
			return ($text);
		} elsif ($retval == 104 || $retval == 26624) {
			return ("ERROR: Invalid License.");
		} elsif ($retval == 105 || $retval == 26880) {
			return ("ERROR: License has expired.");
		} elsif ($retval == 106 || $retval == 27136) {
			return ("ERROR: Exceeded max number of forums allowed by license.");
		} elsif ($retval == 107 || $retval == 27392) {
			return ("ERROR: Exceeded max number of users allowed by license..");
		} elsif ($retval == 108 || $retval == 27648) {
			return ("ERROR: Invald licensed IP address.");
		}
		return ("ERROR: An unknown error (" . $retval . ") occurred while accessing the database.");
	}
	
	return("");
}

sub dbErrorCheckExit {
	local($retval, $text) = @_;
	local($etext) = &dbErrorCheck($retval, $text);
	
	if ($etext) {
		$etext .= "<p>Check file permissions on the server and try again.";
		&showErrorBackHTML($etext);
		exit();
	}
	return("");
}

#######################################################################
#
# Database routines (obsolete)
#
#######################################################################

sub cmpAuthNumDBT {
	# Numerical sorting routine for authors db
	local ($num_a, $num_b) = @_;
	
	if ($num_a eq "" && $a ne "") {
		$num_a = $a;
	}
	if ($num_b eq "" && $b ne "") {
		$num_b = $b;
	}
	
	($autha, $ida) = split(/\:/, $num_a);
	($authb, $idb) = split(/\:/, $num_b);
	
	if ($autha ne $authb) {
		return($autha cmp $authb);
	}
	
	return($ida <=> $idb);

	# return(0);
}

sub cmpNumAuthDBT {
	# Numerical sorting routine for replies db
	local ($num_a, $num_b) = @_;
	
	if ($num_a eq "" && $a ne "") {
		$num_a = $a;
	}
	if ($num_b eq "" && $b ne "") {
		$num_b = $b;
	}
	
	($ida, $autha) = split(/\:/, $num_a);
	($idb, $authb) = split(/\:/, $num_b);
	
	if ($ida == $idb) {
		return($autha cmp $authb);
	}
	
	return($ida <=> $idb);

	# return(0);
}

sub cmpNumDBT {
	# Numerical sorting routine dbs keyed by msgid (n.m.o.p)
	local ($len, $i);
	local ($num_a, $num_b) = @_;
	
	if ($num_a eq "" && $a ne "") {
		$num_a = $a;
	}
	if ($num_b eq "" && $b ne "") {
		$num_b = $b;
	}
	
	@numa = split(/\./, $num_a);
	@numb = split(/\./, $num_b);
	
	if (@numa > @numb) {
		$len = @numa;
	} else {
		$len = @numb;
	}
	
	for ($i=0; $i < $len; $i++) {
		if (@numa[$i] == @numb[$i] && @numa[$i] ne "" && @numb[$i]) {
			next;
		} elsif (@numb[$i] eq "" &&  @numa[$i] ne "" ) {
			return(1);
		} elsif (@numb[$i] ne "" &&  @numa[$i] eq "" ) {
			return(-1);
		} elsif (@numa[$i] != @numb[$i]) {
			return(@numa[$i] <=> @numb[$i]);
		}
	}
	
	return($num_a <=> $num_b);
}


sub cmpNum {
	# Numerical sorting routine for other dbs, including top10
	local ($num_a, $num_b) = @_;
	
	if ($num_a eq "" && $a ne "") {
		$num_a = $a;
	}
	if ($num_b eq "" && $b ne "") {
		$num_b = $b;
	}
	
	return($num_a <=> $num_b);

	# return(0);
}

# Set Fnctl Variables manually, since dynamic loading broke on my computer

$LOCK_SH = 1;
$LOCK_EX = 2;
$LOCK_NB = 4;
$LOCK_UN = 8;

sub lockFileWrite {
	local($file) = @_;
	$fh++;
	$failures = 0;
	$maxfailures = 10;
	
	if (!$isWin || ($isWin && $isNT)) {
		$fn = $file . ".lock";
		if (open($fh, "+>$fn")) {
			while ($failures < $maxfailures && !flock($fh, $LOCK_EX | $LOCK_NB)) {
				sleep(++$failures);
			}
		
			if ($failures >= $maxfailures) {
				close($fh);
				print "\nFile locking timed out after $failures attempts.\n";
				exit();
			}
		}
	}
	
	return $fh;
}

sub lockFileRead {
	local($file) = @_;
	$fh++;
	$failures = 0;
	$maxfailures = 10;
	
	if (!$isWin || ($isWin && $isNT)) {
		$fn = $file . ".lock";
		if (open($fh, "+>$fn")) {
			while ($failures < $maxfailures && !flock($fh, $LOCK_SH | $LOCK_NB)) {
				sleep(++$failures);
			}
		
			if ($failures >= $maxfailures) {
				close($fh);
				print "\nFile locking timed out after $failures attempts.\n";
				exit();
			}
		}
	}
	
	return $fh;
}

sub lockFileUn {
	local($fh) = @_;
	
	if (!$isWin || ($isWin && $isNT)) {
		flock($fh, $LOCK_UN);
		close($fh);
	}
}
