# Teemz(tm) Bulletin Board Software
# Copyright © 2000 Elated Communications Ltd. All Rights Reserved

# By having in your possession a copy of this file, or by using or
# installing this file, you are indicating your acceptance of the
# Teemz licence agreement.  This agreement is publicly viewable
# at http://www.teemz.com/licence and should be included with your
# Teemz distribution in the file teemz_licence.txt.

# You are solely responsible for any consequences of the use of this file.

# Copyright notices included within this file may never be modified,
# appended, or removed without the prior expressed written consent of
# Elated Communications Ltd.

# You are not permitted to modify, append, or remove any copyright
# notices or credits appearing within the visual interface of the Teemz
# Software. This includes, but is not limited to, copyright notices on
# documentation pages, the "Help" link on any board page, the "Administrator's
# Manual" link on the administration pages, and the "Powered By Teemz" link on
# the board home page. Removing links to such copyright notices and credits is
# also prohibited.

# You may not sell or otherwise distribute this file, or any files
# that comprise the Teemz Software, or any derivatives or alterations of
# these files, under any name.

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

# tzlib.pl 

# Library functions.


# tzsetup.cgi should alter $datadir for you automatically when you set up Teemz.  If it cannot, it means
# either you have not set 777 permission on this file (tzlib.pl) or your web host does not allow you
# to set these permissions within cgi-bin.  In this case, you should edit this file and change $datadir 
# to the complete path to your tzdata directory on your web server, and the require statement to reflect
# the full path to tzcgi.pm in your cgi-bin directory, then re-upload tzlib.pl.


# Main Data Directory - All forum data files (users database, message files, etc.) are stored in here.
# The name of this directory should not be easily guessable, otherwise people might be able to view
# your user database via the web!
# Ideally it should not have web access (place it above your document root)

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

$datadir = "";

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



# require statement - this will normally be set automatically by
# Teemz Setup, but if you cannot give the file you are reading 777 permission,
# then you must modify this line yourself. Enter the full path to tzcgi.pm within
# the "" marks.

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

require "full/path/to/tzcgi.pm";

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



use Time::Local;
require 5.002;
use Socket;


use File::Copy;


$query = new CGI;
$board = $query->param(board);
$board = "_master" if ( $board eq "" );

# see if the forums are shut down; if they are, then exit.

if ( ( -e "$datadir/$board/shutdown" ) && ( $bypass_shutdown eq "" ) )
{
	print $query->header;
	include_html ( "$datadir/$board/_template/shutdown.html" );
	exit;
}


require "$datadir/tzsetup.txt";

# files and urls

$basedir = "$datadir/$board";
$imageurl = "$baseimageurl/$board";

require "$datadir/$board/setup.txt";
require "$datadir/$board/skin.txt";

get_includes ( );

if ( $running_tzskin ne "yes" )
{
	$page_header =~ s/\[\#(\w+)(\#\])/eval("\$"."$1")/eg;
	$page_footer =~ s/\[\#(\w+)(\#\])/eval("\$"."$1")/eg;
	$body_tag =~ s/\[\#(\w+)(\#\])/eval("\$"."$1")/eg;
	$head_tag =~ s/\[\#(\w+)(\#\])/eval("\$"."$1")/eg;
}


@months = qw (Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);

##################################
# checkuser: checks the user's cookie to make sure their request is valid (ie they are logged in)
##################################

sub checkuser ( )
{

	# get the logged in user name (if any)

	if ( length ( $query->cookie("tbf_user_$board") ) > 0 )
	{
		# session cookie found
		$user = $query->cookie("tbf_user_$board");
	}
	else
	{
		# mark as guest (not logged in)
		$user = "guest";
	}


	# set up global menu(s)
	
	$forum = $query->param(forum);

	$global_menu = "\n\n\t\t<table border=0 cellpadding=2 cellspacing=0 bgcolor=$table_bgcolor1 width=100%>\n\n\t\t";

	if ( $user eq "guest" )
	{
		$global_menu = $global_menu_guests;
		$global_menu =~ s/\[\#(\w+)(\#\])/eval("\$"."$1")/eg;
	}
	else
	{
		$global_menu = $global_menu_users;
		$global_menu =~ s/\[\#(\w+)(\#\])/eval("\$"."$1")/eg;
	}


	# set last visited message
	
	# is there a permanent "lastlogout" cookie?
	
	if ( length ( $query->cookie("tbf_ll_".$user."_".$board) ) > 0 )
	{
		$tbf_lastlogout = $query->cookie("tbf_ll_".$user."_".$board);
		$tbf_lastlogout =~ s/\n//g;
	}

	if ( $tbf_lastlogout ne "" )
	{
		$lastlogout = pretty_time ( $tbf_lastlogout );
		$lastvisit_message = "<font face=$ff_small size=$fs_small>";
		$lastvisit_message .= "You last logged out on $lastlogout";
		$lastvisit_message .= "</font>";
	}
	else
	{
		$lastvisit_message .= "";
	}
	
	$user_status = $query->cookie ( "tbf_status_$board" );
	
	print $query->header;

}



##################################
# validate_user: does the user have the required rights?
# contains all the validation rules across the board
##################################

# params:
# action: read*, close, reopen, edit, post, delete, deletewithreplies, movetopics
# forum: forumname
# topic: topic number
# post: post number
#
# * - not yet implemented

sub validate_user ( )
{

	my ( $action, $forum, $topic, $post ) = @_;

	my $i;
	
	if ( $action eq "post" )
	{
		# at present, anyone can post
		return true;
	}
	elsif ( $action eq "delete" )
	{

		# get user info

		$user_line = read_user ( $user );
		( $uf_user, $uf_pass, $uf_email, $uf_location, $uf_occupation, $uf_homepage, $uf_allow_email, $uf_status, $uf_show_email, $uf_posts, $uf_last_post, $uf_reg_date, $uf_last_logout, $uf_default_history ) = split ( '\|', $user_line );

		# if they're an admin, return true (admins can do anything)

		return true if ( $uf_status == 3 );

		# get forum info

		open ( LISTFILE, "$basedir/$listfilename" ) or &bail ( "Can't open forum list file." );
		@list_file = <LISTFILE>;
		close LISTFILE;

		foreach $list_line ( @list_file )
		{
			( $name, $foldername, $description, $topics, $posts, $lastpost, $moderators ) = split ( '\|', $list_line );
			last if ( $foldername eq $forum );
		}

		# forum not found? return false

		return false if ( $foldername ne $forum );

		# are they a moderator of this forum?  if so, return true (mods can do anything in their forums)
		
		( $moderators, $junk ) = split ( '\n', $moderators );
		@moderators = split ( ',', $moderators );
		
		for ( $i=0; $i<@moderators; $i++ )
		{
			return true if ( $user eq $moderators[$i] );
		}

		

		# they're a regular user - they can delete if it's their topic or post


		# deleting a topic or a post?
		
		if ( $post eq "" )
		{
			# topic
			# did they create the topic?

			open ( INDEXFILE, "$basedir/$forum/$indexfilename" ) or &bail ( "Can't open index for forum $forum" );
			@index_file = <INDEXFILE>;
			close INDEXFILE;

			for( $i=1; $i<@index_file; $i++ )
			{
				( $topic_num, $replies, $topic_name, $last_reply, $creator_name ) = split ( '\|', $index_file[$i] );
				last if ( $topic_num eq $topic );
			}

			( $creator_name, $junk ) = split ( '\n', $creator_name );
			

			return true if ( $user eq $creator_name );
			return false;
		}
		else
		{
			# post
			# did they create the post, and are there no posts after it?
			
			open ( TOPICFILE, "$basedir/$forum/$topic.txt" ) or &bail ( "Can't open topic $topic" );
			@topic_file = <TOPICFILE>;
			close TOPICFILE;

			for( $i=1; $i<@topic_file; $i++ )
			{
				( $tf_entry, $tf_entry_text, $tf_entry_time, $tf_author_name, $tf_host ) = split ( '\|', $topic_file[$i] );
				last if ( $tf_entry eq $post );
			}
			
			return true if ( $user eq $tf_author_name ) && ( $i == @topic_file - 1 );
			return false;

		}

	}
	elsif ( $action eq "deletewithreplies" )
	{

		# get user info

		$user_line = read_user ( $user );
		( $uf_user, $uf_pass, $uf_email, $uf_location, $uf_occupation, $uf_homepage, $uf_allow_email, $uf_status, $uf_show_email, $uf_posts, $uf_last_post, $uf_reg_date, $uf_last_logout, $uf_default_history ) = split ( '\|', $user_line );

		# if they're an admin, return true (admins can do anything)

		return true if ( $uf_status == 3 );

		# get forum info

		open ( LISTFILE, "$basedir/$listfilename" ) or &bail ( "Can't open forum list file." );
		@list_file = <LISTFILE>;
		close LISTFILE;

		foreach $list_line ( @list_file )
		{
			( $name, $foldername, $description, $topics, $posts, $lastpost, $moderators ) = split ( '\|', $list_line );
			last if ( $foldername eq $forum );
		}

		# forum not found? return false

		return false if ( $foldername ne $forum );

		# are they a moderator of this forum?  if so, return true (mods can do anything in their forums)

		( $moderators, $junk ) = split ( '\n', $moderators );
		@moderators = split ( ',', $moderators );
		
		for ( $i=0; $i<@moderators; $i++ )
		{
			return true if ( $user eq $moderators[$i] );
		}

		# they're a regular user - they can't delete a topic if it's got replies
		
		return false;
	}
	elsif ( $action eq "edit" )
	{

		# get user info

		$user_line = read_user ( $user );
		( $uf_user, $uf_pass, $uf_email, $uf_location, $uf_occupation, $uf_homepage, $uf_allow_email, $uf_status, $uf_show_email, $uf_posts, $uf_last_post, $uf_reg_date, $uf_last_logout, $uf_default_history ) = split ( '\|', $user_line );

		# if they're an admin, return true (admins can do anything)

		return true if ( $uf_status == 3 );

		# get forum info

		open ( LISTFILE, "$basedir/$listfilename" ) or &bail ( "Can't open forum list file." );
		@list_file = <LISTFILE>;
		close LISTFILE;

		foreach $list_line ( @list_file )
		{
			( $name, $foldername, $description, $topics, $posts, $lastpost, $moderators ) = split ( '\|', $list_line );
			last if ( $foldername eq $forum );
		}

		# forum not found? return false

		return false if ( $foldername ne $forum );

		# are they a moderator of this forum?  if so, return true (mods can do anything in their forums)
		
		( $moderators, $junk ) = split ( '\n', $moderators );
		@moderators = split ( ',', $moderators );
		
		for ( $i=0; $i<@moderators; $i++ )
		{
			return true if ( $user eq $moderators[$i] );
		}

		# they're a regular user - they can edit if it's their post


		# did they create the post, and are there no posts after it?


		open ( TOPICFILE, "$basedir/$forum/$topic.txt" ) or &bail ( "Can't open topic $topic" );
		@topic_file = <TOPICFILE>;
		close TOPICFILE;

		for( $i=1; $i<@topic_file; $i++ )
		{
			( $tf_entry, $tf_entry_text, $tf_entry_time, $tf_author_name, $tf_host ) = split ( '\|', $topic_file[$i] );
			last if ( $tf_entry eq $post );
		}

		return true if ( $user eq $tf_author_name ) && ( $i == @topic_file - 1 );
		return false;

	}
	elsif ( $action eq "close" )
	{

		# get user info

		$user_line = read_user ( $user );
		( $uf_user, $uf_pass, $uf_email, $uf_location, $uf_occupation, $uf_homepage, $uf_allow_email, $uf_status, $uf_show_email, $uf_posts, $uf_last_post, $uf_reg_date, $uf_last_logout, $uf_default_history ) = split ( '\|', $user_line );

		# if they're an admin, return true (admins can do anything)

		return true if ( $uf_status == 3 );

		# get forum info

		open ( LISTFILE, "$basedir/$listfilename" ) or &bail ( "Can't open forum list file." );
		@list_file = <LISTFILE>;
		close LISTFILE;

		foreach $list_line ( @list_file )
		{
			( $name, $foldername, $description, $topics, $posts, $lastpost, $moderators ) = split ( '\|', $list_line );
			last if ( $foldername eq $forum );
		}

		# forum not found? return false

		return false if ( $foldername ne $forum );

		# are they a moderator of this forum?  if so, return true (mods can do anything in their forums)

		( $moderators, $junk ) = split ( '\n', $moderators );
		@moderators = split ( ',', $moderators );
		
		for ( $i=0; $i<@moderators; $i++ )
		{
			return true if ( $user eq $moderators[$i] );
		}

		# they're a regular user - they can't close topics

		return false;

	}
	elsif ( $action eq "reopen" )
	{

		# get user info

		$user_line = read_user ( $user );
		( $uf_user, $uf_pass, $uf_email, $uf_location, $uf_occupation, $uf_homepage, $uf_allow_email, $uf_status, $uf_show_email, $uf_posts, $uf_last_post, $uf_reg_date, $uf_last_logout, $uf_default_history ) = split ( '\|', $user_line );

		# if they're an admin, return true (admins can do anything)

		return true if ( $uf_status == 3 );

		# get forum info

		open ( LISTFILE, "$basedir/$listfilename" ) or &bail ( "Can't open forum list file." );
		@list_file = <LISTFILE>;
		close LISTFILE;

		foreach $list_line ( @list_file )
		{
			( $name, $foldername, $description, $topics, $posts, $lastpost, $moderators ) = split ( '\|', $list_line );
			last if ( $foldername eq $forum );
		}

		# forum not found? return false

		return false if ( $foldername ne $forum );

		# are they a moderator of this forum?  if so, return true (mods can do anything in their forums)

		( $moderators, $junk ) = split ( '\n', $moderators );
		@moderators = split ( ',', $moderators );
		
		for ( $i=0; $i<@moderators; $i++ )
		{
			return true if ( $user eq $moderators[$i] );
		}

		# they're a regular user - they can't reopen topics

		return false;

	}
	elsif ( $action eq "movetopics" )
	{

		# get user info

		$user_line = read_user ( $user );
		( $uf_user, $uf_pass, $uf_email, $uf_location, $uf_occupation, $uf_homepage, $uf_allow_email, $uf_status, $uf_show_email, $uf_posts, $uf_last_post, $uf_reg_date, $uf_last_logout, $uf_default_history ) = split ( '\|', $user_line );

		# if they're an admin, return true (admins can do anything)

		return true if ( $uf_status == 3 );

		# no-one else can currently move topics

		return false;

	}
	else
	{
		return false;
	}
}



##################################
# sendmail: sends an email using smtp over tcp/ip sockets
##################################

# params:
# from_email: mail from address
# from_friendly: friendly mail from address
# to_email: mail to address
# to_friendly: friendly mail to address
# subject: email subject
# body: message body


sub sendmail ( )
{
	my ( $from_email, $from_friendly, $to_email, $to_friendly, $subject, $body ) = @_;
	
	
	if ( $smtp_server eq "" )
	{
		# use sendmail

		unless ( -e $sendmail_path )
		{
			bail ("Can't open sendmail: check that your webserver supports sendmail.  If it doesn't, you need to specify a mail server with the variable \$smtp_server - see the Teemz Administrator's Manual for details. (Error: $!)", "nonotify" );
		}
		
		open ( MAIL, "|$sendmail_path -t" ) or bail ("Can't open sendmail: check that your webserver supports sendmail.  If it doesn't, you need to specify a mail server with the variable \$smtp_server - see the Teemz Administrator's Manual for details. (Error: $!)", "nonotify" );
		print MAIL "From: \"$from_friendly\" <$from_email>\n" or bail ("Can't write to sendmail: check that your webserver supports sendmail.  If it doesn't, you need to specify a mail server with the variable \$smtp_server - see the Teemz Administrator's Manual for details. (Error: $!)", "nonotify" );;
		print MAIL "To: \"$to_friendly\" <$to_email>\n";
      		print MAIL "Subject: $subject\n\n";
		print MAIL "$body\n";
		close MAIL;
	}
	else
	{
		# use socket
	
		# Set the line separator according to whether this is running on NT or UNIX.

		if ( $^O eq "MSWin32" )
		{
			$nl = "\r\n";
		}
		else
		{
			$nl = "\n";
		}


		# Make connection to mail server

		$iaddr = inet_aton ( $smtp_server ) or bail ( "Can't find SMTP server $smtp_server", "nonotify" );
		$paddr = sockaddr_in ( $smtp_port, $iaddr );
		$proto = getprotobyname ( 'tcp' );
		socket ( SOCK, PF_INET, SOCK_STREAM, $proto ) or bail ( "socket: $!", "nonotify" );
		connect ( SOCK, $paddr ) or bail ( "connect: $!", "nonotify" );

		select ( SOCK );
		$| = 1;
		select ( STDOUT );

		$reply = <SOCK>;

		print SOCK "HELO $hostname$nl";
		$reply = <SOCK>;

		( $code, $text ) = split ( " ", $reply );

		if ( $code ne "250" )
		{
			close ( SOCK );
			bail ( "HELO failed: error $code", "nonotify" );
		}

		print SOCK "MAIL FROM: <$from_email>$nl";
		$reply = <SOCK>;

		( $code, $text ) = split ( " ", $reply );

		if ( $code ne "250" )
		{
			close ( SOCK );
			bail ( "FROM failed: error $code", "nonotify" );
		}


		print SOCK "RCPT TO: <$to_email>$nl";
		$reply = <SOCK>;

		( $code, $text ) = split ( " ", $reply );

		if ( $code ne "250" )
		{
			close ( SOCK );
			bail ( "TO failed for recipient $to_email: error $code", "nonotify" );
		}



		print SOCK "DATA$nl";
		$reply = <SOCK>;

		( $code, $text ) = split ( " ", $reply );

		if ( $code ne "354" )
		{
			close ( SOCK );
			bail ( "DATA failed for recipient $to_email: error $code", "nonotify" );
		}

		print SOCK "From: \"$from_friendly\" \<$from_email\>$nl";
		print SOCK "To: \"$to_friendly\" \<$to_email\>$nl";
		print SOCK "Subject: $subject$nl";
		print SOCK "X-Mailer: Tz Bulletin Board, http://www.elated.com$nl";
		print SOCK "$nl";

		$body =~ s/\n/$nl/g;

		print SOCK $body;

		print SOCK "$nl.$nl";

		$reply = <SOCK>;
		( $code, $text ) = split ( " ", $reply );

		if ( $code ne "250" )
		{
			close ( SOCK );
			bail ( "Post-DATA failed for recipient $to_email: error $code", "nonotify" );
		}

		print SOCK "QUIT \n";
		$reply = <SOCK>;
		close ( SOCK );
	}
}



##################################
# redirect: url redirect function using javascript, with fallback to a meta refresh
##################################

# params:
# redirect_url: url to redirect to


sub redirect ( )
{
	my $redirect_url = $_[0];
	$redirect_url =~ s/ /%20/g;
	
	print <<END_HTML;
<html><head>
<SCRIPT language="JavaScript1.1">
<!--
location.replace("$redirect_url");
//-->
</SCRIPT> 
<NOSCRIPT>
<META http-equiv="Refresh" content="0; URL=$redirect_url">
</NOSCRIPT>
</head>
<body></body>
</html>
END_HTML

}


##################################
# is_host_banned: aborts with an error page if the remote host is in the host ban file.
##################################

sub is_host_banned ( )
{
	$host = $query->remote_host();
	
	open ( BANFILE, "$basedir/$host_banfile" ) or &bail ( "Can't open host ban file." );
	@ban_file = <BANFILE>;
	close BANFILE;
	
	foreach $ban_entry ( @ban_file )
	{
		( $ban_entry, $junk ) = split ( '\n', $ban_entry );
		if ( $host =~ /^$ban_entry/ )
		{
			unlock_file ( "$basedir/$usersfilename" );
			$errortext = $pd_host_banned;
			include_html ("$basedir/$tpl_permission_denied" );
			exit;
		}
	}
	return false;
}



##################################
# censor: replaces any disallowed words in the supplied text with asterisks.
##################################

sub censor ( )
{
	my $input_text = $_[0];
	
	open ( CENSORFILE, "$basedir/$censor_file" ) or &bail ( "Can't open censor file." );
	@censored_words = <CENSORFILE>;
	close CENSORFILE;
	
	foreach $censored_word ( @censored_words )
	{
		( $censored_word, $junk ) = split ( '\n', $censored_word );
		$asterisks = "*" x length ( $censored_word );
		$input_text =~ s/$censored_word/$asterisks/ig;
	}

	return $input_text;
}




##################################
# check_diskspace: if there is less disk space available than $min_disk_space, aborts with an error.
##################################

sub check_diskspace ( )
{
#	# determine which OS we're using
#	
#	if ( $^O eq "MSWin32" )
#	{
#		# Win32: use the DIR command and parse output to determine disk space
#		$result = `dir /-C \"$basedir\"`;
#		$result =~ /(\d+) bytes free/;
#		$free_space = int ( $1 / 1024 );
#	}
#	else
#	{
#		# UNIX: use the df -k command and parse output to determine disk space
#		$result = `df -k $basedir`;
#		$result =~ /(\d+)\s+\d+\%/;
#		$free_space = $1;
#	}
#	
#	bail ( "Not enough disk space for operation" ) if ( $free_space < $min_disk_space );
}




##################################
# laterthan (x, y) - returns true if x is a later time than y
# x and y are of the format: Tue Jan 25 13:06 2000
##################################

sub laterthan ( )
{
	my ( $x, $y ) = @_;
	my %months = ('Jan',0,'Feb',1,'Mar',2,'Apr',3,'May',4,'Jun',5,'Jul',6,'Aug',7,'Sep',8,'Oct',9,'Nov',10,'Dec',11 );
	
	return false if length ( $x ) == 0;
	return true if length ( $y ) == 0;
	
	( $junk, $xmonth, $xmday, $xhourxminute, $xyear ) = split ( ' ', $x);
	$xmonth = $months{$xmonth};
	( $xhour, $xminute ) = split ( ':', $xhourxminute );
	
	( $junk, $ymonth, $ymday, $yhouryminute, $yyear ) = split ( ' ', $y);
	$ymonth = $months{$ymonth};
	( $yhour, $yminute ) = split ( ':', $yhouryminute );
	
	$xtime = timegm ( 0, $xminute, $xhour, $xmday, $xmonth, $xyear );
	$ytime = timegm ( 0, $yminute, $yhour, $ymday, $ymonth, $yyear );
	
	return true if ( $xtime > $ytime );
	return false;
}




##################################
# olderthan ( ) - returns true if time x is older than time y
# x is of the format: Tue Jan 25 13:06 2000
# y is of the format: non-leap seconds since Jan 1, 1970 UTC
##################################

sub olderthan ( )
{
	my ( $x, $y ) = @_;
	my %months = ('Jan',0,'Feb',1,'Mar',2,'Apr',3,'May',4,'Jun',5,'Jul',6,'Aug',7,'Sep',8,'Oct',9,'Nov',10,'Dec',11 );
	
	( $junk, $xmonth, $xmday, $xhourxminute, $xyear ) = split ( ' ', $x);
	$xmonth = $months{$xmonth};
	( $xhour, $xminute ) = split ( ':', $xhourxminute );
	
	$xtime = timegm ( 0, $xminute, $xhour, $xmday, $xmonth, $xyear );
	
	return true if ( $xtime < $y );
	return false;
}




##################################
# pretty_time ( ) - returns human_readable time format
# uglytime is of the format: non-leap seconds since Jan 1, 1970 UTC
##################################

sub pretty_time ( )
{
	my ( $uglytime ) = $_[0];
	my ( $omit_font_tag ) = $_[1];
	
	return "&nbsp;" if ( $uglytime == 0 );
	
	my $minute, $hour, $mday, $month, $year, $wday, $isdst;

	( $junk, $minute, $hour, $mday, $month, $year, $wday, $junk, $isdst ) = localtime ( $uglytime + $time_offset * 3600 );
	
	$year = $year % 100;
	$year = "0$year" if ( $year < 10 );
	$mday = "0$mday" if ( $mday < 10 );
	$hour = "0$hour" if ( $hour < 10 );
	$minute = "0$minute" if ( $minute < 10 );
	$month = $months[$month];
	
	if ( $omit_font_tag )
	{
		return "$mday-$month-$year&nbsp;$hour:$minute";
	}
	else
	{
		return "$mday-$month-$year&nbsp;<font color=$label_color>$hour:$minute</font>";
	}
}
	



##################################
# db_select ( ) - returns all "rows" of a "table" (text file)
# $table_name:	full path of the text file
# $recordset:	a reference to an array that will contain the recordset
##################################

sub db_select ( )
{
	my $table_name = shift;
	my $recordset = shift;
	my $start_record = shift;
	my $end_record = shift;
	
	
	my $i;
   
	open ( DATAFILE, "$table_name" ) or &bail ( "Can't open database file for read. $table_name" );
	
	if ( ( $start_record eq "" ) && ( $end_record eq "" ) )
	{
		@$recordset = <DATAFILE>;
	}
	
	else
	
	{
		print "start_record=$start_record<br>end_record=$end_record<br>";
		$first_line = <DATAFILE>;
		push @$recordset, $first_line;
		
		#for ( $i = 1; $i < $start_record; $i++ )
		#{
		#	$junk = <DATAFILE>;
		#}
		for ( $i = $start_record; $i <= $end_record; $i++ )
		{

			#@$recordset = <DATAFILE>;
			$the_record = <DATAFILE>;
			push @$recordset, $the_record;
		}

		close DATAFILE;
	}
	
	#return $recordset;
}




##################################
# db_update ( ) - replaces all "rows" of a "table" (text file) with contents of an array
# $table_name:	full path of the text file
# $recordset:	a reference to an array containing the recordset to write
##################################

sub db_update ( )
{
	my $table_name = shift;
	my $recordset = shift;
	
	# back up the file if it already exists
	
	if ( -e $table_name )
	{
		&bail ( "Can't back up database $table_name." ) if ( copy ( "$table_name", "$table_name\.bak" ) == 0 );
	}

	chmod ( 0666, "$table_name\.bak" );
	
	open ( DATAFILE, ">$table_name" ) or &bail ( "Can't open database file for write." );
	print DATAFILE @$recordset or &bail ( "Can't write to database file." );
	close DATAFILE;
	
	chmod ( 0666, $table_name );
}




##################################
# db_insert ( ) - appends one "row" to a "table"
# $table_name:	full path of the text file
# $record_row:	the "row" (| delimited string) to append
##################################

sub db_insert ( )
{
	my $table_name = shift;
	my $record_row = shift;
	
	# back up the file if it already exists
	
	if ( -e $table_name )
	{
		&bail ( "Can't back up database $table_name." ) if ( copy ( "$table_name", "$table_name\.bak" ) == 0 );
	}
   
	chmod ( 0666, "$table_name\.bak" );

	open ( DATAFILE, ">>$table_name" ) or &bail ( "Can't open database file for append." );
	print DATAFILE $record_row or &bail ( "Can't append to database file." );;
	close DATAFILE;
	
	chmod ( 0666, $table_name );
}




##################################
# read_user ( ) - finds the database file containing the specified user
# and returns the user record in the form of a | delimited string
# $user_name:	user name to look for
##################################

sub read_user ( )
{
	my $user_name = shift;
	my $count, $ascii_values;
	
	# find the database file containing the user
	
	$count = 0;
	@ascii_values = unpack ( 'C*', uc ( $user_name ) );
	foreach $ascii_value ( @ascii_values ) { $count += $ascii_value; };
	$count = $count % 100;
	
	# read the record
	
	if ( -e "$basedir/$userdir/$count.txt" )
	{
		open ( DATAFILE, "$basedir/$userdir/$count.txt" ) or &bail ( "Can't open database file $basedir/$userdir/$count.txt for read." );
		@users_file = <DATAFILE>;
		close DATAFILE;

		foreach $user_line ( @users_file )
		{
			( $uf_user, $uf_pass, $uf_email, $uf_location, $uf_occupation, $uf_homepage, $uf_allow_email, $uf_status, $uf_show_email, $uf_posts, $uf_last_post, $uf_reg_date, $uf_last_logout, $uf_default_history ) = split ( '\|', $user_line );
			return $user_line if ( uc ( $uf_user ) eq uc ( $user_name ) );
		}
	} else
	{
		return "";
	}
}




##################################
# write_user ( ) - writes the user record specified by $user_record
# to the appropriate users database file
# $user_record:	user record to write
##################################

sub write_user ( )
{
	my $user_record = shift;
	my $count, $ascii_values;
	
	# get the user name
	
	( $user_name, $junk ) = split ( '\|', $user_record );
	
	# find the database file containing the user
	
	$count = 0;
	@ascii_values = unpack ( 'C*', uc ( $user_name ) );
	foreach $ascii_value ( @ascii_values ) { $count += $ascii_value; };
	$count = $count % 100;
	
	# write the record
	
	open ( DATAFILE, "$basedir/$userdir/$count.txt" ) or &bail ( "Can't open database file for read." );
	@users_file = <DATAFILE>;
	close DATAFILE;
	
	foreach $user_line ( @users_file )
	{
		( $uf_user, $uf_pass, $uf_email, $uf_location, $uf_occupation, $uf_homepage, $uf_allow_email, $uf_status, $uf_show_email, $uf_posts, $uf_last_post, $uf_reg_date, $uf_last_logout, $uf_default_history ) = split ( '\|', $user_line );
		if ( uc ( $uf_user ) eq uc ( $user_name ) )
		{
			$user_line = $user_record;
			last;
		}
	}
	
	open ( DATAFILE, ">$basedir/$userdir/$count.txt" ) or &bail ( "Can't open database file for write." );
	print DATAFILE @users_file;
	close DATAFILE;
	
	chmod ( 0666, "$basedir/$userdir/$count.txt" );
}




##################################
# append_user ( ) - appends the user record specified by $user_record
# to the appropriate users database file
# $user_record:	user record to append
##################################

sub append_user ( )
{
	my $user_record = shift;
	my $count, $ascii_values;
	
	# get the user name
	
	( $user_name, $junk ) = split ( '\|', $user_record );
	
	# find the database file that will contain the user
	
	$count = 0;
	@ascii_values = unpack ( 'C*', uc ( $user_name ) );
	foreach $ascii_value ( @ascii_values ) { $count += $ascii_value; };
	$count = $count % 100;
	
	# append the record
	
	open ( DATAFILE, ">>$basedir/$userdir/$count.txt" ) or &bail ( "Can't open database file for write." );
	print DATAFILE $user_record;
	close DATAFILE;
	
	chmod ( 0666, "$basedir/$userdir/$count.txt" );
}





##################################
# delete_user ( ) - deletes the user record specified by $user_name
# from the appropriate users database file
# $user_record:	user record to append
##################################

sub delete_user ( )
{
	my $user_name = shift;
	my $count, $ascii_values;
	my @new_users_file;
	
	# find the database file containing the user
	
	$count = 0;
	@ascii_values = unpack ( 'C*', uc ( $user_name ) );
	foreach $ascii_value ( @ascii_values ) { $count += $ascii_value; };
	$count = $count % 100;
	
	# delete the record
	
	open ( DATAFILE, "$basedir/$userdir/$count.txt" ) or &bail ( "Can't open database file for read." );
	@users_file = <DATAFILE>;
	close DATAFILE;
	
	@new_users_file = ();

	foreach $user_line ( @users_file )
	{
		( $uf_user, $uf_pass, $uf_email, $uf_location, $uf_occupation, $uf_homepage, $uf_allow_email, $uf_status, $uf_show_email, $uf_posts, $uf_last_post, $uf_reg_date, $uf_last_login, $uf_default_history ) = split ( '\|', $user_line );

		if ( uc ( $user_name ) ne uc ( $uf_user ) )
		{
			push @new_users_file, "$uf_user|$uf_pass|$uf_email|$uf_location|$uf_occupation|$uf_homepage|$uf_allow_email|$uf_status|$uf_show_email|$uf_posts|$uf_last_post|$uf_reg_date|$uf_last_login|$uf_default_history";
		}
	}
	
	open ( DATAFILE, ">$basedir/$userdir/$count.txt" ) or &bail ( "Can't open database file for write." );
	print DATAFILE @new_users_file;
	close DATAFILE;
	
	chmod ( 0666, "$basedir/$userdir/$count.txt" );
}





##################################
# bail ( ): general error handling routine
# $msg: error message to report
# $notify: if set to "nonotify" then don't email the admin
# (used by sendmail ( ) to avoid infinite recursion)
##################################

sub bail ( )
{
	my ( $msg, $notify ) = @_;
	
	# release any locks on files

	unlock_file ( "$forumdir/$topic.txt" );	
	unlock_file ( "$forumdir/$indexfilename" );
	unlock_file ( "$basedir/$listfilename" );
	unlock_file ( "$basedir/$targetforum/$indexfilename" );
	
	unlock_file ( "$basedir/$usersfilename" ) if ( $msg !~ /^Lock timeout on users database/ );
	
	# send mail to admin unless otherwise specified
	
	if ( $admin_email ne "" && $notify ne "nonotify" )
	{	
		$action = $query->param(action);
		$current_time = gmtime;
		$host = $query->remote_host();
		$browser = $query->user_agent();
		$path_info = $query->path_info();
		$request_method = $query->request_method();
		$path_translated = $query->path_translated();
		$query_string = $query->query_string();
		$script_name = $query->script_name();
		$raw_cookie = $query->raw_cookie();
		
		$body_text = "The following error occurred today at $current_time GMT:\n\n";
		$body_text .= "$msg\n\n";
		$body_text .= "User Name: $user\n";
		$body_text .= "Board: $board\n";
		$body_text .= "Forum: $forum\n";
		$body_text .= "Topic: $topic\n";
		$body_text .= "Entry: $entry\n";
		$body_text .= "Action: $action\n";
		$body_text .= "---------------------------------------------------\n";
		$body_text .= "Remote Host: $host\n";
		$body_text .= "Browser: $browser\n";
		$body_text .= "Extra Path Info: $path_info\n";
		$body_text .= "Request Method: $request_method\n";
		$body_text .= "Translated Path: $path_translated\n";
		$body_text .= "Query String: $query_string\n";
		$body_text .= "Script Name: $script_name\n";
		$body_text .= "Raw Cookies: $raw_cookie\n";
		$body_text .= "---------------------------------------------------\n";
	
		&sendmail ( $from_email, $from_friendly, $admin_email, "$admin_email", "$board_title: Error Notification", $body_text );
	}

	print <<END_OF_PAGE;
	Content-type: text/html\n\n
	<html>
	<head>
	<title>Error!</title>
	</head>
	<body bgcolor="#FFFFFF">
	<br>
	We're sorry, but there has been an error processing your request.
	<br>
	Please contact <a href="mailto:$reg_email">$reg_email</a> for assistance, quoting the error message:
	<br>
	<br>
	<b>$msg</b>
	<br>
	<br>
	Thank you.
	</body>
	</html>
END_OF_PAGE
	die $msg;
}



##################################
# lock_file: file locking routine
##################################

sub lock_file ( )
{
	my $filename = shift(@_);
	my $i;
	for ( $i=0; $i<5000; $i++ )
	{
		if ( not -e "$filename.lck" )
		{
				
			open LOCKFILE, ">$filename.lck";
			close LOCKFILE;
			last;
		}
	}
		
	if ( $i == 5000 )
	{
		unlock_file ( $filename );
		&bail ( "Lock timeout on database file - please try again." );
		return -1;
	} else {
		return 0;
	}

}



##################################
# unlock_file: file unlocking routine
##################################

sub unlock_file ( )
{
	my $filename = shift(@_);
	unlink "$filename.lck";
}



##################################
# include_html: dumps the specified html file to the output stream.
# replaces all [#vars#] in the file with their actual $vars values.
##################################

sub include_html ( )
{
	my $filename = shift(@_);
	open ( TEMPLATE, "$filename" ) or &bail ( "Can't open template file $filename." );
	undef $/;
	$template_html = <TEMPLATE>;
	$/ = "\n";
	close TEMPLATE;
	
	# search for includes ( [#include="filename"#] ) and replace with the actual
	# HTML files in the include hash
	
	$template_html =~ s/\[\#include\=\"(.+)\"(\#\])/eval("\$include_files\{"."\"$1\""."\}")/eg;
	
	# do the standard [#var#] -> $var substitution
	
	$template_html =~ s/\[\#(\w+)(\#\])/eval("\$"."$1")/eg;
	print $template_html;
}


##################################
# get_html: similar to include_html ( ) but doesn't dump to the
# output stream, or do any variable replacement.  Just grabs html
# file into a single string.
##################################

sub get_html ( )
{
	my $filename = shift(@_);
	open ( HTMLFILE, "$filename" ) or &bail ( "Can't open html file $filename." );
	undef $/;
	$html_file = <HTMLFILE>;
	$/ = "\n";
	close HTMLFILE;
	
	# search for includes ( [#include="filename"#] ) and replace with the actual
	# HTML files in the include hash
	
	$html_file =~ s/\[\#include\=\"(.+)\"(\#\])/eval("\$include_files\{"."\"$1\""."\}")/eg;
	
	return $html_file;
}



##################################
# get_includes: scans the _include/ directory in the current board
# for any files, then creates a hash of filenames -> contents.
# this hash is then used to include the html in the forum pages
# where specified in the templates by [#include="filename"#].
##################################

sub get_includes ( )
{
	opendir THISDIR, "$basedir/_include";
	@allfiles = grep !/^\.\.?$/, readdir THISDIR;
	closedir THISDIR;

	foreach $filename ( @allfiles )
	{
		if ( -d "$basedir/_include/$filename" != 1 )
		{
			$include_files{$filename} = &get_html ( "$basedir/_include/$filename" );
		}
	}
}

true;