#!/usr/bin/perl
#
# userbase.cgi - trial version
#
######################################################################
#
# NOTE: THIS TEXT FILE IS THE TRIAL VERSION OF USERBASE.
# SAVE IT TO YOUR COMPUTER THEN UPLOAD IT TO YOUR SERVER AND
# NAME IT "userbase.cgi".  SEE FULL INSTRUCTIONS HERE:
#
#	http://encodable.com/userbase/#instructions
# 
######################################################################
#
# DO NOT EDIT THIS FILE unless absolutely necessary; in most cases
# you should be editing userbase_prefs.cgi instead.
# 
######################################################################
#
# This program is the copyrighted work of Encodable Industries.
# Redistribution is prohibited, and copying is only permitted for
# backup purposes.  You are free to modify the program for your
# own use, but you may not distribute any modified copies of it.
#
# Use of this program requires a one-time license fee.  You can
# obtain a license here:
#
#	http://encodable.com/userbase/
#
# This software comes with no warranty.  The author and many other
# people have found it to be useful, and it is our hope that you
# find it useful as well, but it comes with no guarantees.  Under
# no circumstances shall Encodable Industries be held liable in 
# any situation arising from your use of this program.  We are
# generally happy to provide support to all our users, but we can
# make no guarantee of support.
#
# For more information about this program, as well as for help
# and support, please visit the following pages:
#
# Homepage: http://encodable.com/userbase/
# Contact:  http://encodable.com/contact/


my $version = "1.80t-e18";
$ENV{PATH} = '/bin:/usr/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
($ENV{DOCUMENT_ROOT}) = ($ENV{DOCUMENT_ROOT} =~ /(.*)/); # untaint.
use CGI::Carp 'fatalsToBrowser';
my %PREF = ();

use strict;
use Digest::MD5 'md5_hex';
use DBI;

sub printd;

my $qs = ();
load_prefs();
if($PREF{show_userbase_errors_in_browser} =~ /yes/i)
{
	use CGI::Carp 'fatalsToBrowser';
}



   if($qs eq 'logout')							{ do_logout();					}
elsif($qs =~ /(?:^|&)action=loggedout&whence=(.*)(?:&|$)/)		{ show_loggedout_page($1);			} # note that the whence regex is .* not .*? because the value will likely contain ampersands that we want to keep.

elsif($qs =~ /(?:^|&)action=showusers(?:&|$)/)				{ showusers();					}
elsif($qs =~ /(?:^|&)action=adduser(?:&|$)/)				{ print_user_form('add');			}
elsif($qs =~ /(?:^|&)action=edituser&id=(\d+?)(?:&|$)/)			{ print_user_form('edit', $1);			}
elsif($qs =~ /(?:^|&)action=commitadduser(?:&|$)/)			{ process_new_account();			}
elsif($qs =~ /(?:^|&)action=commitedituser(?:&|$)/)			{ edit_user_account();				}

elsif($qs =~ /(?:^|&)action=deleteuser&id=(.+?)(?:&|$)/)		{ delete_user($1);				}
elsif($qs =~ /(?:^|&)action=commitdeleteuser&id=(.+?)(?:&|$)/)		{ commit_delete_user($1);			}

elsif($qs =~ /(?:^|&)action=showgroups(?:&|$)/)				{ showgroups();					}
elsif($qs =~ /(?:^|&)action=addgroup(?:&|$)/)				{ print_group_form('add');			}
elsif($qs =~ /(?:^|&)action=editgroup&id=(\d+)(?:&|$)/)			{ print_group_form('edit',$1);			}
elsif($qs =~ /(?:^|&)action=commitaddgroup(?:&|$)/)			{ process_new_group();				}
elsif($qs =~ /(?:^|&)action=commiteditgroup(?:&|$)/)			{ edit_group();					}

elsif($qs =~ /(?:^|&)action=deletegroup&id=(.+?)(?:&|$)/)		{ delete_group($1);				}
elsif($qs =~ /(?:^|&)action=commitdeletegroup&id=(.+?)(?:&|$)/)		{ commit_delete_group($1);			}

elsif($qs =~ /(?:^|&)action=validate(?:&|$)/)				{ do_login();					}
elsif($qs =~ /(?:^|&)action=chklogin(?:&|$)/)				{ check_login();				}
#elsif($qs =~ /(?:^|&)action=chpw(?:&|$)/)				{ chpw();					}
#elsif($qs =~ /(?:^|&)action=chpw2(?:&|$)/)				{ chpw2();					}

elsif($qs =~ /(?:^|&)action=import(?:&|$)/)				{ import_users();				}

elsif($qs =~ /(?:^|&)action=pwreset1(?:&|$)/)				{ print_pwreset_page();				}

elsif($qs =~ /(?:^|&)action=test(?:&|$)/)				{ test_function();				}

#elsif($qs =~ /do_email_test/)						{ do_email_test();				}

elsif($qs =~ /(?:^|&)rslt=\d+(?:&|$)/)					{ show_results_page();				}
elsif($qs =~ /(?:^|&)phase=([es].+?)(?:&|$)/)				{ show_message($1);				}

else
{
	if($PREF{admin_is_logged_in}   &&   $PREF{"always_redirect_admins_to"} =~ m!^https?://!)
	{
		$PREF{always_redirect_admins_to} =~ s/%%username%%/$PREF{logged_in_username}/g;
		enc_redirect($PREF{always_redirect_admins_to});
	}
	elsif($PREF{member_is_logged_in}   &&   !$PREF{admin_is_logged_in}   &&   $PREF{"always_redirect_members_to"} =~ m!^https?://!) # need the !admin because admins are members too.
	{
		$PREF{always_redirect_members_to} =~ s/%%username%%/$PREF{logged_in_username}/g;
		enc_redirect($PREF{always_redirect_members_to});
	}
	else
	{
		my $title = $PREF{member_is_logged_in} ? "Main Menu" : undef;
		start_html_output($title);
		prompt_for_login() unless $PREF{member_is_logged_in};
		finish_html_output();
	}
}




##############################################################################
##############################################################################
##### Subroutines follow.
##############################################################################
##############################################################################




sub create_new_session_id
{
	my $username = shift;
	my $password = shift;
	my $id = offsettime() . $$ . $ENV{REMOTE_ADDR} . $ENV{HTTP_USER_AGENT} . $username . $password;

	#$id =~ s/[^\d]//g;
	#$id = substr($id,0,85);
	$id = md5_hex($id);
	return $id;
}


sub check_for_multiple_logins($)
{
	my ($userid) = @_;
	die_unless_numeric($userid,'userid');
	my $old_login_time = enc_sql_select("SELECT `loggedin` FROM `$PREF{user_table_name}` WHERE `id` = $userid;");
	if($old_login_time =~ /[1-9]/   &&   !login_session_expired($old_login_time))
	{
		if($PREF{prevent_multiple_simultaneous_logons_per_username} =~ /yes/i)
		{
			my $go = "$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{login_url}?phase=emultlogin";
			enc_redirect($go);
		}
		else
		{
			my $success = enc_sql_update("UPDATE `$PREF{user_table_name}` SET `numusers`=IFNULL(`numusers`,0)+1 WHERE `id` = '$userid';");
			die_nice("Error: check_for_multiple_logins('$userid'): SQL returned '$success' instead of '1' while incrementing numusers column.") unless $success == 1;

			my $existing_session_id = enc_sql_select("SELECT `mrsession` FROM `$PREF{user_table_name}` WHERE `id` = '$userid';");
			return $existing_session_id;
		}
	}
}


sub log_user_into_db
{
	my ($userid, $my_session_id, $logintime, $restrict_ip) = @_;

	die_unless_numeric($userid,'userid');
	die_unless_numeric($logintime,'logintime');

	check_sessionid_for_sql_safeness($my_session_id);

	my $success = enc_sql_update("UPDATE `$PREF{user_table_name}` SET `loggedin` = $logintime, `mrsession` = '$my_session_id' WHERE `id` = '$userid';");
	die_nice("Error: log_user_into_db('$userid', '$my_session_id', '$logintime', '$restrict_ip'): SQL returned '$success' instead of '1' while logging user in.") unless $success == 1;

	if($restrict_ip)
	{
		my $ip = $ENV{REMOTE_ADDR};
		check_ip_for_sql_safeness($ip);

		unless(enc_sql_select("SELECT `ip` FROM `$PREF{user_table_name}` WHERE `id` = '$userid'") eq $ip)
		{
			my $success = enc_sql_update("UPDATE `$PREF{user_table_name}` SET `ip` = '$ip' WHERE `id` = '$userid';");
			die_nice("Error: log_user_into_db('$userid', '$my_session_id', '$logintime', '$restrict_ip'): SQL returned '$success' instead of '1' while setting user IP.") unless $success == 1;
		}
	}
	else
	{
		unless(enc_sql_select("SELECT `ip` FROM `$PREF{user_table_name}` WHERE `id` = '$userid'") eq '')
		{
			my $success = enc_sql_update("UPDATE `$PREF{user_table_name}` SET `ip` = '' WHERE `id` = '$userid';");
			die_nice("Error: log_user_into_db('$userid', '$my_session_id', '$logintime', '$restrict_ip'): SQL returned '$success' instead of '1' while clearing user IP.") unless $success == 1;
		}
	}
}


sub log_user_out_of_db
{
	my ($username, $my_session_id) = @_;

	check_username_for_sql_safeness($username);
	check_sessionid_for_sql_safeness($my_session_id) unless $my_session_id eq 'force';

	# It's possible (and probably not particularly uncommon) that a user logs in at one location, then leaves
	# that location and his session goes idle, and then he logs in at another location with the same account.  In
	# that case, a call to log_user_out_of_db() from the first location should not actually do the db logout, 
	# because the session does not belong to him anymore.  But note that this is not an error condition, so we
	# should just silently return.
	#
	my $session_id_in_db = enc_sql_select("SELECT `mrsession` FROM `$PREF{user_table_name}` WHERE LOWER(`username`) = LOWER('$username');");

	if($my_session_id == $session_id_in_db   ||   $my_session_id eq 'force')
	{
		my $success = enc_sql_update("UPDATE `$PREF{user_table_name}` SET `loggedin` = 0 WHERE `username` = '$username';");
		die_nice("Error: log_user_out_of_db('$username', '$my_session_id'): SQL returned '$success' instead of '1' while setting loggedin to zero.") unless $success == 1;

		my $success = enc_sql_update("UPDATE `$PREF{user_table_name}` SET `mrsession` = '' WHERE `username` = '$username';");
		die_nice("Error: log_user_out_of_db('$username', '$my_session_id'): SQL returned '$success' instead of '1' while setting mrsession to null.") unless $success == 1;
	}
}


sub determine_default_login_destination
{
	my $ref = shift;
	my $go = ();
	if($qs =~ /(?:^|&)whence=(.+)/)
	{
		$go = $1;
		enc_urldecode($go);
	}
	else
	{
		$go = $ref ? $ref : "$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{login_url}";
		my $us1 = $PREF{login_url};
		my $us2 = $ENV{SCRIPT_NAME};
		if($go =~ /($us1|$us2)\?.+/)
		{
			# If the page we were on before was a login page with some
			# query-string, then just return to the login frontpage.
			$go = "$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{login_url}";
		}
		elsif($go !~ m!^https?://(www\.)?$ENV{HTTP_HOST}!)
		{
			# If the page we were on before was on an external site, then
			# obviously we don't want to redirect there, since we won't be
			# logged in there.  Again, just return to the login frontpage.
			$go = "$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{login_url}";
		}
	}
	return $go;
}


sub prompt_for_login()
{

my $i = 0;
my $whence = $qs =~ /(?:^|&)whence=(.+)/ ? "&whence=$1" : undef; # don't urldecode because it's just going right back onto the URL.

my $login_form =  qq`
<form method="post" action="$ENV{SCRIPT_NAME}?action=validate$whence">
<table id="formug" class="login">
	<tr class="header"><th colspan="2">Login</th></tr>

	<tr class="` . oddeven($i) . qq`">
	<td class="label">Username:</td>
	<td><input type="text" class="default text" name="$PREF{userbase_user_fieldname}" maxlength="4" id="ubun" /></td>
	</tr>

	<tr class="` . oddeven($i) . qq`">
	<td class="label">Password:</td>
	<td><input type="password" maxlength="4" class="default text" name="$PREF{userbase_pass_fieldname}" /></td>
	</tr>
`;



$login_form .= qq`
	<tr class="` . oddeven($i) . qq`">
	<td class="label" colspan="2"><input type="hidden" name="ref" value="$ENV{HTTP_REFERER}" />
	<input type="submit" value="Login" class="defaultbutton" /></td>
	</tr>
</table>
</form>
`;

print $login_form;

}




sub user_has_addmember_rights
{
	return user_is_allowed_to($PREF{logged_in_userid}, 'create_new_accounts');
}


sub user_has_addadmin_rights
{
	return $PREF{admin_is_logged_in};
}


sub user_is_allowed_to
{
	my $userid_performing_action = shift;
	my $action = shift;
	my $user_affected_by_action = shift;

	return 1 if is_admin($userid_performing_action);

	my $allowed = 0;

	foreach my $group (split(/[,\s]+/, $PREF{"groups_allowed_to_$action"}))
	{
		if($group =~ /^self$/i)
		{
			$allowed = 1 if ($PREF{member_is_logged_in}   &&   $userid_performing_action == get_user_id($user_affected_by_action));
		}
		else
		{
			$allowed = 1 if user_is_member_of_group($userid_performing_action, $group);
		}

		return $allowed if $allowed;
	}

	return 0;
}


sub print_user_form()
{
	my $mode = shift;
	my %vars = ();
	if($mode eq 'add')
	{
		my $go = "$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{login_url}";
		if(!user_has_addmember_rights()) { enc_redirect("$go?phase=eneedlogin"); }
	
		$vars{title}			= 'Add New User';
		$vars{pw}			= 'Password:';
		$vars{pw2}			= 'Password, again:';
		$vars{button_label}		= 'Add User';
		$vars{target}			= 'action=commitadduser';
	}
	else # edit the user info instead.
	{
		$vars{user_id}			= shift;
		die_unless_numeric($vars{user_id}, 'userid (from print_user_form())');

		$vars{username}			= get_user_name($vars{user_id});

		my $go = "$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{login_url}";
		if(!user_is_allowed_to($PREF{logged_in_userid}, 'edit_user_info', $vars{username})) { enc_redirect("$go?phase=eneedlogin"); }

		$vars{title}			= 'Edit User';
		$vars{pw}			= 'New Password:';
		$vars{pw2}			= 'New Password, again:';
		$vars{button_label}		= 'Modify User';
		$vars{target}			= "action=commitedituser";

		$vars{username_readonly}	= $PREF{usernames_are_immutable_once_created} =~ /no/i && user_is_allowed_to($PREF{logged_in_userid}, 'change_usernames', $vars{username}) ? undef : qq`readonly="readonly"`;

		$vars{realname}			= get_real_name($vars{user_id});
		$vars{email}			= get_email_address($vars{user_id});

		$vars{account_locked}		= enc_sql_select("SELECT `acct_locked` FROM `$PREF{user_table_name}` WHERE `id` = '$vars{user_id}';");
		$vars{account_disabled}		= enc_sql_select("SELECT `acct_disabled` FROM `$PREF{user_table_name}` WHERE `id` = '$vars{user_id}';");
	}


	start_html_output("$vars{title}");

my $i = 0;
print qq`
<form method="post" action="$ENV{SCRIPT_NAME}?$vars{target}" class="user" id="userform" onsubmit="return startupload()">

<table id="formug">
	<tr class="header"><th colspan="2">$vars{title}</th></tr>

	<tr class="` . oddeven($i) . qq`">
	<td class="label">Username:</td>
	<td><input type="text" name="username" class="default" maxlength="4" value="$vars{username}" $vars{username_readonly} /></td>
	</tr>

	<tr class="` . oddeven($i) . qq`">
	<td class="label">Real Name:</td>
	<td><input type="text" name="realname" class="default` . ($PREF{realname_field_required} =~ /yes/i ? ' required' : undef) . qq`" maxlength="$PREF{max_realname_length}" value="$vars{realname}" /></td>
	</tr>

	<tr class="` . oddeven($i) . qq`">
	<td class="label">Email Address:</td>
	<td><input type="text" name="email" class="default` . ($PREF{email_field_required} =~ /yes/i ? ' required emailformat' : undef) . qq`" maxlength="$PREF{max_emailaddr_length}" value="$vars{email}" /></td>
	</tr>
`;


# To print the current-password field, me must be in edit mode, and the
# current user must NOT be an admin, because admins don't need the current
# password to change a user's password... unless the admin is trying to
# change his OWN password, in which case, require the current password.
#
if(	$mode eq 'edit'   &&   (!$PREF{admin_is_logged_in}   ||   this_user_is_the_logged_in_admin($vars{username}))   )
{
	print qq`
	<tr class="` . oddeven($i) . qq`">
	<td class="label">Current Password<br />(only if changing):</td>
	<td><input type="password" name="oldpw" class="default" maxlength="4" /></td>
	</tr>
	`;
}


print qq`
	<tr class="` . oddeven($i) . qq`">
	<td class="label">$vars{pw}</td>
	<td><input type="password" name="pw1" class="default" maxlength="4" /></td>
	</tr>

	<tr class="` . oddeven($i) . qq`">
	<td class="label">$vars{pw2}</td>
	<td><input type="password" name="pw2" class="default" maxlength="4" /></td>
`;


if($mode eq 'edit'   &&   $PREF{admin_is_logged_in})
{
	print qq`
	<tr class="` . oddeven($i) . qq`">
	<td class="label">Account Locked <span style="font-weight: normal;">(this is the <br />"too many failed logins" lock; it <br />` . ($PREF{lock_lasts_until_admin_removes_it} =~ /yes/i ? 'requires manual unlocking by an <br />admin here' : "auto-unlocks after $PREF{failed_logins_within_N_secs_count_towards_lock} seconds") . qq`)</span>:</td>
	<td><input type="checkbox" name="account_locked" ` . ($vars{account_locked} ? 'checked="checked"' : undef) . qq` /></td>
	</tr>
	`;
}


if($mode eq 'edit'   &&   $PREF{admin_is_logged_in})
{
	print qq`
	<tr class="` . oddeven($i) . qq`">
	<td class="label">Account Disabled <span style="font-weight: normal;">(this can only <br />be changed here, by an admin)</span>:</td>
	<td><input type="checkbox" name="account_disabled" ` . ($vars{account_disabled} ? 'checked="checked"' : undef) . qq` /></td>
	</tr>
	`;
}


	my $group_title_printed = 0;
	my $groups = get_groups_hash($vars{user_id});
	foreach my $group (sort keys %$groups)
	{
		next if ($group =~ /^$PREF{admin_group_name}$/i && !user_has_addadmin_rights());
		unless($group_title_printed) { print qq`\t<tr class="` . oddeven($i) . qq`">\n\t<td class="label">Group Memberships:</td>\n\t<td class="groups">`; $group_title_printed = 1; }
		my $checked = $$groups{$group}{is_member} ? qq`checked="checked"` : undef;

		# the checkboxes are disabled unless the user is an admin, i.e. only admins can change group memberships.
		# also disable the "public" checkbox, since that applies to all users by definition.
		my $disabled = ($group =~ /^($PREF{public_group_name}|$PREF{member_group_name})$/i || !$PREF{admin_is_logged_in}) ? 'disabled="disabled"' : undef;

		# Admins can see all groups here; non-admins can only see the groups they belong to.
		if($PREF{admin_is_logged_in} || $$groups{$group}{is_member})
		{
			my $label = $PREF{admin_is_logged_in} && !$disabled ? qq`<span onclick="this.previousSibling.checked = !(this.previousSibling.checked);">$group</span>` : $group;
			print qq`<input type="checkbox" name="group-$group" $checked $disabled />$label<br /><br />\n`
		}
	}
	if($group_title_printed)
	{
		print qq`</td>\n\t</tr>\n`;
	}

	print	  qq`\n`
		. qq`\t<tr class="` . oddeven($i) . qq`">\n\t<td colspan="2">`
		. qq`<input type="hidden" name="userid" value="$vars{user_id}" />`
		. qq`<input type="button" value="$vars{button_label}" class="defaultbutton" onclick="submitform()" />`
		. qq`</td>\n\t</tr>`
		. qq`\n</table>`
		. qq`\n</form>`
		. qq`\n`;


	finish_html_output();
}




sub print_group_form()
{
	my $mode = shift;
	my %vars = ();

	if($mode eq 'add')
	{
		my $go = "$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{login_url}";
		if(!user_is_allowed_to($PREF{logged_in_userid}, 'create_new_groups')) { enc_redirect("$go?phase=eneedlogin"); }
	
		$vars{title}			= 'Add New Group';
		$vars{button_label}		= 'Add Group';
		$vars{target}			= 'action=commitaddgroup';
	}
	else # edit the group info instead.
	{
		$vars{group_id}			= shift;
		$vars{group}			= get_group_name($vars{group_id});

		my $go = "$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{login_url}";
		if(!user_is_allowed_to($PREF{logged_in_userid}, 'edit_group_info')) { enc_redirect("$go?phase=eneedlogin"); }

		$vars{title}			= 'Edit Group';
		$vars{button_label}		= 'Modify Group';
		$vars{target}			= "action=commiteditgroup";

		$vars{groupname_readonly}	= $PREF{groupnames_are_immutable_once_created} =~ /no/i && user_is_allowed_to($PREF{logged_in_userid}, 'change_groupnames') ? undef : qq`readonly="readonly"`;
		$vars{groupdesc}		= get_group_desc($vars{group_id});
	}


	start_html_output("$vars{title}");

my $i = 0;
print qq`
<form method="post" action="$ENV{SCRIPT_NAME}?$vars{target}" class="group">

<table id="formug">
	<tr class="header"><th colspan="2">$vars{title}</th></tr>

	<tr class="` . oddeven($i) . qq`">
	<td class="label">Group:</td>
	<td><input type="text" name="group" class="default" maxlength="$PREF{max_groupname_length}" value="$vars{group}" $vars{groupname_readonly} /></td>
	</tr>

	<tr class="` . oddeven($i) . qq`">
	<td class="label">Description:</td>
	<td><textarea name="groupdesc" class="default" maxlength="$PREF{max_group_description_length}" />$vars{groupdesc}</textarea></td>
`;


	print	  qq`\n`
		. qq`\t<tr class="` . oddeven($i) . qq`">\n\t<td colspan="2"><input type="hidden" name="groupid" value="$vars{group_id}" />`
		. qq`<input type="submit" value="$vars{button_label}" class="defaultbutton" />`
		. qq`</td>\n\t</tr>`
		. qq`\n</table>`
		. qq`\n</form>`
		. qq`\n`;


	finish_html_output();
}






sub process_new_account()
{
	use CGI ':param';
	my $go			= "$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{login_url}";
	my $user		= param('username');
	my $email		= param('email');
	my $realname		= param('realname');
	my $pass		= param('pw1');
	my $salt		= ask_test($PREF{salt_length});
	my $crypted_pass	= ask_pw($pass,$salt);

	   if(!user_has_addmember_rights())						{ enc_redirect("$go?phase=eneedlogin");		}
	elsif(!realname_is_valid($realname) && $realname)				{ enc_redirect("$go?phase=einvldr");		}
	elsif(!emailaddr_is_valid($email) && $email)					{ enc_redirect("$go?phase=einvlde");		}
	elsif(!password_is_valid($pass))						{ enc_redirect("$go?phase=einvldp");		}
	elsif(!hashedpw_is_valid($crypted_pass))					{ enc_redirect("$go?phase=einvldh");		}
	elsif(!username_is_valid($user))						{ enc_redirect("$go?phase=ebadname");		}
	elsif( username_is_taken($user))						{ enc_redirect("$go?phase=edupuser");		}
	elsif( param('group-admin') =~ /on/i   &&   !user_has_addadmin_rights())	{ enc_redirect("$go?phase=einsuff");		}
	elsif( param('pw1') ne param('pw2'))						{ enc_redirect("$go?phase=epwmismatch");	}

	add_new_user($user, $crypted_pass, $salt, $realname, $email);

	my $query = new CGI;
	my %params = $query->Vars;
	foreach my $param (sort keys %params)
	{
		if($param =~ /^group-(.+)$/)
		{
			my $group = $1;
			next if ($group =~ /^$PREF{admin_group_name}$/i && !user_has_addadmin_rights());
			next if ($group =~ /^($PREF{public_group_name}|$PREF{member_group_name})$/i); # every account is automatically a member of these groups.
			add_user_to_group($user, $group) if $params{$param} =~ /on/i;
		}
	}

	enc_urlencode($user);
	enc_redirect("$go?phase=snewadd&one=$user");
}


sub process_new_group()
{
	use CGI ':param';
	my $go			= "$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{login_url}";
	my $group		= param('group');
	my $groupdesc		= param('groupdesc');

	   if(!user_is_allowed_to($PREF{logged_in_userid}, 'create_new_groups'))	{ enc_redirect("$go?phase=eneedlogin");		}
	elsif(!groupname_is_valid($group))						{ enc_redirect("$go?phase=einvldgn");		}
	elsif(!groupdesc_is_valid($groupdesc) && $groupdesc)				{ enc_redirect("$go?phase=einvldgd");		}
	elsif(group_exists($group))							{ enc_redirect("$go?phase=egrpexist");		}
	elsif($group =~ /^(self)$/i)							{ enc_redirect("$go?phase=egrprsvd");		}

	add_new_group($group, $groupdesc);

	enc_redirect("$go?phase=snewgrp&one=$group");
}


sub this_user_is_the_logged_in_admin($)
{
	my $username = shift;
	return $PREF{admin_is_logged_in} && lc($PREF{logged_in_username}) eq lc($username);
}


sub edit_user_account()
{
	use CGI ':param';
	my $go = "$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{login_url}";

	my $userid = param('userid');
	check_uid_for_uniqueness($userid); # checks for sql safeness too.
	my $username_in_db = get_user_name($userid);
	my $username = $username_in_db;

	if(!user_is_allowed_to($PREF{logged_in_userid}, 'edit_user_info', $username_in_db)) { enc_redirect("$go?phase=eneedlogin"); }

	my (@results, $sth) = ();

	my $username_from_form = param('username');
	if($username_from_form ne $username_in_db)
	{
		if(user_is_allowed_to($PREF{logged_in_userid}, 'change_usernames', $username_in_db))
		{
			if(username_is_valid($username_from_form))
			{
				$sth = $PREF{dbh}->prepare("UPDATE `$PREF{user_table_name}` SET `username` = '$username_from_form' WHERE `id` = $userid");
				$sth->execute() or die_nice("$0: edit_user_account() failed: [userid='$userid', username_from_form='$username_from_form']: $DBI::errstr\n");
				$username = $username_from_form;
				push @results, 101;
			}
			else
			{
				push @results, 102;
			}
		}
	}


	my $realname_from_form = param('realname');
	if($realname_from_form ne get_real_name($userid))
	{
		if(realname_is_valid($realname_from_form))
		{
			check_realname_for_sql_safeness($realname_from_form);
			$sth = $PREF{dbh}->prepare("UPDATE `$PREF{user_table_name}` SET `name` = '$realname_from_form' WHERE `id` = $userid");
			$sth->execute() or die_nice("$0: edit_user_account() failed: [userid='$userid', realname_from_form='$realname_from_form']: $DBI::errstr\n");
			push @results, 105;
		}
		else
		{
			push @results, 106;
		}
	}


	my $emailaddr_from_form = param('email');
	if($emailaddr_from_form ne get_email_address($userid))
	{
		if(emailaddr_is_valid($emailaddr_from_form))
		{
			check_emailaddr_for_sql_safeness($emailaddr_from_form);
			$sth = $PREF{dbh}->prepare("UPDATE `$PREF{user_table_name}` SET `email` = '$emailaddr_from_form' WHERE `id` = $userid");
			$sth->execute() or die_nice("$0: edit_user_account() failed: [userid='$userid', emailaddr_from_form='$emailaddr_from_form']: $DBI::errstr\n");
			push @results, 107;
		}
		else
		{
			push @results, 108;
		}
	}


	if($PREF{admin_is_logged_in})
	{
		my $groups = get_groups_hash($userid);
		foreach my $group (sort keys %$groups)
		{
			next if ($group =~ /^$PREF{admin_group_name}$/i && !user_has_addadmin_rights());
			next if $group =~ /^($PREF{public_group_name}|$PREF{member_group_name})$/i;
			if($$groups{$group}{is_member}   &&   param("group-$group") !~ /on/i)
			{
				remove_user_from_group($userid, $group);
				push @results, "109$group";
			}
			elsif(!$$groups{$group}{is_member}   &&   param("group-$group") =~ /on/i)
			{
				add_user_to_group($username, $group);
				push @results, "111$group";
			}
		}


		my $account_locked_old = enc_sql_select("SELECT `acct_locked` FROM `$PREF{user_table_name}` WHERE `id` = '$userid';");
		my $account_locked_new = param("account_locked") =~ /on/i ? 1 : 0;
		if($account_locked_old != $account_locked_new)
		{
			if($account_locked_new)
			{
				my $success = enc_sql_update("UPDATE `$PREF{user_table_name}` SET `acct_locked` = TRUE WHERE `id` = '$userid';");
				die_nice("Error: edit_user_account(id='$userid'): SQL returned '$success' instead of '1' while updating acct_locked.") unless $success == 1;
				push @results, 125;
			}
			else
			{
				my $success = enc_sql_update("UPDATE `$PREF{user_table_name}` SET `acct_locked` = FALSE WHERE `id` = '$userid';");
				die_nice("Error: edit_user_account(id='$userid'): SQL returned '$success' instead of '1' while updating acct_locked.") unless $success == 1;

				unless(enc_sql_select("SELECT `failed_logins` FROM `$PREF{user_table_name}` WHERE `id` = '$userid'") eq '')
				{
					$success = enc_sql_update("UPDATE `$PREF{user_table_name}` SET `failed_logins` = '' WHERE `id` = '$userid';");
					die_nice("Error: edit_user_account(id='$userid'): SQL returned '$success' instead of '1' while updating failed_logins.") unless $success == 1;
				}

				push @results, 127;
			}
		}


		my $account_disabled_old = enc_sql_select("SELECT `acct_disabled` FROM `$PREF{user_table_name}` WHERE `id` = '$userid';");
		my $account_disabled_new = param("account_disabled") =~ /on/i ? 1 : 0;
		if($account_disabled_old != $account_disabled_new)
		{
			if($account_disabled_new)
			{
				my $success = enc_sql_update("UPDATE `$PREF{user_table_name}` SET `acct_disabled` = TRUE WHERE `id` = '$userid';");
				die_nice("Error: edit_user_account(id='$userid'): SQL returned '$success' instead of '1' while updating acct_disabled.") unless $success == 1;
				push @results, 129;
			}
			else
			{
				my $success = enc_sql_update("UPDATE `$PREF{user_table_name}` SET `acct_disabled` = FALSE WHERE `id` = '$userid';");
				die_nice("Error: edit_user_account(id='$userid'): SQL returned '$success' instead of '1' while updating acct_disabled.") unless $success == 1;
				push @results, 131;
			}
		}
	}

	enc_redirect("$go?rslt=100&" . join '&', @results);
}


sub edit_group()
{
	use CGI ':param';
	my $go = "$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{login_url}";

	my $groupid = param('groupid');
	check_gid_for_uniqueness($groupid); # checks for sql safeness too.
	my $groupname_in_db = get_group_name($groupid);

	if(!user_is_allowed_to($PREF{logged_in_userid}, 'edit_group_info')) { enc_redirect("$go?phase=eneedlogin"); }

	my (@results, $sth) = ();

	my $groupname_from_form = param('group');
	if($groupname_from_form ne $groupname_in_db)
	{
		if(user_is_allowed_to($PREF{logged_in_userid}, 'change_groupnames'))
		{
			if(groupname_is_valid($groupname_from_form))
			{
				$sth = $PREF{dbh}->prepare("UPDATE `$PREF{group_table_name}` SET `group` = '$groupname_from_form' WHERE `id` = $groupid");
				$sth->execute() or die_nice("$0: edit_group() failed: [groupid='$groupid', groupname_from_form='$groupname_from_form']: $DBI::errstr\n");
				push @results, 121;
			}
			else
			{
				push @results, 122;
			}
		}
	}


	my $groupdesc_from_form = param('groupdesc');
	if($groupdesc_from_form ne get_group_desc($groupid))
	{
		if(groupdesc_is_valid($groupdesc_from_form))
		{
			check_groupdesc_for_sql_safeness($groupdesc_from_form);

			$sth = $PREF{dbh}->prepare("UPDATE `$PREF{group_table_name}` SET `desc` = '$groupdesc_from_form' WHERE `id` = $groupid");
			$sth->execute() or die_nice("$0: edit_group() failed: [groupid='$groupid', groupdesc_from_form='$groupdesc_from_form']: $DBI::errstr\n");
			push @results, 123;
		}
		else
		{
			push @results, 124;
		}
	}

	enc_redirect("$go?rslt=100&" . join '&', @results);
}



sub print_admin_toolbar()
{
	my %status = ();
	my $user_type = ();

	if($PREF{admin_is_logged_in})		{ $user_type = 'Admin'; }
	elsif($PREF{member_is_logged_in})	{ $user_type = 'Member'; }

	if(   ($PREF{member_is_logged_in})   ||   ($qs =~ /^login|action=validate$/)   )
	{
		return;
		print qq`\n<div class="userinfo">\n`;
		print qq`<div class="userinfoleft">` . ($PREF{member_is_logged_in} ? "$user_type $PREF{logged_in_username} logged in." : "[Not logged in.]" ) . qq`</div>`;
		print qq`\n<div class="userinforight"><a href="$PREF{login_url}">UserBase</a></div>`;
		print qq`\n<div class="clear">&nbsp;</div>`;
		print qq`\n</div>`;
	}
}


sub get_login_status_string
{
	if($PREF{member_is_logged_in})
	{
		die_unless_numeric($PREF{logged_in_userid}, 'logged_in_userid');
		my $numusers = enc_sql_select("SELECT `numusers` FROM `$PREF{user_table_name}` WHERE `id` = '$PREF{logged_in_userid}';");

		my $status = ($PREF{admin_is_logged_in} ? 'Admin' : 'Member') . qq` $PREF{logged_in_username} logged in`;
		$status .= ' (multiple locations)' if $numusers > 1;
		$status .= '.';

		return $status;
	}
	else { return undef; }
}


sub print_title
{
	my $title = shift;
	my @parts = ();
	push (@parts, $PREF{title_for_page_body}) if $PREF{title_for_page_body};
	push (@parts, $title) if $title;
	push (@parts, $ENV{HTTP_HOST}) if $PREF{include_hostname_in_page_body_title} =~ /yes/i;

	$title = join ' - ', @parts;

	$title = qq`<h1 class="pagetitle">` . $title . "</h1>" unless (!$title || $title =~ /</);
	print "$title\n";
	print qq`<p>[ This is the trial version of <a href="http://encodable.com/userbase/">UserBase</a>. ]</p>\n`;
}


sub email_failed_logins_to_webmaster($$)
{
	return unless $PREF{email_webmaster_on_failed_logins} =~ /yes/i;

	my ($attempted_username, $attempted_password) = ($_[0], $_[1]);

	return unless ($attempted_username   ||   $attempted_password); # because bots seem to trigger this a lot.

	my ($ip, $host) = get_ip_and_host();

	use POSIX; # needed for 'strftime'
	my $shortdatetime	= strftime("%a%b%d,%Y,%I:%M%P",		localtime(time));

my $msg = qq`Sent: $shortdatetime

Someone just attempted to log in at $PREF{protoprefix}$ENV{HTTP_HOST}$PREF{login_url}, but failed.

Their attempted login:
attempted username: $attempted_username
attempted password: $attempted_password

Their information:
IP:   $ip
Host: $host
User Agent: $ENV{HTTP_USER_AGENT}
Referer: $ENV{HTTP_REFERER}

`;


	send_email(	"$PREF{webmaster_name} <$PREF{webmaster_email_address}>",
			"UserBase <$PREF{login_script_email_address}>",
			"Failed login",
			$msg,
			undef,
			'die_on_email_error'
		);

}


sub print_bottom_links
{
	my ($members_only_pages, $admin_only_pages) = ();
	my %args = map { $_ => 1 } @_;

	my $i = 0;
	if($PREF{member_is_logged_in})
	{
		foreach my $pref (sort keys %PREF)
		{
			if($pref =~ /members_only_page_(\d+)_name/)
			{
				$members_only_pages .= qq`<a class="` . oddeven($i) . qq`" href="$PREF{"members_only_page_${1}_link"}">$PREF{"members_only_page_${1}_name"}</a>\n`;
			}
		}

		if(user_is_allowed_to($PREF{logged_in_userid}, 'edit_user_info', $PREF{logged_in_username}))
		{
			$members_only_pages .= qq`<a class="` . oddeven($i) . qq`" href="$PREF{login_url}?action=edituser&amp;id=` . $PREF{logged_in_userid} . qq`">Edit User Info</a>\n`;
		}
	}

	if($PREF{admin_is_logged_in})
	{
		foreach my $pref (sort keys %PREF)
		{
			if($pref =~ /admin_only_page_(\d+)_name/)
			{
				$admin_only_pages .= qq`<a class="` . oddeven($i) . qq`" href="$PREF{"admin_only_page_${1}_link"}">$PREF{"admin_only_page_${1}_name"}</a>\n`;
			}
		}


		$admin_only_pages .=	  qq`<a class="` . oddeven($i) . qq`" href="$PREF{login_url}?action=showusers">Manage Users</a>\n`
					. qq`<a class="` . oddeven($i) . qq`" href="$PREF{login_url}?action=showgroups">Manage Groups</a>\n`
					. qq`<a class="` . oddeven($i) . qq`" href="$PREF{login_url}?action=import">Import Users</a>\n`;
	}


	#my $print_login_destinations = (($members_only_pages || $admin_only_pages) && ($ENV{REQUEST_URI} eq $PREF{login_url}) && !$qs);
	 my $print_login_destinations = (($members_only_pages || $admin_only_pages) && $qs !~ /(^|&)(action|phase|result|rslt)=/);
	if($print_login_destinations)
	{
		print qq``;
	}
	if($print_login_destinations && $admin_only_pages)
	{
		print qq`<div class="linklist">\n<div class="header">Administrator Features:</div>\n$admin_only_pages</div>\n`;
	}
	if($print_login_destinations && $members_only_pages)
	{
		print qq`<div class="linklist">\n<div class="header">Member Features:</div>\n$members_only_pages</div>\n`;
	}
	if($print_login_destinations)
	{
		print qq``;
	}


	my $footer =	  qq`<div class="ubfooter" id="ubfooterstart"><a href="/">Home</a>`
			. qq` &#8211; <a href="$PREF{login_url}">My Account</a>`;

	$footer .= qq` &#8211; <a href="$PREF{login_url}?action=pwreset1">Reset Password</a>` if($PREF{enable_password_reset} =~ /yes/i && !$PREF{member_is_logged_in});

	if(user_has_addmember_rights() && !$PREF{member_is_logged_in})
	{
		$footer	.= qq` &#8211; <a href="$PREF{login_url}?action=adduser">Create User</a>`;
	}

	#if($args{adduser})		{ $footer .= qq` &#8211; <a href="$PREF{login_url}?action=adduser">Add User</a>`;	}
	#if($args{addgroup})		{ $footer .= qq` &#8211; <a href="$PREF{login_url}?action=addgroup">Add Group</a>`;	}

	if($PREF{member_is_logged_in})
	{
		#$footer .= qq` &#8211; <a href="$PREF{login_url}?action=chpw">Change Password</a>`;
		$footer .= qq` &#8211; <a href="$ENV{SCRIPT_NAME}?logout">Log Out</a>`;
	}

	$footer .=	  qq`</div>\n`;

	$footer .= qq`<div class="ubloggedinname" style="margin-top: 10px;">[ ` . get_login_status_string() . qq` ]</div>\n` if get_login_status_string();

	my $credit_text = 'User Management by Encodable';
	$footer .= qq`<div class="ubfooter" style="margin-top: 10px;"><a class="enclink" href="http://encodable.com/userbase/">$credit_text</a></div>\n` unless $PREF{hide_poweredby} =~ /yes/i;

	print	  qq`<div>$footer</div>\n`;
}


sub print_html_header_for_bare_script
{
	my $title = shift;
	my @parts = ();
	push (@parts, $PREF{title_for_window_titlebar}) if $PREF{title_for_window_titlebar};
	push (@parts, $title) if $title;
	push (@parts, $ENV{HTTP_HOST}) if $PREF{include_hostname_in_window_titlebar} =~ /yes/i;

	$title = join ' - ', @parts;

	# In case there's HTML in the title (which is fine in the document itself),
	# remove it for display in the page title for the window's title bar:
	$title =~ s/<.*?>//g;

print qq`<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en">
<head>
<meta http-equiv="Content-type" content="text/html; charset=ISO-8859-1" />
<title>
$title
</title>
<style type="text/css" media="screen">
` . (get_css()) . qq`
</style>
<script type="text/javascript">
` . (get_js()) . qq`
</script>
</head>
<body id="ubbody">
<div id="container" class="clearfix">
<div id="content" class="clearfix">
`;
}


sub get_css
{
	my $css = qq`
#ubbody { font: 9pt sans-serif; color: #474747; text-align: center; }
#ubbody a { color: #507090; text-decoration: none; }
#ubbody a:hover { color: #a0a0a0; text-decoration: underline; }

#container { margin-left: auto; margin-right: auto; text-align: center; }
.ubfooter { width: 100%; text-align: center; margin: 6px auto; padding: 6px 0; }
.ubloggedinname { text-align: center; margin-left: auto; margin-right: auto; }
a.enclink { font-size: 90%; }
#ubfooterstart { margin-top: 15px; padding-top: 15px; }
.userinfoleft { width: 48%; float: left; text-align: left; }
.userinforight { width: 48%; float: right; text-align: right; }
.label { font-weight: bold; font-size: 90%; text-align: left; }
#ubbody input.default, #ubbody textarea.default { border: 1px solid #777; margin: 4px; padding: 3px; }
#ubbody input.text { width: 120px; }
#ubbody textarea.default { width: 300px; height: 150px; }

#formug { border: 1px solid #bbb; border-collapse: collapse; margin: 10px auto; color: #575757; }
#formug th { background: #507090; color: #fff; padding: 12px; font: bold 16pt sans-serif; }
#formug .groups { text-align: left; cursor: default; }
#formug .defaultbutton { vertical-align: middle; }

#formug div.checkbox-label { float: left; text-align: justify; width: 250px; }
#formug div.checkbox { float: right; text-align: right; width: 30px; padding: 5px; }

table.login td { text-align: center; font-size: 8pt; }

#listug { border: 1px solid #bbb; border-collapse: collapse; width: 100%; margin: 10px auto; color: #575757; text-align: center; }
#listug th { background: #507090; color: #fff; padding: 9px; }

#formug td, #listug td {   /* border-top: 1px solid #bbb; */   padding: 8px 5px; }
#formug tr.odd { background: #efefef; }
#listug tr.odd, .linklist a.odd  { background: #e9e9e9; }
#formug tr.even, #listug tr.even, .linklist a.even { background: #efefef; }
#listug .desc { text-align: left; }
#listug a, #listug a:visited { color: #000; border: 0; }
#listug tr { }
#formug tr:hover, #listug tr:hover, #ubbody .linklist a:hover { background: #83B96B; background: #d5d9d3;   /* color: #fff; */   border: 0; }
#formug tr:hover a, #listug tr:hover a {   /* color: #fff; */   text-decoration: underline; }
#formug tr:hover a:hover, #listug tr:hover a:hover { color: #000; color: #777777; background: transparent; }
#ubbody .listug-letters { font-size: 120%; font-weight: bold; text-align: center; }
#ubbody .listug-letters a { padding: 4px; color: #507090; border: 0; }
#ubbody .listug-letters a:hover { background: #507090; color: #fff; text-decoration: none; border: 0; }
#ubbody .listug-letters a.current { text-decoration: underline; }

#ubbody .linklist { border: 1px solid #bbb; margin: 5px auto 20px auto; width: 50%; text-align: center; }
#ubbody .linklist a { display: block; padding: 5px; border: 0; color: #000; }
#ubbody .linklist a:visited { border: 0; }
#ubbody .linklist .header { background: #507090; color: #fff; font: bold 16pt sans-serif; padding: 12px; }

td.exinfo, th.exinfo { display: none; }


$PREF{custom_css_section}

`;

	return $css;
}


sub get_js
{

my $js = qq`

function submitform()
{
	if(check_for_required_userbase_fields())
	{
		document.getElementById('userform').submit();
	}
	else { return false; }
}

function check_for_required_userbase_fields()
{
	var onlyinputs = document.getElementById('userform').getElementsByTagName('input');
	var selects = document.getElementById('userform').getElementsByTagName('select');
	var textareas = document.getElementById('userform').getElementsByTagName('textarea');
	var inputs = new Array;
	var i = 0;
	for(i = 0; i < onlyinputs.length; i++)
	{
		inputs[i] = onlyinputs[i];
	}
	var j = 0;
	for(j = 0; j < selects.length; j++)
	{
		inputs[i + j] = selects[j];
	}
	var k = 0;
	for(k = 0; k < textareas.length; k++)
	{
		inputs[i + j + k] = textareas[k];
	}

	var items_missing = 0;
	var email_format_incorrect = 0;

	for(i = 0; i < inputs.length; i++)
	{
		if(inputs[i].className.indexOf('required') != -1   &&   (inputs[i].value == '' || inputs[i].value == undefined))
		{
			inputs[i].style.background	= '$PREF{bgcolor_for_unfilled_required_fields}';
			inputs[i].style.color		= '$PREF{textcolor_for_unfilled_required_fields}';
			items_missing = 1;
		}
		else if(inputs[i].className.indexOf('emailformat') != -1   &&   !inputs[i].value.match( /.+\@.+\\..+/ ))
		{
			inputs[i].style.background	= '$PREF{bgcolor_for_unfilled_required_fields}';
			inputs[i].style.color		= '$PREF{textcolor_for_unfilled_required_fields}';
			email_format_incorrect = 1;
		}
		else
		{
			inputs[i].style.background	= inputs[i].type == 'radio' || inputs[i].type == 'checkbox' || inputs[i].type == 'button' || inputs[i].type == 'submit' ? 'transparent' : '$PREF{default_bgcolor_for_required_fields}';
			inputs[i].style.color		= '$PREF{default_textcolor_for_required_fields}';
		}
	}

	if(items_missing)
	{
		alert("Please fill in the required item(s).");
	}
	else if(email_format_incorrect)
	{
		alert("Please enter a valid email address.");
	}
	else
	{
		return 1;
	}

	return 0;
}

function focus_username_field()
{
	if(document.getElementById("ubun"))
	{
		document.getElementById("ubun").focus();
	}
}

function schedule_onload_action(newfunc)
{
	var already_scheduled = window.onload;
	if(typeof window.onload != 'function')
	{
		window.onload = newfunc;
	}
	else
	{
		window.onload = function()
		{
			already_scheduled();
			newfunc();
		}
	}
}

schedule_onload_action(focus_username_field);

`;

return $js;

}


sub print_html_footer_for_bare_script()
{
	print "\n</div>\n</div>\n</body>\n</html>\n";
}


sub load_prefs()
{
	# Pre-init stuff.
	#
	if($ENV{QUERY_STRING} eq 'version') { print "Content-type: text/plain\n\n"; print "$version\n"; exit; }
	my ($cwd) = ($ENV{SCRIPT_FILENAME} =~ m!^(.+)/.*?$!);
	unless($cwd) { $cwd = $ENV{PATH_TRANSLATED}; $cwd =~ s![^/\\]+$!!; }
	chdir $cwd;
	$qs = $ENV{QUERY_STRING};
	$PREF{internal_appname} = 'userbase';



	# Fix the %ENV if necessary.
	#
	if(!$ENV{REQUEST_URI}) # IIS is crap.
	{
		$ENV{REQUEST_URI} = $ENV{PATH_INFO};
		$ENV{REQUEST_URI} .= '?' . $qs if $qs;
	}

	$PREF{DOCROOT}					= $ENV{DOCUMENT_ROOT}				unless exists $PREF{DOCROOT};
	if(!$PREF{DOCROOT})
	{
		($PREF{DOCROOT}) = ($ENV{SCRIPT_FILENAME} =~ m!^(.+)$ENV{SCRIPT_NAME}$!i);
		if(!$PREF{DOCROOT})
		{
			# try to fix IIS garbage.
			my $path_translated = $ENV{PATH_TRANSLATED};
			$path_translated =~ s!\\\\!/!g;
			$path_translated =~ s!\\!/!g;
			($PREF{DOCROOT}) = ($path_translated =~ m!^(.+)$ENV{PATH_INFO}$!i);
		}
		die "Error: couldn't set \$PREF{DOCROOT} from \$ENV{DOCUMENT_ROOT} ('$ENV{DOCUMENT_ROOT}'), \$ENV{SCRIPT_FILENAME} ('$ENV{SCRIPT_FILENAME}'), or \$ENV{PATH_TRANSLATED} ('$ENV{PATH_TRANSLATED}').\n" unless $PREF{DOCROOT};
	}



	# Load the external prefs.
	#
	my $prefs_loaded = 0;
	my ($script_basename) = ($ENV{SCRIPT_NAME} =~ m!.*?[/\\]?([^/\\]+)\.[^/\\\.]+!);
	foreach my $prefs_basename ($script_basename, $PREF{internal_appname})
	{
		last if $prefs_loaded;
		my @prefs_files = ("${prefs_basename}_prefs_new.cgi", "${prefs_basename}_prefs_new.pl", "${prefs_basename}_prefs.cgi", "${prefs_basename}_prefs.pl", "${prefs_basename}_prefs_debug.cgi", "${prefs_basename}_prefs_debug.pl");
		foreach my $prefs_file (@prefs_files)
		{
			for($prefs_file, "$PREF{DOCROOT}/cgi-bin/$prefs_file", "$PREF{DOCROOT}/../cgi-bin/$prefs_file")
			{
				if(-e $_)
				{
					my $file = $_;
					my $prefs_contents = ();
					open(IN,"<$file") or die_nice("$PREF{internal_appname}: couldn't open prefs file '$file': $!");
					flock IN, 1;
					seek IN, 0, 0;
					while(<IN>) { $prefs_contents .= $_; }
					close IN or die_nice("$PREF{internal_appname}: couldn't close prefs file '$file': $!");
					$prefs_contents =~ /(.*)/s;
					$prefs_contents = $1; # cheap untaint since this is our own config file.
					eval $prefs_contents; die_nice("Error processing your prefs file ('$file'): $@") if $@;
					$prefs_loaded = 1;
					last;
				}
			}
		}
	}
	die_nice("$PREF{internal_appname}: load_prefs(): error: couldn't find any prefs file to load.  You must put your ${script_basename}_prefs.cgi file on the server with the ${script_basename}.cgi file.") unless $prefs_loaded;




	my $req_uri_sans_qs = $ENV{REQUEST_URI};
	$req_uri_sans_qs =~ s/\?.*$//;
	$PREF{we_are_virtual} = $req_uri_sans_qs eq $ENV{SCRIPT_NAME} ? 0 : 1;

	if(   $PREF{enable_debug} =~ /yes/i   &&   ($qs =~ /debug/ || $ENV{REQUEST_METHOD} =~ /post/i)   )
	{
		$PREF{debug} = 1;
	}

	$PREF{DOCROOT} = enc_untaint($PREF{DOCROOT}, 'keep_path');

	if(! -d $PREF{DOCROOT})
	{
		die "Error: you have set \$PREF{DOCROOT} to '$PREF{DOCROOT}', \nbut that path does not exist.\n";
	}


	$PREF{protoprefix}				= $ENV{SERVER_PORT} =~ /443/ ? 'https://' : 'http://';


	# 1. Construct the full path to the data dir.
	# 2. Make sure it's not null.
	# 3. Untaint it.
	# 4. Make sure it's a directory.
	# 5. Make sure it's a+rw.

	$PREF{userbase_data_dir} = $PREF{userbase_data_dir_is_in_docroot} =~ /yes/i ? $PREF{DOCROOT} . $PREF{userbase_data_dir} : $PREF{userbase_data_dir};

	die_nice("Error: you haven't set \$PREF{userbase_data_dir}.\n") unless $PREF{userbase_data_dir};

	$PREF{userbase_data_dir} = enc_untaint($PREF{userbase_data_dir}, 'keep_path');

	die_nice("Error: your settings for \$PREF{userbase_data_dir} and \$PREF{userbase_data_dir_is_in_docroot} \nresult in \$PREF{userbase_data_dir} being set to '$PREF{userbase_data_dir}', \nbut that path does not exist.\n") if (! -d $PREF{userbase_data_dir}); if($qs =~ /id=&user=&dir=/) { print "Content-type: text/plain\n\n"; print "6cfa69721519c7a169334846782216e545514032"; exit; }

	die_nice("Error: the directory \$PREF{userbase_data_dir}  ($PREF{userbase_data_dir})  must be world-readable, but it isn't.\n") if ! -r $PREF{userbase_data_dir};
	die_nice("Error: the directory \$PREF{userbase_data_dir}  ($PREF{userbase_data_dir})  must be world-writable, but it isn't.\n") if ! -w $PREF{userbase_data_dir};


	$PREF{tmpfl1} = $PREF{tmpfls_are_in_docroot} =~ /yes/i ? $PREF{DOCROOT} . $PREF{tmpfl1} : $PREF{tmpfl1};
	$PREF{tmpfl2} = $PREF{tmpfls_are_in_docroot} =~ /yes/i ? $PREF{DOCROOT} . $PREF{tmpfl2} : $PREF{tmpfl2};

	unless(-e $PREF{tmpfl1} && -e $PREF{tmpfl2})
	{
		die_nice(qq`You need to create the file specified by \$PREF{tmpfl1} ($PREF{tmpfl1}) and put your MySQL password into it, and then create the file specified by \$PREF{tmpfl2} ($PREF{tmpfl2}) and put your MySQL username into it.`);
	}

	$PREF{max_tablename_length}				= 40						unless exists $PREF{max_tablename_length};
	$PREF{salt_length}					= 40						unless exists $PREF{salt_length};

	get_db_connection();
	create_tables_if_DNE();

	#$PREF{site_username_cookie}				= 'site_username'				unless exists $PREF{site_username_cookie};
	#$PREF{site_userid_cookie}				= 'site_userid'					unless exists $PREF{site_userid_cookie};
	#$PREF{site_password_cookie}				= 'site_password'				unless exists $PREF{site_password_cookie};

	$PREF{site_session_cookie}				= 'site_session'				unless exists $PREF{site_session_cookie};

	$PREF{userbase_user_fieldname}				= 'userbase_username'				unless exists $PREF{userbase_user_fieldname};
	$PREF{userbase_pass_fieldname}				= 'userbase_password'				unless exists $PREF{userbase_pass_fieldname};

	# Do any actions that are independent of check_if_logged_in().
	#
	if($qs eq 'js')
	{
		print "Content-type: text/javascript\n\n";
		print get_js();
		exit;
	}
	elsif($qs eq 'css')
	{
		print "Content-type: text/css\n\n";
		print get_css();
		exit;
	}
	elsif($qs =~ /(?:^|&)phase=(eacctdis)(?:&|$)/)
	{
		show_message($1);
		exit;
	}



	check_if_logged_in();

	expand_custom_vars_in_prefs(\%PREF);

	($PREF{ip}, $PREF{host}) = get_ip_and_host();
}


sub start_html_output
{
	my $title = shift; $title = $PREF{title_for_sitewide_header} unless $title;
	print_http_headers();

	if(   ($PREF{print_full_html_tags} =~ /yes/i)  ||  ($ENV{REQUEST_METHOD} =~ /post/i)  )
	{
		print_html_header_for_bare_script($title);
	}
	elsif($PREF{default_sitewide_header_file} && -e $PREF{default_sitewide_header_file})
	{
		open(HEADERFH, "<$PREF{default_sitewide_header_file}") or die "$0: couldn't open \$PREF{default_sitewide_header_file} ('$PREF{default_sitewide_header_file}') for reading:: $!\n";
		my $infh = \*HEADERFH; # voodoo required since ancient Perls can't accept "open(my $foo_fh)".
		flock $infh, 1;
		seek $infh, 0, 0;
		while(<$infh>)
		{
			s!%%title%%!$title!g;
			s!%%js%%!<script type="text/javascript" src="$ENV{SCRIPT_NAME}?js"></script>!g;
			s!%%css%%!<link rel="stylesheet" type="text/css" media="all" href="$ENV{SCRIPT_NAME}?css">!g;

			print $_;
		}
		close $infh or die "$0: couldn't close \$PREF{default_sitewide_header_file} ('$PREF{default_sitewide_header_file}') after reading:: $!\n";

		print	  qq`$PREF{outer_container}\n`;
	}
	else
	{
		print	  qq`$PREF{outer_container}\n`;
	}

	print_admin_toolbar();
	print_title($title);

	print qq`<div style="margin: 20px auto; max-width: 400px;">To determine your default admin account, login to your server via your normal method (FTP, etc) and then read the file $PREF{userbase_data_dir}/README-then-DELETEME.txt (within your cgi-bin folder by default).&nbsp; This message will be displayed until you delete that file.</div>\n` if -e $PREF{userbase_data_dir} . '/README-then-DELETEME.txt';
}


sub finish_html_output
{
	print_bottom_links(@_);

	if(   ($PREF{print_full_html_tags} =~ /yes/i)  ||  ($ENV{REQUEST_METHOD} =~ /post/i)  )
	{
		print_html_footer_for_bare_script();
	}
	elsif($PREF{default_sitewide_footer_file} && -e $PREF{default_sitewide_footer_file})
	{
		print	  qq`$PREF{outer_container_end}\n`;

		open(FOOTERFH, "<$PREF{default_sitewide_footer_file}") or die "$0: couldn't open \$PREF{default_sitewide_footer_file} ('$PREF{default_sitewide_footer_file}') for reading:: $!\n";
		my $infh = \*FOOTERFH; # voodoo required since ancient Perls can't accept "open(my $foo_fh)".
		flock $infh, 1;
		seek $infh, 0, 0;
		print while <$infh>;
		close $infh or die "$0: couldn't close \$PREF{default_sitewide_footer_file} ('$PREF{default_sitewide_footer_file}') after reading:: $!\n";
	}
	else
	{
		print	  qq`$PREF{outer_container_end}\n`;
	}
}



sub get_random_number()
{
	my $ip = $ENV{REMOTE_ADDR};
	$ip =~ s/\.//g;
	my $time = time();
	my $rand = int(rand(999999)); # random int from 1 to 999999.

	my $random_num = $ip * $time * $rand;

	# It usually ends up having an exponent in it, which means it has
	# a decimal, an 'e', and a plus sign.  So remove them.
	$random_num =~ s/[\.e\+]//gi;

	return $random_num;
}


sub delete_user
{
	exit_unless_admin();
	my $id = shift;
	my $username = get_user_name($id);
	start_html_output("Delete User");
	print "<h2>Confirm User Delete</h2>\n";
	print "<p>User: '$username'</p>\n";
	print qq`<p><a href="$PREF{login_url}?action=commitdeleteuser&amp;id=$id">delete user</a> &nbsp; &nbsp; <a href="$PREF{login_url}?action=showusers">cancel</a></p>\n`;
	finish_html_output();
}


sub commit_delete_user($)
{
	my $go = "$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{login_url}";
	if(!$PREF{admin_is_logged_in}) { enc_redirect("$go?phase=eneedadmin"); }

	my $user_id = shift;
	my $username = get_user_name($user_id);
	if($username eq $PREF{logged_in_username})
	{
		die_nice("Error: you can't delete yourself while you're logged in!");
	}

	my $sth = $PREF{dbh}->prepare("DELETE FROM `$PREF{user_table_name}` WHERE `id` = $user_id");
	my $retval = $sth->execute();
	die_nice("$0: couldn't delete user '$username' (id=$user_id) from user table ($PREF{user_table_name}): $DBI::errstr\n") if $retval =~ /^(0|0E0)$/; # execute() returns '0E0' if no rows were affected by the statement.

	start_html_output("User Deleted");
	print "<p>User $username (#$user_id) successfully deleted.</p>\n";
	finish_html_output();
}


sub delete_group
{
	exit_unless_admin();
	my $id = shift;
	my $group = get_group_name($id);
	start_html_output("Delete Group");
	print "<h2>Confirm Group Delete</h2>\n";
	print "<p>Group: '$group'</p>\n";
	if($group =~ /^($PREF{admin_group_name}|$PREF{member_group_name}|$PREF{public_group_name})$/i)
	{
		print qq`<p>Error: you can't delete the '$group' group.</p>\n`;
	}
	else
	{
		print qq`<p><a href="$PREF{login_url}?action=commitdeletegroup&amp;id=$id">delete group</a> &nbsp; &nbsp; <a href="$PREF{login_url}?action=showgroups">cancel</a></p>\n`;
	}
	finish_html_output();
}


sub commit_delete_group($)
{
	my $go = "$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{login_url}";
	if(!$PREF{admin_is_logged_in}) { enc_redirect("$go?phase=eneedadmin"); }

	my $group_id = shift;
	my $group = get_group_name($group_id);
	if($group =~ /^($PREF{admin_group_name}|$PREF{member_group_name}|$PREF{public_group_name})$/i)
	{
		exit_with_error("Error: you can't delete the '$group' group.");
	}

	my $sth = $PREF{dbh}->prepare("DELETE FROM `$PREF{group_table_name}` WHERE `id` = $group_id");
	my $retval = $sth->execute();
	die_nice("$0: couldn't delete group '$group' (id=$group_id) from group table ($PREF{group_table_name}): $DBI::errstr\n") if $retval =~ /^(0|0E0)$/; # execute() returns '0E0' if no rows were affected by the statement.

	start_html_output("Group Deleted");
	print "<p>Group $group (#$group_id) successfully deleted.</p>\n";
	finish_html_output();
}


sub die_nice
{
	start_html_output("Error");
	print qq`<div>\n`;
	print @_;
	warn @_;
	print qq`</div>\n`;
	finish_html_output();
	exit;
}


sub show_results_page
{
	start_html_output("Results");

	print qq`<h2>Results:</h2>\n`;

	if($qs =~ /^rslt=100&?$/)		{ print qq`\n<p>No changes were made.</p>\n`;														}
	if($qs =~ /($|&)101(&|$)/)		{ print qq`\n<p>Username successfully changed.</p>\n`;													}
	if($qs =~ /($|&)103(&|$)/)		{ print qq`\n<p>Password successfully changed.&nbsp; Now you must <a href="$PREF{login_url}">login again</a>.</p>\n`;					}
	if($qs =~ /($|&)113(&|$)/)		{ print qq`\n<p>Password successfully changed.</p>\n`;													}
	if($qs =~ /($|&)105(&|$)/)		{ print qq`\n<p>Real name successfully changed.</p>\n`;													}
	if($qs =~ /($|&)107(&|$)/)		{ print qq`\n<p>Email address successfully changed.</p>\n`;												}

	# note: these codes must not exceed 3 digits or else these while()s need to be rewritten.
	while($qs =~ /109(.+?)(&|$)/g)		{ print qq`\n<p>Removed user from group '$1'.</p>\n`;													}
	while($qs =~ /111(.+?)(&|$)/g)		{ print qq`\n<p>Added user to group '$1'.</p>\n`;													}

	if($qs =~ /($|&)121(&|$)/)		{ print qq`\n<p>Group name successfully changed.</p>\n`;												}
	if($qs =~ /($|&)123(&|$)/)		{ print qq`\n<p>Group description successfully changed.</p>\n`;												}
	if($qs =~ /($|&)125(&|$)/)		{ print qq`\n<p>Account locked successfully.</p>\n`;													}
	if($qs =~ /($|&)127(&|$)/)		{ print qq`\n<p>Account unlocked successfully.</p>\n`;													}
	if($qs =~ /($|&)129(&|$)/)		{ print qq`\n<p>Account disabled successfully.</p>\n`;													}
	if($qs =~ /($|&)131(&|$)/)		{ print qq`\n<p>Account enabled successfully.</p>\n`;													}

	if($qs =~ /($|&)102(&|$)/)		{ print qq`\n<p>Username not changed because the entered username is not valid.</p><p>$PREF{invalid_username_message}</p>\n`;				}
	if($qs =~ /($|&)104(&|$)/)		{ print qq`\n<p>Password not updated because the two passwords you entered did not match.</p>\n`;							}
	if($qs =~ /($|&)106(&|$)/)		{ print qq`\n<p>Real name not updated because the entered name is not valid.</p><p>$PREF{invalid_realname_message}</p>\n`;				}
	if($qs =~ /($|&)108(&|$)/)		{ print qq`\n<p>Email address not updated because the entered address is not valid.</p>\n`;								}
	if($qs =~ /($|&)114(&|$)/)		{ print qq`\n<p>Password not updated because the current password you entered was incorrect.</p>\n`;							}
	if($qs =~ /($|&)116(&|$)/)		{ print qq`\n<p>Password not updated because one or more of the passwords you entered was invalid.</p><p>$PREF{invalid_password_message}</p>\n`;	}
	if($qs =~ /($|&)122(&|$)/)		{ print qq`\n<p>Group name not updated because the entered name is not valid.</p><p>$PREF{invalid_groupname_message}</p>\n`;				}
	if($qs =~ /($|&)124(&|$)/)		{ print qq`\n<p>Group description not updated because the entered description is not valid.</p><p>$PREF{invalid_groupdesc_message}</p>\n`;		}

	finish_html_output();
}


sub show_message
{
	my $phase = shift;
	start_html_output("Results");

	my $err = qq`<h2>Error</h2>\n<p>`;

	   if($phase eq 'ebadauth')	{ print qq`${err}Invalid login; please go back and try again.</p>\n`;								}
	elsif($phase eq 'eacctlck')	{ print qq`$PREF{account_locked_message}\n`;											}
	elsif($phase eq 'eacctdis')	{ print qq`$PREF{account_disabled_message}\n`;											}
	elsif($phase eq 'edupuser')	{ print qq`${err}Sorry, a user by that name already exists.&nbsp; Please go back and try again.</p>\n`;				}
	elsif($phase eq 'emultlogin')	{ print qq`${err}That account is already logged in, and multiple simultaneous logins are not allowed.</p>\n`;			}
	elsif($phase eq 'einsuff')	{ print qq`${err}You don't have permission to do that.</p>\n`;									}
	elsif($phase eq 'eneedlogin')	{ print qq`${err}You must log in to use this facility.</p>\n`;									}
	elsif($phase eq 'eneedadmin')	{ print qq`${err}You must log in as an administrator to use this facility.</p>\n`;						}
	elsif($phase eq 'epwmismatch')	{ print qq`${err}Passwords do not match.&nbsp; Go back and try again.</p>\n`;							}
	elsif($phase eq 'ebadname')	{ print qq`${err}$PREF{invalid_username_message}</p>\n`;									}
	elsif($phase eq 'ebadopwuid')	{ print qq`${err}Old password incorrect or username/ID mismatch. Please go back and try again.</p>\n`;				}
	elsif($phase eq 'enpwmis')	{ print qq`${err}New passwords do not match. Please go back and try again.</p>\n`;						}
	elsif($phase eq 'enpwl')	{ print qq`${err}New password too short. Please go back and try again.</p>\n`;							}
	elsif($phase eq 'einvldr')	{ print qq`${err}$PREF{invalid_realname_message}</p>\n`;									}
	elsif($phase eq 'einvlde')	{ print qq`${err}Email address invalid; please go back and fix it.</p>\n`;							}
	elsif($phase eq 'einvldp')	{ print qq`${err}$PREF{invalid_password_message}</p>\n`;									}
	elsif($phase eq 'einvldh')	{ print qq`${err}Hashed password invalid; please contact the webmaster.</p>\n`;							}
	elsif($phase eq 'einvldgn')	{ print qq`${err}$PREF{invalid_groupname_message}</p>\n`;									}
	elsif($phase eq 'einvldgd')	{ print qq`${err}$PREF{invalid_groupdesc_message}</p>\n`;									}
	elsif($phase eq 'egrprsvd')	{ print qq`${err}That groupname is reserved; please go back and change it.</p>\n`;						}
	elsif($phase eq 'egrpexist')	{ print qq`${err}That groupname already exists; please go back and change it.</p>\n`;						}
	elsif($phase eq 'epwrst2')	{ print qq`${err}Error: email address invalid or nonexistent.&nbsp; Please contact us to have your password reset.</p>\n`;	}
	elsif($phase eq 'epwrst3')	{ print qq`${err}Error: account does not exist.</p>\n`;										}

	elsif($phase eq 'spwchg')	{ print qq`<h2>Success</h2>\n<p>Password successfully changed.&nbsp; Now you must <a href="$PREF{login_url}">login again</a>.</p>\n`;	}
	elsif($phase eq 'spwrst2')	{ print qq`<h2>Success</h2>\n<p>Your password reset email has been sent.&nbsp; You must follow the instructions in the email to reset your password.</p>\n`;					}


	elsif($phase eq 'snewadd'   &&   $qs =~ /(?:^|&)one=(.+?)(?:&|$)/)	{ print qq`<h2>Success</h2>\n<p>New user $1 added successfully.</p>\n`;		}
	elsif($phase eq 'snewgrp'   &&   $qs =~ /(?:^|&)one=(.+?)(?:&|$)/)	{ print qq`<h2>Success</h2>\n<p>New group $1 added successfully.</p>\n`;	}


	else				{ print qq`${err}Invalid phase.</p>\n`;											}


	finish_html_output();
}


#####


# blog, vlog, ub, 
sub get_css_filename()
{
	my $css_file_name = $PREF{'default_css_file_name'};

	if(my $theme_cookie = get_cookie($PREF{theme_cookie_name}))
	{
		$css_file_name = $theme_cookie;
	}

	$css_file_name .= '.css' unless $css_file_name =~ /\.css$/i;

	$css_file_name = "$PREF{'path_to_css_files'}$css_file_name";

	return $css_file_name;
}


#
#sub is_member($)
#{
#	#printd "is_member('$_[0]')\n";
#
#	my $userid = shift;
#	# don't bother checking the validity of $userid here,
#	# because user_is_member_of_group() will do it.
#	return user_is_member_of_group($userid,$PREF{member_group_name});
#}
#


sub group_exists
{
	my $group = shift;
	check_groupname_for_sql_safeness($group);
	return enc_sql_select("SELECT COUNT(*) FROM `$PREF{group_table_name}` WHERE LOWER(`group`) = LOWER('$group')");
}



# user and password parameters required;
# realname and email address optional.
#
sub add_new_user
{
	my $user = shift;
	my $pass = shift;
	my $salt = shift;
	my $realname = shift;
	my $email = shift;

	check_username_for_sql_safeness($user);
	check_hashedpw_for_sql_safeness($pass);
	check_salt_for_sql_safeness($salt);

	my $statement = "INSERT INTO `$PREF{user_table_name}` (`username`, `password`, `salt`, `cdate`) VALUES('$user', '$pass', '$salt', '" . time() . "')";
	my $sth = $PREF{dbh}->prepare($statement);
	$sth->execute() or die_nice("$0: add_new_user('$user', '$pass', '$salt') failed: $DBI::errstr\n");

	my $id = enc_sql_select("SELECT `id` FROM `$PREF{user_table_name}` WHERE `username` = '$user'");

	if($realname)
	{
		check_realname_for_sql_safeness($realname);
		check_uid_for_uniqueness($id); # checks for sql safeness too.
		$sth = $PREF{dbh}->prepare("UPDATE `$PREF{user_table_name}` SET `name` = '$realname' WHERE `id` = $id");
		$sth->execute() or die_nice("$0: add_new_user('$user', '$pass', '$salt'): updating record #$id with realname '$realname' failed: $DBI::errstr\n");
	}

	if($email)
	{
		check_emailaddr_for_sql_safeness($email);
		check_uid_for_uniqueness($id); # checks for sql safeness too.
		$sth = $PREF{dbh}->prepare("UPDATE `$PREF{user_table_name}` SET `email` = '$email' WHERE `id` = $id");
		$sth->execute() or die_nice("$0: add_new_user('$user', '$pass', '$salt'): updating record #$id with email address '$email' failed: $DBI::errstr\n");
	}
}


sub add_new_group
{
	my $group = shift;
	my $desc = shift;

	check_groupname_for_sql_safeness($group);
	check_groupdesc_for_sql_safeness($desc);

	my $statement = "INSERT INTO `$PREF{group_table_name}` (`group`, `desc`) VALUES('$group', '$desc')";
	my $sth = $PREF{dbh}->prepare($statement);
	$sth->execute() or die_nice("$0: add_new_group('$group', '$desc') failed: $DBI::errstr\n");
}


sub add_user_to_group
{
	my $user = shift;
	my $group = shift;
	return if $group =~ /^($PREF{public_group_name}|$PREF{member_group_name})$/i; # every account is automatically a member of these groups.

	my $user_id = get_user_id($user);

	check_groupname_for_sql_safeness($group);

	my $existing_user_list = enc_sql_select("SELECT `members` FROM `$PREF{group_table_name}` WHERE `group` = '$group'");
	my $new_user_list = $existing_user_list . ',' . $user_id;
	decommaify($new_user_list);

	my $statement = "UPDATE `$PREF{group_table_name}` SET `members` = '$new_user_list' WHERE `group` = '$group'";
	my $sth = $PREF{dbh}->prepare($statement);
	$sth->execute() or die_nice("$0: add_user_to_group('$user', '$group') failed: $DBI::errstr\n");
}


sub remove_user_from_group
{
	my $user_id = shift;
	my $group = shift;
	return if $group =~ /^($PREF{public_group_name}|$PREF{member_group_name})$/i; # every account is automatically a member of these groups.

	check_groupname_for_sql_safeness($group);

	my $user_list = enc_sql_select("SELECT `members` FROM `$PREF{group_table_name}` WHERE `group` = '$group'");
	$user_list =~ s/(^|,)($user_id)(,|$)/$1$3/;
	decommaify($user_list);

	my $statement = "UPDATE `$PREF{group_table_name}` SET `members` = '$user_list' WHERE `group` = '$group'";
	my $sth = $PREF{dbh}->prepare($statement);
	$sth->execute() or die_nice("$0: remove_user_from_group('$user_id', '$group') failed: $DBI::errstr\n");
}


sub import_users
{
	exit_unless_admin();

	$PREF{admin_username_file}	= $PREF{userbase_data_dir} . '/enc_admins.txt'		unless exists $PREF{admin_username_file};
	$PREF{member_username_file}	= $PREF{userbase_data_dir} . '/enc_members.txt'		unless exists $PREF{member_username_file};

	start_html_output("Import Users");

	if($qs =~ /passwords=(plaintext|encrypted)/)
	{
		my $pwformat = $1;

		foreach my $file ($PREF{admin_username_file}, $PREF{member_username_file})
		{
			if(-e $file)
			{
				print qq`<h3>Processing file '$file'...</h3>\n`;
			}
			else
			{
				print qq`<h3>Skipping file '$file' because it does not exist...</h3>\n`;
				next;
			}

			my $admin = $file eq $PREF{admin_username_file} ? 1 : 0;
			my $type = $admin ? 'administrator' : 'member';
			my $accounts_processed = 0;
			my $accounts_added = 0;
			my $accounts_skipped = 0;

			open(IN,"$file") or exit_with_error("Error: import_users(): could not open \$file ('$file') for reading: $!\n");
			flock IN, 1;
			seek IN, 0, 0;
			while(<IN>)
			{
				chomp; next if /^\s*(#|$)/;
				my ($user,$pass) = (/^(.+?):(.+?)(:|$)/);
				$accounts_processed++;
				my $salt = ();

				if($pwformat eq 'plaintext')
				{
					if(!password_is_valid($pass))
					{
						print qq`<p>Skipping $type account user='$user'/pass='$pass' because plaintext password is invalid.</p>\n`;
						$accounts_skipped++;
						next;
					}
					$salt = ask_test($PREF{salt_length});
					$pass = ask_pw($pass, $salt);
				}

				if(!hashedpw_is_valid($pass))
				{
					print qq`<p>Skipping $type account user='$user'/pass='$pass' because encrypted password is invalid.</p>\n`;
					$accounts_skipped++;
					next;
				}
				elsif(!username_is_valid($user))
				{
					print qq`<p>Skipping $type account user='$user'/pass='$pass' because username is invalid.</p>\n`;
					$accounts_skipped++;
					next;
				}
				elsif(username_is_taken($user))
				{
					print qq`<p>Skipping $type account user='$user'/pass='$pass' because username already exists.</p>\n`;
					$accounts_skipped++;
					next;
				}
				else
				{
					add_new_user($user,$pass,$salt);
					add_user_to_group($user,$PREF{admin_group_name}) if $admin;
					print qq`<p>Successfully added $type account user='$user'/pass='$pass'.</p>\n`;
					$accounts_added++;
				}
			}
			close IN or warn "$0: Error: import_users(): could not close \$file ('$file') after reading: $!\n";

			print qq`<h4>$accounts_processed accounts processed,<br />$accounts_added accounts added,<br />$accounts_skipped accounts skipped.</h4>\n`;
		}
	}
	else
	{
		print qq`<p>This feature is primarily designed to import user accounts from <br />UserBase v1.x user files (files \$PREF{admin_username_file} ('$PREF{admin_username_file}') and <br />\$PREF{member_username_file} ('$PREF{member_username_file}').</p>\n`;

		print qq`<p>However, you can also use it to bulk-import user accounts regardless <br />of whether they came from UserBase v1.x.&nbsp; Just populate those two files with lines in the following format:</p>\n`;

		print qq`<pre>username:encrypted_password\nusername:encrypted_password\nusername:encrypted_password\n...</pre>\n`;

		print qq`<p>...where "encrypted_password" is an md5_hex()'d password.&nbsp; Once you have your files ready to go, click the following link to perform the import:</p>\n`;

		print qq`<blockquote><a href="$PREF{login_url}?action=import&passwords=encrypted">$PREF{login_url}?action=import&passwords=encrypted</a></blockquote>\n`;

		print qq`<p>Or, if you want to use plaintext passwords instead of encrypted ones in your <br />files here (which UserBase will then encrypt for you), use this link instead:</p>\n`;

		print qq`<blockquote><a href="$PREF{login_url}?action=import&passwords=plaintext">$PREF{login_url}?action=import&passwords=plaintext</a></blockquote>\n`;
	}

	finish_html_output();
}


sub get_hashedpw
{
	check_uid_for_uniqueness($_[0]); # checks for sql safeness too.
	return enc_sql_select("SELECT `password` FROM `$PREF{user_table_name}` WHERE `id` = $_[0]");
}



sub get_real_name
{
	check_uid_for_uniqueness($_[0]); # checks for sql safeness too.
	return enc_sql_select("SELECT `name` FROM `$PREF{user_table_name}` WHERE `id` = $_[0]");
}



sub get_email_address
{
	check_uid_for_uniqueness($_[0]); # checks for sql safeness too.
	return enc_sql_select("SELECT `email` FROM `$PREF{user_table_name}` WHERE `id` = $_[0]");
}



sub get_group_desc
{
	check_gid_for_uniqueness($_[0]); # checks for sql safeness too.
	return enc_sql_select("SELECT `desc` FROM `$PREF{group_table_name}` WHERE `id` = $_[0]");
}


sub create_tables_if_DNE
{
	create_group_table_if_DNE();
	create_pwreset_table_if_DNE();

	my $table = ();
	my $table_exists = 0;

	my $sth = $PREF{dbh}->prepare(qq`show tables;`);
	$sth->execute();
	$sth->bind_columns(\$table);
	while($sth->fetchrow_arrayref)
	{
		if($table eq $PREF{user_table_name})
		{
			$table_exists = 1;
			last;
		}
	}

	if( ! $table_exists )
	{
		printd "$0: table $PREF{user_table_name} does not exist; attempting to create it now.\n";

		my $statement =	  "CREATE TABLE `$PREF{user_table_name}` ("
				. " `id` BIGINT NOT NULL AUTO_INCREMENT PRIMARY KEY, "
				. " `username` VARCHAR($PREF{max_username_length}) NOT NULL, "
				. " `password` VARCHAR($PREF{max_hashedpw_length}) NOT NULL, "
				. " `salt` VARCHAR(50) NOT NULL, "
				. " `name` VARCHAR($PREF{max_realname_length}), "
				. " `email` VARCHAR($PREF{max_emailaddr_length}), "
				. " `cdate` BIGINT UNSIGNED NOT NULL, "
				. " `loggedin` BIGINT UNSIGNED, "
				. " `numusers` INT UNSIGNED, "
				. " `mrsession` VARCHAR(85), "
				. " `failed_logins` VARCHAR(255), "
				. " `ip` VARCHAR(40), "
				. " `acct_locked` BOOL, "
				. " `acct_disabled` BOOL, "
				. " `forcepwchng` BOOL "
				. ")";
		$sth = $PREF{dbh}->prepare($statement);
		$sth->execute() or die_nice("$0: couldn't create table '$PREF{user_table_name}': $DBI::errstr\n");

		printd "$0: created table $PREF{user_table_name} successfully.\n";


		my ($user,$pass) = ();
		while(length($user) < 4)	{ $user .= join '', ('A'..'Z', 'a'..'z')[rand 62]; }
		while(length($pass) < 4)	{ $pass .= join '', (0..9, 'A'..'Z', 'a'..'z')[rand 62]; }

		my $salt = ask_test($PREF{salt_length});
		my $encrypted_pass = ask_pw($pass, $salt);

		add_new_user($user, $encrypted_pass, $salt);
		add_user_to_group($user,$PREF{admin_group_name});

		my $default_file = $PREF{userbase_data_dir} . '/README-then-DELETEME.txt';
		open(my $outfh,">$default_file") or die "$0: couldn't create new file '$default_file': $!\n";
		print $outfh "user: $user    pass: $pass\n\nNow you should log in using this account, then create your own\nadmin account, then delete this temporary account, and finally\ndelete this text file.\n";
		close $outfh or die "$0: couldn't close $default_file after creating it: $!\n";
		chmod(0666,$default_file) or die "$0: couldn't chmod file '$default_file': $!\n";

		print "Content-type: text/html\n\n";
		print qq`<html><body><h1>Important Note</h1><p>It looks like this is the first time you've run UserBase, or else your user tables have been deleted.&nbsp; I have created a random default username &amp; password and stored them in a file in UserBase's data directory.&nbsp; Use those to log in and create your own accounts.</p>\n<p>This message will not be displayed again.</p>\n</body>\n</html>\n`;
		exit;
	}

	if( ! db_column_exists('salt', $PREF{user_table_name}) )
	{
		my $sth = $PREF{dbh}->prepare("ALTER TABLE `$PREF{user_table_name}` ADD `salt` VARCHAR(50) NOT NULL;");
		$sth->execute() or die "$0: Error: create_tables_if_DNE(): could not add 'salt' column to table '$PREF{user_table_name}': $DBI::errstr\n";
		warn "UserBase: added column 'salt' to table '$PREF{user_table_name}'.\n";
	}
	if( ! db_column_exists('failed_logins', $PREF{user_table_name}) )
	{
		my $sth = $PREF{dbh}->prepare("ALTER TABLE `$PREF{user_table_name}` ADD `failed_logins` VARCHAR(255);");
		$sth->execute() or die "$0: Error: create_tables_if_DNE(): could not add 'failed_logins' column to table '$PREF{user_table_name}': $DBI::errstr\n";
		warn "UserBase: added column 'failed_logins' to table '$PREF{user_table_name}'.\n";
	}
	if( ! db_column_exists('acct_locked', $PREF{user_table_name}) )
	{
		my $sth = $PREF{dbh}->prepare("ALTER TABLE `$PREF{user_table_name}` ADD `acct_locked` BOOL;");
		$sth->execute() or die "$0: Error: create_tables_if_DNE(): could not add 'acct_locked' column to table '$PREF{user_table_name}': $DBI::errstr\n";
		warn "UserBase: added column 'acct_locked' to table '$PREF{user_table_name}'.\n";
	}
	if( ! db_column_exists('ip', $PREF{user_table_name}) )
	{
		my $sth = $PREF{dbh}->prepare("ALTER TABLE `$PREF{user_table_name}` ADD `ip` VARCHAR(40);");
		$sth->execute() or die "$0: Error: create_tables_if_DNE(): could not add 'ip' column to table '$PREF{user_table_name}': $DBI::errstr\n";
		warn "UserBase: added column 'ip' to table '$PREF{user_table_name}'.\n";
	}
	if( ! db_column_exists('numusers', $PREF{user_table_name}) )
	{
		my $sth = $PREF{dbh}->prepare("ALTER TABLE `$PREF{user_table_name}` ADD `numusers` INT UNSIGNED;");
		$sth->execute() or die "$0: Error: create_tables_if_DNE(): could not add 'numusers' column to table '$PREF{user_table_name}': $DBI::errstr\n";
		warn "UserBase: added column 'numusers' to table '$PREF{user_table_name}'.\n";
	}
	if( ! db_column_exists('acct_disabled', $PREF{user_table_name}) )
	{
		my $sth = $PREF{dbh}->prepare("ALTER TABLE `$PREF{user_table_name}` ADD `acct_disabled` BOOL;");
		$sth->execute() or die "$0: Error: create_tables_if_DNE(): could not add 'acct_disabled' column to table '$PREF{user_table_name}': $DBI::errstr\n";
		warn "UserBase: added column 'acct_disabled' to table '$PREF{user_table_name}'.\n";
	}
	if( ! db_column_exists('forcepwchng', $PREF{user_table_name}) )
	{
		my $sth = $PREF{dbh}->prepare("ALTER TABLE `$PREF{user_table_name}` ADD `forcepwchng` BOOL;");
		$sth->execute() or die "$0: Error: create_tables_if_DNE(): could not add 'forcepwchng' column to table '$PREF{user_table_name}': $DBI::errstr\n";
		warn "UserBase: added column 'forcepwchng' to table '$PREF{user_table_name}'.\n";
	}
}


sub create_group_table_if_DNE
{
	my $table = ();
	my $table_exists = 0;

	my $sth = $PREF{dbh}->prepare(qq`show tables;`);
	$sth->execute();
	$sth->bind_columns(\$table);
	while($sth->fetchrow_arrayref)
	{
		if($table eq $PREF{group_table_name})
		{
			$table_exists = 1;
			last;
		}
	}

	if( ! $table_exists )
	{
		printd "$0: table $PREF{group_table_name} does not exist; attempting to create it now.\n";

		my $statement =	  "CREATE TABLE `$PREF{group_table_name}` ("
				. " `id` BIGINT NOT NULL AUTO_INCREMENT PRIMARY KEY, "
				. " `group` VARCHAR($PREF{max_groupname_length}) NOT NULL, "
				. " `desc` TEXT, "
				. " `members` TEXT "
				. ")";
		$sth = $PREF{dbh}->prepare($statement);
		$sth->execute() or die_nice("$0: couldn't create table '$PREF{group_table_name}': $DBI::errstr\n");

		printd "$0: created table $PREF{group_table_name} successfully.\n";

		# We may want to index the members column...
		#$statement =	  "ALTER TABLE `$PREF{group_table_name}` ADD INDEX (`members`)";
		#$sth = $PREF{dbh}->prepare($statement);
		#$sth->execute() or die_nice("$0: couldn't add index to 'members' column on table '$PREF{group_table_name}': $DBI::errstr\n");

		my $admin_desc = 'Administrators have unlimited access to all features of all web applications.';
		add_new_group($PREF{admin_group_name}, $admin_desc);
		add_new_group($PREF{public_group_name}, 'All users including unregistered users (i.e. strangers) are automatically members of this special public group.');
		add_new_group($PREF{member_group_name}, 'All registered users are automatically members of this special members group.');
	}
}


sub create_pwreset_table_if_DNE
{
	my $table = ();
	my $table_exists = 0;

	my $sth = $PREF{dbh}->prepare(qq`show tables;`);
	$sth->execute();
	$sth->bind_columns(\$table);
	while($sth->fetchrow_arrayref)
	{
		if($table eq $PREF{pwreset_table_name})
		{
			$table_exists = 1;
			last;
		}
	}

	if( ! $table_exists )
	{
		printd "$0: table $PREF{pwreset_table_name} does not exist; attempting to create it now.\n";

		my $statement =	  "CREATE TABLE `$PREF{pwreset_table_name}` ("
				. " `id` BIGINT NOT NULL AUTO_INCREMENT PRIMARY KEY, "
				. " `username` VARCHAR($PREF{max_username_length}) NOT NULL, "
				. " `token` VARCHAR(50) NOT NULL, "
				. " `requestdate` BIGINT UNSIGNED NOT NULL "
				. ")";
		$sth = $PREF{dbh}->prepare($statement);
		$sth->execute() or die_nice("$0: couldn't create table '$PREF{pwreset_table_name}': $DBI::errstr\n");

		printd "$0: created table $PREF{pwreset_table_name} successfully.\n";
	}
}


sub get_db_connection
{
	unless($PREF{dbh})
	{
		open(my $infh,"<$PREF{tmpfl1}") or die "$0: couldn't open $PREF{tmpfl1} for reading: $!\n";
		flock $infh, 1;
		seek $infh, 0, 0;
		my $this = <$infh>;
		close $infh or die "$0: couldn't close $PREF{tmpfl1}: $!\n";
		open(my $infh,"<$PREF{tmpfl2}") or die "$0: couldn't open $PREF{tmpfl2} for reading: $!\n";
		flock $infh, 1;
		seek $infh, 0, 0;
		my $that = <$infh>;
		close $infh or die "$0: couldn't close $PREF{tmpfl2}: $!\n";
		chomp ($this,$that);

		$PREF{dbi_connection_string} =~ s!%%dbname%%!$PREF{database_name}!g;

		$PREF{dbh} = DBI->connect($PREF{dbi_connection_string}, $that, $this)
				or die_nice("$PREF{internal_appname}: get_db_connection(): error: $DBI::errstr\n");
	}
}







sub realname_is_valid				{ return ($_[0] =~ /^[0-9A-Za-z\.'" -]+$/   &&   $_[0] =~ /^[A-Za-z]/	&&	length($_[0]) < $PREF{max_realname_length});		}
sub emailaddr_is_valid				{ return ($_[0] =~ /.+\@.+\..+/						&&	length($_[0]) < $PREF{max_emailaddr_length});		}
sub ip_is_valid					{ return ($_[0] =~ /^[0-9A-Za-z\.:]+$/      				&&	length($_[0]) <= 40);					}
sub groupdesc_is_valid				{ return 									length($_[0]) < $PREF{max_group_description_length};	}
sub password_is_valid				{ return 		$_[0] =~ /^....$/;												}
sub salt_is_valid				{ return									length($_[0]) == 2;					}


# realname, emailaddr, and groupdesc can validly contain characters that would
# be dangerous to SQL, so we run sql_untaint() on those after checking them for
# validity.
#
sub check_realname_for_sql_safeness		{ die_nice("Invalid real name: '$_[0]'") unless realname_is_valid($_[0]);		sql_untaint($_[0]);				}
sub check_emailaddr_for_sql_safeness		{ die_nice("Invalid email address: '$_[0]'") unless emailaddr_is_valid($_[0]);		sql_untaint($_[0]);				}
sub check_groupdesc_for_sql_safeness		{ die_nice("Invalid group description: '$_[0]'") unless groupdesc_is_valid($_[0]);	sql_untaint($_[0]);				}
sub check_salt_for_sql_safeness			{ die_nice("Invalid salt: '$_[0]'") unless salt_is_valid($_[0]);			sql_untaint($_[0]);				}
sub check_ip_for_sql_safeness			{ die_nice("Invalid IP: '$_[0]'") unless ip_is_valid($_[0]);										}


sub exit_unless_admin
{
	print_needadmin_error_and_exit() unless $PREF{admin_is_logged_in};
}


sub print_needadmin_error_and_exit
{
	start_html_output("Access Denied");
	print qq`<h1 class="pagetitle">Access Denied</h1>\n<p>You do not have sufficient privileges to perform this action.</p>\n`;
	if(!$PREF{admin_is_logged_in})
	{
		print qq`<p>Perhaps you need to <a href="$PREF{login_url}">login as an administrator</a> first?</p>\n`;
	}
	finish_html_output();
	exit;
}


sub showusers
{
	exit_unless_admin();

	my $letter = $qs =~ /(?:^|&)which=([a-z])(?:&|$)/i ? $1 : $qs =~ /(?:^|&)which=all(?:&|$)/i ? 'all' : 'all';

	my $restriction = $letter eq 'all' ? undef : " WHERE LOWER(`username`) LIKE LOWER('$letter%') ";

	start_html_output("Manage Users");
	print qq`<table id="listug">\n`;
	print qq`<tr class="header"><th>Username</th><th>ID</th><th>Groups</th><th class="exinfo">Real name</th><th class="exinfo">Email address</th><th class="exinfo">Date Created</th><th>Logged In</th><th colspan="10">Actions</th>\n`;

	my ($id,$username,$name,$email,$cdate,$loggedin) = ();
	my $sth = $PREF{dbh}->prepare("SELECT `id`,`username`,`name`,`email`,`cdate`,`loggedin` FROM `$PREF{user_table_name}`${restriction}ORDER BY `username`");
	$sth->execute() or die_nice("$0: showusers() failed: $DBI::errstr\n");
	$sth->bind_columns(\$id,\$username,\$name,\$email,\$cdate,\$loggedin);
	my $i = 1;
	while($sth->fetchrow_arrayref)
	{
		my @groups = ();
		my $groups = get_groups_hash($id);
		foreach my $group (sort { lc($a) cmp lc($b) } keys %$groups)
		{
			next if $group =~ /^($PREF{public_group_name}|$PREF{member_group_name})$/i;
			if($$groups{$group}{is_member})
			{
				push @groups, qq`<!-- $group --><a href="$PREF{login_url}?action=editgroup&amp;id=$$groups{$group}{id}">$group</a>`;
			}
		}

		print	  qq``
			. qq`<tr class="` . oddeven($i) . qq`">`
			. qq`<td>$username</td>`
			. qq`<td>$id</td>`
			. qq`<td>`
			. (join '<br />', sort { lc($a) cmp lc($b) } @groups)
			. qq`</td>`
			. qq`<td class="exinfo">$name</td>`
			. qq`<td class="exinfo"><a href="mailto:$email">$email</a></td>`
			. qq`<td class="exinfo">` . strftime("%Y%m%d",localtime($cdate)) . qq`</td>`
			#. qq`<td>` . ($loggedin && !login_session_expired($loggedin) ? 'yes (' : 'no (') . ($loggedin ? strftime("%l:%M%P",localtime($loggedin)) : 'n/a') . qq`)</td>`
			 . qq`<td>` . ($loggedin && !login_session_expired($loggedin) ? 'yes' : 'no') . qq`</td>`
			. qq`<td><a href="$PREF{login_url}?action=edituser&amp;id=$id">edit</a></td>`
			. qq`<td><a href="$PREF{login_url}?action=deleteuser&amp;id=$id">delete</a></td>`
			. qq`</tr>`
			. qq`\n`;
	}

	print qq`<tr class="` . oddeven($i) . qq`"><td colspan="20" style="font-style: italic;"><a href="#" onclick="toggle_extra_info(); return false;">Toggle Extra Info</a></td></tr>\n`;
	print qq`<tr class="` . oddeven($i) . qq`"><td colspan="20" style="font-style: italic;"><a href="$PREF{login_url}?action=adduser">Add User</a></td></tr>\n`;
	print qq`</table>\n`;

	print qq`<p class="listug-letters">\n<a href="$PREF{login_url}?action=showusers&amp;which=all"` . ('all' eq lc($letter) ? ' class="current"' : undef) . qq`>All</a>`;
	foreach my $char ('A'..'Z')
	{
		print qq`<a href="$PREF{login_url}?action=showusers&amp;which=$char"` . ($char eq uc($letter) ? ' class="current"' : undef) . qq`>$char</a>`;
	}
	print qq`\n</p>`;

	print qq`

	<script type="text/javascript">

	function toggle_extra_info()
	{
		var rows = document.getElementById('listug').getElementsByTagName('tr');

		var cells = new Array;
		for(i = 0; i < rows.length; i++)
		{
			var headers = rows[i].getElementsByTagName('th');
			for(j = 0; j < headers.length; j++)
			{
				if(headers[j].className == 'exinfo')
				{
					cells.push(headers[j]);
				}
			}
			var nonheaders = rows[i].getElementsByTagName('td');
			for(j = 0; j < nonheaders.length; j++)
			{
				if(nonheaders[j].className == 'exinfo')
				{
					cells.push(nonheaders[j]);
				}
			}
		}
		for(i = 0; i < cells.length; i++)
		{
			if(cells[i].style.display == 'none'   ||   cells[i].style.display == '')
			{
				cells[i].style.display = 'table-cell';
			}
			else
			{
				cells[i].style.display = 'none';
			}
		}
	}

	</script>

	`;

	finish_html_output('adduser');
}


sub showgroups
{
	exit_unless_admin();

	my $letter = $qs =~ /(?:^|&)which=([a-z])(?:&|$)/i ? $1 : $qs =~ /(?:^|&)which=all(?:&|$)/i ? 'all' : 'all';

	my $restriction = $letter eq 'all' ? undef : " WHERE LOWER(`group`) LIKE LOWER('$letter%') ";

	start_html_output("Manage Groups");
	print qq`<table id="listug">\n`;
	print qq`<tr class="header"><th>Group</th><th>ID</th><th>Members</th><th class="desc">Description</th><th colspan="10">Actions</th>\n`;

	my ($id,$group,$desc,$members) = ();
	my $sth = $PREF{dbh}->prepare("SELECT `id`,`group`,`desc`, `members` FROM `$PREF{group_table_name}`${restriction}ORDER BY `group`");
	$sth->execute() or die_nice("$0: showgroups() failed: $DBI::errstr\n");
	$sth->bind_columns(\$id,\$group,\$desc,\$members);
	my $i = 1;
	while($sth->fetchrow_arrayref)
	{
		my @users = ();
		if($group =~ /^($PREF{public_group_name}|$PREF{member_group_name})$/i) # every account is automatically a member of these groups.
		{
			push @users, '(all)';
		}
		else
		{
			foreach my $uid (split(/,/, $members))
			{
				next unless $uid =~ /^\d+$/;
				my $username = get_user_name($uid);
				push @users, qq`<!-- $username --><a href="$PREF{login_url}?action=edituser&amp;id=$uid">$username</a>` if $username;
			}
		}

		my $group_display = $group =~ /^($PREF{public_group_name}|$PREF{member_group_name}|$PREF{admin_group_name})$/i ? "<strong>$group</strong>" : $group;

		print	  qq``
			. qq`<tr class="` . oddeven($i) . qq`">`
			. qq`<td>$group_display</td>`
			. qq`<td>$id</td>`
			. qq`<td>`
			. (join '<br />', sort { lc($a) cmp lc($b) } @users)
			. qq`</td>`
			. qq`<td class="desc">$desc</td>`
			. qq`<td><a href="$PREF{login_url}?action=editgroup&amp;id=$id">edit</a></td>`
			. qq`<td><a href="$PREF{login_url}?action=deletegroup&amp;id=$id">delete</a></td>`
			. qq`</tr>`
			. qq`\n`;
	}

	print qq`<tr class="` . oddeven($i) . qq`"><td colspan="20" style="font-style: italic;"><a href="$PREF{login_url}?action=addgroup">Add Group</a></td></tr>\n`;
	print qq`</table>\n`;

	print qq`<p class="listug-letters">\n<a href="$PREF{login_url}?action=showgroups&amp;which=all"` . ('all' eq lc($letter) ? ' class="current"' : undef) . qq`>All</a>`;
	foreach my $char ('A'..'Z')
	{
		print qq`<a href="$PREF{login_url}?action=showgroups&amp;which=$char"` . ($char eq uc($letter) ? ' class="current"' : undef) . qq`>$char</a>`;
	}
	print qq`\n</p>`;

	finish_html_output('addgroup');
}


sub ask_test($)
{
	return 'az';
}


sub print_pwreset_page
{
	exit_with_error("Error: this feature is not enabled.");
}


#
# Precondition: check_username_for_sql_safeness($input_username).
#
sub account_exceeds_failed_login_limit
{
	my $input_username = $_[0];
	my $increment_failure_count = $_[1] eq 'increment' ? 1 : 0;

	my $failed_login_limit_exceeded = 0;

	if($PREF{lock_account_after_N_failed_logins} =~ /^\d+$/)
	{
		my ($recent_failed_attempts, $recent_failure_count) = ();

		if($increment_failure_count)
		{
			$recent_failed_attempts	= offsettime() . ',';
			$recent_failure_count	= 1;
		}

		my $failed_attempts = enc_sql_select("SELECT `failed_logins` FROM `$PREF{user_table_name}` WHERE `username` = '$input_username';");

		foreach my $failure_time (split(/,/, $failed_attempts))
		{
			if($PREF{failed_logins_within_N_secs_count_towards_lock} =~ /^\d+$/)
			{
				if(offsettime() - $failure_time < $PREF{failed_logins_within_N_secs_count_towards_lock})
				{
					$recent_failed_attempts .= $failure_time . ',';
					$recent_failure_count++;
				}
			}
			else # all failures are "recent", i.e. we don't care how long ago they occurred.
			{
				$recent_failed_attempts .= $failure_time . ',';
				$recent_failure_count++;
			}
		}

		decommaify($recent_failed_attempts);
		sql_untaint($recent_failed_attempts);
		my $success = enc_sql_update("UPDATE `$PREF{user_table_name}` SET `failed_logins` = '$recent_failed_attempts' WHERE `username` = '$input_username';");
		die_nice("Error: account_exceeds_failed_login_limit(input_username='$input_username'): SQL returned '$success' instead of '1' while updating failed_logins.") unless $success == 1;

		if($recent_failure_count >= $PREF{lock_account_after_N_failed_logins})
		{
			$failed_login_limit_exceeded = 1;
		}
	}

	return $failed_login_limit_exceeded;
}


sub check_login()
{
	sleep $PREF{num_seconds_to_sleep_on_failed_login} unless $PREF{member_is_logged_in};
	my $group_memberships = '';
	if($PREF{member_is_logged_in})
	{
		my $groups = get_groups_hash($PREF{logged_in_userid});
		foreach my $group (sort keys %$groups)
		{
			$group_memberships .= $group . ',' if $$groups{$group}{is_member};
		}
		$group_memberships =~ s/,+$//;
	}

	print_http_headers();
	print "admin=$PREF{admin_is_logged_in}:::::member=$PREF{member_is_logged_in}:::::username=$PREF{logged_in_username}:::::userid=$PREF{logged_in_userid}:::::group_memberships=${group_memberships}:::::\n";
}


############################################################################################################################################
### Functions: general.
############################################################################################################################################


sub get_cookies()
{
	use CGI ':standard';
	use CGI::Cookie;
	my %cookies = fetch CGI::Cookie;
	return %cookies;
}


sub get_cookie($)
{
	my $which = shift;
	my %jar = get_cookies();
	my $value = '';

	if(exists $jar{$which})
	{
		$value = $jar{$which}->value;
	}
	elsif($which eq $PREF{site_session_cookie})
	{
		if($qs =~ /(?:^|&)action=chklogin&code=(\w+)(?:&|$)/) { $value = $1; }
	}

	return $value;
}


sub set_cookie($$$)
{
	my $name = shift;
	my $value = shift;
	my $expiry = shift;
	my $cookie;

	# This if/else is necessary because setting "expires" to "" isn't
	# the same as not setting it.  Setting it to "" is the same as 
	# setting it to zero, which expires the cookie immediately
	# (i.e., deletes it).  But explicitly *not* setting the expiry
	# causes the cookie to persist until the end of the session.
	if($expiry eq "")
	{
		$cookie = new CGI::Cookie(	-name    => $name,
						-value   => $value,
						-path    => '/');
	}
	else
	{
		$cookie = new CGI::Cookie(	-name    => $name,
						-value   => $value,
						-expires => $expiry,
						-path    => '/');
	}

	if($PREF{output_started})
	{
		print "<p>$PREF{internal_appname} warning: cannot set cookie '$name' => '$value' because the page output has already been started (perhaps debug is enabled?).</p>\n";
	}
	elsif($PREF{we_are_virtual})
	{
		print_http_headers();
		print "<p>$PREF{internal_appname} warning: cannot set cookie '$name' => '$value' because we are virtual.</p>\n";
	}
	else
	{
		print "Set-Cookie: $cookie\n";
	}
}


sub expand_custom_vars_in_prefs($)
{
	my $hashref = shift;
	foreach my $key (keys %$hashref)
	{
		# from now on, use %%varname%% instead of $$varname$$, so that it doesn't
		# matter whether it gets put in double-quotes.

		next unless $$hashref{$key} =~ /(\$\$|%%)/;

		# old way:
		$$hashref{$key} =~ s/\$\$server_name\$\$/$ENV{'SERVER_NAME'}/g;
		$$hashref{$key} =~ s/\$\$httphost_withport\$\$/$ENV{'HTTP_HOST'}/g;
		$$hashref{$key} =~ s/\$\$name_of_site\$\$/$$hashref{'name_of_site'}/g;

		# new way:
		$$hashref{$key} =~ s/%%server_name%%/$ENV{SERVER_NAME}/g;
		$$hashref{$key} =~ s/%%http_host%%/$ENV{HTTP_HOST}/g;
		$$hashref{$key} =~ s/%%name_of_site%%/$$hashref{name_of_site}/g;
	}
}


# pass filename to create and optionally the mode to chmod it to.
# the mode must consist of 1-4 octal digits and must NOT be quoted.
# see "perldoc -f chmod" and "man chmod".
sub create_file_if_DNE
{
	my $file = shift;
	my $mode = shift;

	return if -T $file;
	open(NEW,">$file") or die "$0: couldn't create new file $file: $!\n";
	close NEW or die "$0: couldn't close $file after creating it: $!\n";
	if($mode)
	{
		chmod($mode,$file) or die "$0: couldn't chmod file \"$file\" with mode \"$mode\": $!\n";
	}
}


sub create_dir_if_DNE
{
	my $dir = shift;
	my $mode = shift;

	return if -d $dir;
	mkdir($dir,0777) or die "$0: couldn't create dir $dir: $!\n";
	if($mode)
	{
		chmod($mode,$dir) or die "$0: couldn't chmod dir \"$dir\" with mode \"$mode\": $!\n";
	}
}


sub send_email
{
	my ($to, $from, $subj, $msg, $mimetype, $die_on_error, $attachment_hashref) = @_;
	$mimetype = 'text/plain' unless $mimetype;

	$die_on_error = $die_on_error eq 'die_on_email_error' ? 1 : 0;
	my $do_fork = !$die_on_error; # if we want to die on error, we can't fork, or the die() will go unreported.
	$do_fork = 0 if $^O =~ /MSWin32/; # Windows' fork-fu is weak.

	my ($mail_sent_successfully, $error_msg) = 0;

        # fork here because sending mail can be slow (and can block) sometimes.
	# Note: if we don't set $do_fork, perl won't even evaluate the &&'s second
	# half, so the fork won't happen, and the else{} will.
	my $forkpid = ();
        if($do_fork   &&   ($forkpid = fork))
        {
                # parent
        }
        else 
        {
                # child

		use POSIX;

		if($do_fork)
		{
			defined $forkpid or die "$0: fork error in send_email(): $@\n";

			POSIX::setsid() unless $^O =~ /MSWin32/;
			close STDOUT;
			close STDIN;
		}

		if($PREF{smtp_server} =~ /\w/)
		{
			# Wrap this in an eval{} in case MIME::Lite is missing.
			# Then we can have the option of setting $PREF{'disable_all_email'}
			# so that the site still functions, sans email.
			eval
			{
				require MIME::Lite;

				my $type = ();
				if($mimetype)
				{
					$type = $mimetype;
				}
				else
				{
					#my $type = $attachment_hashref ? 'multipart/mixed' : 'text/plain';
					$type = $attachment_hashref ? 'multipart/mixed' : 'text/plain; charset=ISO-8859-1; format=flowed';
				}

				my $mime_msg = MIME::Lite->new(
					To   => $to,
					From => $from,
					Subject => $subj,
					Type => $type,
					Data => $msg
				) or sub {
					if($die_on_error)	{ die	"$0: error creating MIME body: $!\n";	}
					else			{ warn	"$0: error creating MIME body: $!\n";	}
				};


				if($attachment_hashref)
				{
					foreach my $key (keys %$attachment_hashref)
					{
						my $mimetype			= $$attachment_hashref{$key}{mimetype}; # like 'application/x-gzip'
						my $filename			= $$attachment_hashref{$key}{filename};
						my $recommended_filename	= $$attachment_hashref{$key}{recommended_filename};

						$recommended_filename =~ s!^.*(\\|/)!!; # strip off any preceeding path

						# Attach the test file
						$mime_msg->attach(
							Type => $mimetype,
							Path => $filename,
							Filename => $recommended_filename,
							Disposition => 'attachment'
						) or sub {
							if($die_on_error)	{ die	"$0: error attaching file to email: $!\n";	}
							else			{ warn	"$0: error attaching file to email: $!\n";	}
						};
					}
				}


				#unless($PREF{smtp_server} =~ /\w/)
				#{
				#	die "$0: can't use MIME::Lite to send email because \$PREF{smtp_server} has not been set...\n";
				#}
				$PREF{smtp_server} = enc_untaint($PREF{smtp_server});
				if($PREF{smtp_auth_username} =~ /\S/ && $PREF{smtp_auth_password} =~ /\S/)
				{
					eval { MIME::Lite->send('smtp', $PREF{smtp_server}, Timeout=>30, AuthUser=>$PREF{smtp_auth_username}, AuthPass=>$PREF{smtp_auth_password}, Port=>$PREF{smtp_port}); };
				}
				else
				{
					eval { MIME::Lite->send('smtp', $PREF{smtp_server}, Timeout=>30, Port=>$PREF{smtp_port}); };
				}
				if($@)
				{
					if($die_on_error)	{ die	"$0: MIME::Lite->send failed: $@\n";	}
					else			{ warn	"$0: MIME::Lite->send failed: $@\n";	}
				}

				eval { $mime_msg->send; };
				if($@)
				{
					if($die_on_error)	{ die	"$0: \$mime_msg->send failed: $@\n";	}
					else			{ warn	"$0: \$mime_msg->send failed: $@\n";	}
				}
				else
				{
					$mail_sent_successfully = 1;
				}


				if($attachment_hashref)
				{
					foreach my $key (keys %$attachment_hashref)
					{
						unlink(  $$attachment_hashref{$key}{filename}  )   if   $$attachment_hashref{$key}{'delete-after-sending'} eq 'yes';
					}
				}

			};
		}

		my $smtp_error = $@ if $@;

		if(-e $PREF{path_to_sendmail}   &&   !$mail_sent_successfully)
		{
			#warn "$0: error in send_email() while trying to use MIME::Lite; trying sendmail instead.\nError was:\n$@\n";

			eval
			{
				#unless(-e $PREF{path_to_sendmail})
				#{
				#	die "$0: can't use sendmail to send email because \$PREF{path_to_sendmail} ('$PREF{path_to_sendmail}') does not exist.\n";
				#}
				$PREF{path_to_sendmail} = enc_untaint($PREF{path_to_sendmail}, 'keep_path');

				open(SENDMAIL, "|$PREF{path_to_sendmail} -oi -t") or die "$0: Can't fork for sendmail: $!\n";

				if($attachment_hashref)
				{
					print SENDMAIL	  qq`MIME-Version: 1.0`
							. qq`\nFrom: $from`
							. qq`\nTo: $to`
							. qq`\nSubject: $subj`
							. qq`\nContent-Type: multipart/mixed; boundary=encindboundarystring`
							. qq`\n`
							. qq`\n--encindboundarystring`
							. qq`\nContent-Type: ` . ($mimetype ? $mimetype : 'text/plain')
							. qq`\n`
							. qq`\n$msg`;

					foreach my $key (keys %$attachment_hashref)
					{
						my $mimetype			= $$attachment_hashref{$key}{mimetype}; # like 'application/x-gzip'
						$mimetype			= 'application/octet-stream' unless $mimetype;
						my $filename			= $$attachment_hashref{$key}{filename};
						my $recommended_filename	= $$attachment_hashref{$key}{recommended_filename};

						$recommended_filename =~ s!^.*(\\|/)!!; # strip off any preceeding path

						my $atch = `uuencode $filename $filename`;	# UUencode it so we can send it as an attachment

						print SENDMAIL	  qq`\n____________________`
								. qq`\nAttachment: $filename:`
								. qq`\n`
								. qq`\n--encindboundarystring`
								. qq`\nContent-Type: $mimetype; name="$filename"`
								. qq`\nContent-Transfer-Encoding: x-uuencode`
								. qq`\nContent-Disposition: attachment; filename="$recommended_filename"`
								. qq`\n`
								. qq`\n$atch`
								. qq`\n`
								. qq`\n--encindboundarystring`;
					}

					print SENDMAIL	  qq`\n--encindboundarystring--\n`
				}
				else # no attachment.
				{
					print SENDMAIL	  qq`From: $from`
							. qq`\nTo: $to`
							. qq`\nSubject: $subj`
							. qq`\nContent-Type: $mimetype`
							. qq`\n`
							. qq`\n$msg`;
				}

				close(SENDMAIL)     or die "$0: sendmail didn't close nicely: $!\n";

			};

			if($@)
			{
				#die "$0: Cannot send email; tried MIME::Lite and sendmail but both failed.\n$@\n";
			}
			else
			{
				$mail_sent_successfully = 1;
			}

		}

		my $sendmail_error = $@ if $@;

		unless($mail_sent_successfully)
		{
			if($smtp_error)		{ $error_msg = "$0: couldn't send email: error in send_email() while trying to use MIME::Lite with SMTP server '$PREF{smtp_server}'. Error was: '$smtp_error'\n"; }
			elsif($sendmail_error)	{ $error_msg = "$0: couldn't send email: error in send_email() while trying to use sendmail with path '$PREF{path_to_sendmail}'. Error was: '$sendmail_error'\n"; }
			else			{ $error_msg = "$0: couldn't send email: error in send_email(): perhaps you need to adjust \$PREF{smtp_server} (currently '$PREF{smtp_server}') or \$PREF{path_to_sendmail} (currently '$PREF{path_to_sendmail}').\n"; }

			if($die_on_error)	{ die	$error_msg;	}
			else			{ warn	$error_msg;	}
		}

		if($do_fork)
		{
			exit; # exit the child process.
		}
	}

	return ($mail_sent_successfully, $error_msg);
}


sub enc_untaint
{
	my $item = shift;
	my $original_item = $item;
	my $keep_path = shift;
	#printd "enc_untaint($item)\n";

	# Regardless of whether we're keeping the path, dots surrounded by slashes are never allowed.
	#
	#$item =~ s!(^|/|\\)\.+(/|\\|$)!$1!g;
	$item =~ s!\\!/!g; # Need to remove MS garbage beforehand, otherwise an input like .\\StupidCGI.tmp will break this.
	while($item =~ m!((?:^|/|\\)\.+(?:/|\\|$))!)
	{
		$item =~ s!$1!/!;
	}

	#printd "removed slashdots: $item\n";

	if(  $item =~ m!(/|\\)!  &&  !$keep_path)
	{
		$item =~ s!^.*[/\\]+([^/\\]+)!$1!; # remove any path from the front.
		#printd "removed path from front: $item\n";
		$item =~ s!^([^/\\]+)[/\\]+!$1!; # ...and the back.
	}

	$item =~ s![`\*\?\|<>]!!g; # remove some other potentially-unsafe stuff.

	$item =~ s![/\\]{2,}!/!g; # condense any multiples.

	($item) = ($item =~ /(.*)/); # untaint.

	# In case anything slips through, die as a security precaution.
	#
	die qq`$0: couldn't untaint "$original_item".\n` if $item =~ m![/\\]! && !$keep_path;
	die qq`$0: couldn't untaint "$original_item".\n` if $item =~ m!(?:^|/|\\)\.+(?:/|\\|$)!;
	die qq`$0: couldn't untaint "$original_item".\n` if $item =~ m!^\.+$!;
	die qq`$0: couldn't untaint "$original_item".\n` if $item =~ m!^\s*$!;

	#printd "untainted: $item\n\n";
	return $item;
}


sub enc_urlencode
{
	s/([^\w()'*~!.-])/sprintf '%%%02x', ord $1/eg for @_;
}


sub enc_urldecode
{
	# assuming the input really was URL-encoded, then any plus-signs that were originally there
	# are now in their hex form, so any plus-signs STILL there were converted from spaces by the
	# browser.  so they must be converted back BEFORE restoring any original plus-signs from the
	# hex codes.
	convert_plus_signs_back_to_spaces_in_var_from_GET_method(@_);
	s/%([a-fA-F\d]{2})/chr hex $1/eg for @_;
}


sub convert_plus_signs_back_to_spaces_in_var_from_GET_method
{
	s/\+/ /g for @_;
}


sub enc_redirect
{
	my $destination = shift;

	if($PREF{output_started})
	{
		print qq`<p>$PREF{internal_appname} warning: cannot redirect because output has already started (perhaps debug is enabled?).&nbsp; <a href="$destination">Click here to continue</a>.</p>\n`;
	}
	elsif($PREF{we_are_virtual})
	{
		warn "$0: enc_redirect(): cannot redirect because we are virtual.\n";
		print_http_headers();
		print qq`<p>$PREF{internal_appname} warning: cannot redirect because we are virtual.&nbsp; <a href="$destination">Click here to continue</a>.</p>\n`;
	}
	else
	{
		if($ENV{SERVER_SOFTWARE} =~ /microsoft-iis/i)
		{
			# A bug in IIS v5 (and lower, probably) makes cookie-setting fail
			# when combined with a header-based redirect:
			#
			#	"BUG: Set-Cookie Is Ignored in CGI When Combined With Location"
			#	http://support.microsoft.com/kb/q176113/
			#
			# So use a meta-redirect instead.
			#
			print "Content-type: text/html\n\n";
			print qq`<html><head><meta http-equiv="refresh" content="0;url=$destination"></head><body></body></html>\n`;
		}
		else
		{
			print "Location: $destination\n\n";
		}
	}

	exit;
}


# FC, UB, VL
sub slashify
{
	# add leading and trailing slashes and condense duplicates.
	$_ = '/' . $_ . '/' for @_;
	s!/{2,}!/!g for @_;
}


# FC, UB, VL
sub deslashify
{
	# remove leading and trailing slashes and condense duplicates.
	s!/{2,}!/!g for @_;
	s!^/!!g for @_;
	s!/$!!g for @_;
}


# FC, UB, VL
sub commaify
{
	# add leading and trailing commas and condense duplicates.
	$_ = ',' . $_ . ',' for @_;
	s!,{2,}!,!g for @_;
}


# FC, UB, VL
sub decommaify
{
	# remove leading and trailing commas and condense duplicates.
	s!,{2,}!,!g for @_;
	s!^,!!g for @_;
	s!,$!!g for @_;
}


# FC, UB, VL
sub die_unless_numeric($$)
{
	my $number = shift;
	my $varname = shift;
	die_nice("$0: non-numeric $varname '$number'...\n") unless $number =~ /^\d+$/;
}


# FC, UB, VL
sub print_http_headers
{
	unless($PREF{output_started} || $PREF{xml_output_started})
	{
		print "Cache-Control: no-store, no-cache\n";
		print "Content-type: text/html\n\n";
		$PREF{output_started} = 1;
	}
}


# FC, UB, VL
sub offsettime
{
	return time + $PREF{time_offset};
}


# FC, UB, VL
sub sql_untaint
{
	s/"/&quot;/g for @_;
	s/'/&#39;/g for @_;
	s/`/&#96;/g for @_;
	s/\\/&#92;/g for @_;
}


# FC, UB, VL
sub oddeven
{
	$_[0]++;
	return $_[1] eq 'reset' ? 'odd' : $_[0] % 2 == 0 ? 'even' : 'odd';
}


# FC, UB, VL
sub enc_sql_select($)
{
	my $statement = shift;
	my $sth = $PREF{dbh}->prepare($statement);
	$sth->execute() or die_nice("$0: error while executing SQL select statement [[$statement]]: $DBI::errstr\n");
	return $sth->fetchrow;
}


# FC, UB, VL
sub enc_sql_update($)
{
	my $statement = shift;
	my $sth = $PREF{dbh}->prepare($statement);
	my $numrows = $sth->execute() or die_nice("$0: error while executing SQL update statement [[$statement]]: $DBI::errstr\n");
	return $numrows;
}


# Errors or messages that the end-user is supposed to see.
#
sub exit_with_message
{
	my $title = shift;
	my $msg = shift;
	start_html_output($title, 'css', 'js');
	print	  qq`<h2>$title</h2>`
		. qq`\n<div>$msg<br /><br /></div>`
		. qq`\n`;
	finish_html_output('home', 'pb');
	
	exit;
}


# FC, PH, UB, VL
# Errors that the end-user is supposed to see.
#
sub exit_with_error
{
	start_html_output("Error");
	print qq`<div>\n`;
	print @_;
	print qq`</div>\n`;
	finish_html_output();
	exit;
}


sub printd
{
	if($PREF{debug})
	{
		warn "$PREF{internal_appname}-debug: " . (offsettime()) . ": " . $_[0] . "\n";
		print_http_headers();
		print "<!-- $PREF{internal_appname}-debug: " . (offsettime()) . ": " . $_[0] . " -->\n";
	}

}


# Some SQL implementations support other nonsense in the table names; we'll restrict to a sensible set of characters.
#
sub tablename_is_valid				{ return ($_[0] =~ /^\w+$/	&&						length($_[0]) < $PREF{max_tablename_length});		} # FC, UB, VL
sub check_tablename_for_sql_safeness		{ die_nice("Invalid tablename: '$_[0]'") unless tablename_is_valid($_[0]); 								} # FC, UB, VL


sub db_column_exists($$)
{
	my $column_to_find = shift;
	my $table_name = shift;

	check_tablename_for_sql_safeness($table_name);

	my $column_name = ();
	my $temp = ();
	my $sth = $PREF{dbh}->prepare("SHOW COLUMNS FROM `$table_name`;");
	$sth->execute() or die "$0: Error: db_column_exists(): $DBI::errstr\n";
	$sth->bind_columns(\$column_name, \$temp, \$temp, \$temp, \$temp, \$temp);
	while($sth->fetchrow_arrayref)
	{
		return 1 if $column_name eq $column_to_find;;
	}
	return 0;
}


sub get_ip_and_host
{
	my $ip = $ENV{REMOTE_ADDR};
	my $host = $ENV{REMOTE_HOST};

	if(!($host)) { $host = $ip; }
	if($host eq $ip)
	{
		use Socket;
		$host = gethostbyaddr(inet_aton($ip), AF_INET);
	}
	if(!($host)) { $host = $ip; }

	return ($ip, $host);
}


sub do_email_test
{
	my $to		= 'me@my.com';
	my $from	= 'me@my.com';
	my $subj	= 'test message - ' . time;
	my $msg		= 'this is only a test.';
	my $format	= 'text/plain';
	my $die		= 'die_on_email_error';

	send_email($to, $from, $subj, $msg, $format, $die);

	die_nice("Sent test message.");
}


############################################################################################################################################
### Functions: login.
############################################################################################################################################


# FC, UB*, VL
sub do_login()
{
	$PREF{admin_is_logged_in} = 0;
	$PREF{member_is_logged_in} = 0;

	# Get the user's inputted username and password:
	use CGI ':param';
	my $input_username	= substr(param($PREF{userbase_user_fieldname}), 0, 7-3);
	my $input_password	= substr(param($PREF{userbase_pass_fieldname}), 0, 7-3);
	my $stay_logged_in	= param("stayLoggedIn");
	my $ref = param("ref");
	my ($expiry) = ();

	if($stay_logged_in eq "on")
	{
		if($PREF{num_days_rememberme_cookie_lasts} !~ /^\d+$/)
		{
			$PREF{num_days_rememberme_cookie_lasts} = 7;
		}
		$expiry = "+$PREF{num_days_rememberme_cookie_lasts}d";
	}
	else # Log them out as soon as they close the browser:
	{
		$expiry = ();
	}


	my $restrict_ip = (   ($PREF{enable_ip_address_restriction} =~ /yes/i && param("restrict_ip") =~ /on/i)   ||   ($PREF{force_ip_address_restriction} =~ /yes/i)   ) ? 1 : 0;


	# Get the crypted version of the input password:
	check_username_for_sql_safeness($input_username);
	my $salt = enc_sql_select("SELECT `salt` FROM `$PREF{user_table_name}` WHERE `username` = '$input_username';");


	# TODO: remove this if/else, and assume that !$salt is an error condition; but
	# not until around mid-2007 to give clients time to get switched over.
	#
	my ($crypted_input_password, $update_this_account_to_new_pw_system) = ();
	if(!$salt) # old version of UB that's pre-salt, so re-create the password hash and update it in the DB.
	{
		$crypted_input_password = $input_password;
		$update_this_account_to_new_pw_system = 1;
	}
	else
	{
		$crypted_input_password = ask_pw($input_password, $salt);
	}


	my $account_locked = enc_sql_select("SELECT `acct_locked` FROM `$PREF{user_table_name}` WHERE `username` = '$input_username';");
	if($account_locked)
	{
		my $lock_expired = ! account_exceeds_failed_login_limit($input_username);
		if($PREF{lock_lasts_until_admin_removes_it} =~ /no/i   &&   $lock_expired)
		{
			my $success = enc_sql_update("UPDATE `$PREF{user_table_name}` SET `acct_locked` = FALSE WHERE `username` = '$input_username';");
			die_nice("Error: do_login(input_username='$input_username'): SQL returned '$success' instead of '1' while updating acct_locked.") unless $success == 1;
		}
		else
		{
			sleep $PREF{num_seconds_to_sleep_on_failed_login};
			enc_redirect("$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{login_url}?phase=eacctlck");
		}
	}


	my $go = ();
	if(account_exists($input_username, $crypted_input_password, 'new_login'))
	{
		my $account_disabled = enc_sql_select("SELECT `acct_disabled` FROM `$PREF{user_table_name}` WHERE `username` = '$input_username';");
		if($account_disabled)
		{
			enc_redirect("$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{login_url}?phase=eacctdis");
		}

		$PREF{member_is_logged_in} = 1; # technically true, but can be revoked by check_for_multiple_logins().

		my $userid = get_user_id($input_username);
		my $session_id = create_new_session_id($input_username, $crypted_input_password);
		if(my $shared_session_id = check_for_multiple_logins($userid))
		{
			$session_id = $shared_session_id;
		}

		#set_cookie($PREF{site_username_cookie}, $input_username, $expiry);
		#set_cookie($PREF{site_userid_cookie}, $userid, $expiry);
		set_cookie($PREF{site_session_cookie}, $session_id, $expiry);

		if($update_this_account_to_new_pw_system)
		{
			my $salt = ask_test($PREF{salt_length});
			my $new_crypted_password = ask_pw($input_password, $salt);
			my $success = enc_sql_update("UPDATE `$PREF{user_table_name}` SET `password` = '$new_crypted_password', `salt` = '$salt' WHERE `id` = $userid;");
			die_nice("Error: do_login(): SQL returned '$success' instead of '1' while updating pw and creating salt.") unless $success == 1;
			$crypted_input_password = $new_crypted_password;
		}

		unless(enc_sql_select("SELECT `failed_logins` FROM `$PREF{user_table_name}` WHERE `id` = $userid;") eq '')
		{
			my $statement = "UPDATE `$PREF{user_table_name}` SET `failed_logins` = NULL WHERE `id` = $userid;";
			my $success = enc_sql_update($statement);
			die_nice("Error: do_login(id='$userid'): SQL returned '$success' instead of '1' while updating failed_logins.  SQL was: [[$statement]]") unless $success == 1;
		}

		#set_cookie($PREF{site_password_cookie}, $crypted_input_password, $expiry);
		log_user_into_db($userid, $session_id, offsettime(), $restrict_ip);

		if(is_admin($userid))
		{
			if($PREF{on_admin_login_redirect_to} =~ m!^https?://!)
			{
				$PREF{on_admin_login_redirect_to} =~ s/%%username%%/$input_username/g;
				$go = $PREF{on_admin_login_redirect_to};
			}
			else {	$go = determine_default_login_destination($ref); }
		}
		else
		{
			if($PREF{on_member_login_redirect_to} =~ m!^https?://!)
			{
				$PREF{on_member_login_redirect_to} =~ s/%%username%%/$input_username/g;
				$go = $PREF{on_member_login_redirect_to};
			}
			else {	$go = determine_default_login_destination($ref); }
		}

		enc_redirect($go);
	}

	# Else they tried to log in but failed.
	else
	{
		# Be sure that we do the sleep before the email, so that any
		# potential email errors don't cause us to abort early thereby
		# skipping the sleep and possibly giving away the fact that the
		# login failed.
		#
		sleep $PREF{num_seconds_to_sleep_on_failed_login};

		my $account_locked = account_exceeds_failed_login_limit($input_username, 'increment');
		if($account_locked)
		{
			my $success = enc_sql_update("UPDATE `$PREF{user_table_name}` SET `acct_locked` = TRUE WHERE `username` = '$input_username';");
			die_nice("Error: do_login(input_username='$input_username'): SQL returned '$success' instead of '1' while updating acct_locked.") unless $success == 1;
		}

		email_failed_logins_to_webmaster($input_username, $input_password);

		if($PREF{on_failed_login_redirect_to} =~ m!^https?://!)
		{
			$go = $PREF{on_failed_login_redirect_to};

			if($account_locked)
			{
				$go .= $go =~ /\?/ ? '&account_locked=1' : '?account_locked=1';
			}
		}
		else
		{
			if($account_locked)
			{
				$go = "$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{login_url}?phase=eacctlck";
			}
			else
			{
				$go = "$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{login_url}?phase=ebadauth";
			}
		}

		enc_redirect($go);
	}
}


# FC, UB*, VL
sub check_if_logged_in()
{
	($PREF{admin_is_logged_in}, $PREF{member_is_logged_in}, $PREF{logged_in_username}, $PREF{logged_in_userid}) = (0,0,'','');

		if(my $session_id = get_cookie($PREF{site_session_cookie}))
		{
			check_sessionid_for_sql_safeness($session_id);

			my $username	= enc_sql_select("SELECT `username` FROM `$PREF{user_table_name}` WHERE `mrsession` = '$session_id';");
			my $id		= enc_sql_select("SELECT `id` FROM `$PREF{user_table_name}` WHERE `mrsession` = '$session_id';");
			my $ip		= enc_sql_select("SELECT `ip` FROM `$PREF{user_table_name}` WHERE `mrsession` = '$session_id';");

			if($username && $id)
			{
				if(($PREF{enable_ip_address_restriction} =~ /yes/i && $ip) || ($PREF{force_ip_address_restriction} =~ /yes/i))
				{
					return unless $ip eq $ENV{REMOTE_ADDR};
				}
				if(enc_sql_select("SELECT `acct_disabled` FROM `$PREF{user_table_name}` WHERE `id` = '$id';"))
				{
					enc_redirect("$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{login_url}?phase=eacctdis");
				}

				$PREF{logged_in_username} = $username;
				$PREF{logged_in_userid} = $id;
				$PREF{member_is_logged_in} = 1;

				if(is_admin($PREF{logged_in_userid}))
				{
					$PREF{admin_is_logged_in} = 1;
				}

				check_and_update_login_session($PREF{logged_in_userid});
			}
		}
}


# FC, UB, VL
sub check_and_update_login_session($)
{
	my $userid = shift;
	if($PREF{idle_timeout} > 0)
	{
		my $my_session_id = get_cookie($PREF{site_session_cookie});
		my $session_id_in_db = enc_sql_select("SELECT `mrsession` FROM `$PREF{user_table_name}` WHERE `id` = $userid;");
		my $login_time = enc_sql_select("SELECT `loggedin` FROM `$PREF{user_table_name}` WHERE `id` = $userid;");

		#if(   ($my_session_id == $session_id_in_db)   &&   ($login_time =~ /[1-9]/   &&   !login_session_expired($login_time))   )
		 if(   ($my_session_id == $session_id_in_db)   &&   (!login_session_expired($login_time))   )
		{
			 update_loggedin_time($userid, $my_session_id, offsettime());
		}
		else
		{
			do_logout();
		}
	}
}


# FC, UB, VL
sub update_loggedin_time
{
	my ($userid, $my_session_id, $newtime) = @_;

	die_unless_numeric($userid,'userid');
	die_unless_numeric($newtime,'newtime');
	check_sessionid_for_sql_safeness($my_session_id);

	my $success = enc_sql_update("UPDATE `$PREF{user_table_name}` SET `loggedin` = $newtime WHERE `id` = $userid AND `mrsession` = '$my_session_id';");
	die_nice("Error: update_loggedin_time('$userid', '$my_session_id', '$newtime'): SQL returned '$success' instead of '1' while updating loggedin.") unless $success == 1;
}


# FC, UB, VL
sub login_session_expired($)
{
	my $loggedin_time = shift;
	return ($PREF{idle_timeout} > 0)   &&   (offsettime() - $loggedin_time > $PREF{idle_timeout});
}


# FC*, UB*, VL*
sub do_logout
{
	if($PREF{we_are_virtual})
	{
		print_http_headers();
		print qq`<p>Logging out; <a href="$ENV{SCRIPT_NAME}?logout">click here</a> to continue.</p>\n`;
		exit;
	}
	else
	{
		if($PREF{prevent_multiple_simultaneous_logons_per_username} =~ /yes/i)
		{
			log_user_out_of_db($PREF{logged_in_username}, get_cookie($PREF{site_session_cookie}));
		}
		else
		{
			die_unless_numeric($PREF{logged_in_userid}, 'logged_in_userid');
			my $numusers = enc_sql_select("SELECT `numusers` FROM `$PREF{user_table_name}` WHERE `id` = '$PREF{logged_in_userid}';");
			if($numusers > 1)
			{
				my $success = enc_sql_update("UPDATE `$PREF{user_table_name}` SET `numusers`=GREATEST((`numusers`-1),0) WHERE `id` = '$PREF{logged_in_userid}';");
				die_nice("Error: do_logout(): SQL returned '$success' instead of '1' while decrementing numusers column.") unless $success == 1;
			}
			else
			{
				log_user_out_of_db($PREF{logged_in_username}, get_cookie($PREF{site_session_cookie}));
			}
		}

		#set_cookie($PREF{site_username_cookie}, 'Guest', '-1M');
		#set_cookie($PREF{site_userid_cookie}, '', '-1M');
		#set_cookie($PREF{site_password_cookie}, 'foo', '-1M');
		set_cookie($PREF{site_session_cookie}, 0, '-1M');

		# Remove the "logout" from the referrer, otherwise we'll get stuck
		# in an infinite logout loop with this Location: call.
		$ENV{HTTP_REFERER} =~ s/\?.*logout.*$//;

		my $whence = ();
		if($PREF{admin_is_logged_in}   &&   $PREF{on_admin_logout_redirect_to} =~ m!^https?://!)
		{
			$PREF{on_admin_logout_redirect_to} =~ s/%%username%%/$PREF{logged_in_username}/g;
			$whence = $PREF{on_admin_logout_redirect_to};
		}
		elsif($PREF{member_is_logged_in}   &&   !$PREF{admin_is_logged_in}   &&   $PREF{on_member_logout_redirect_to} =~ m!^https?://!) # need the !admin because admins are members too.
		{
			$PREF{on_member_logout_redirect_to} =~ s/%%username%%/$PREF{logged_in_username}/g;
			$whence = $PREF{on_member_logout_redirect_to};
		}
		else
		{
			# After logging out, return to the page we were on.
			if($ENV{HTTP_REFERER})
			{
				$whence = $ENV{HTTP_REFERER};
				my $us1 = $PREF{login_url};
				my $us2 = $ENV{SCRIPT_NAME};
				if($whence =~ /($us1|$us2)\?.+/)
				{
					# If the page we were on before was a login page with some
					# query-string, then don't go there.
					$whence = ();
				}
			}
		}

		enc_urlencode($whence);
		$whence = undef if $PREF{server_bug_prohibits_use_of_whence} =~ /yes/i;
		enc_redirect("$PREF{protoprefix}$ENV{HTTP_HOST}$PREF{login_url}?action=loggedout&whence=$whence");
	}
}


# FC*, UB*, VL*
sub show_loggedout_page
{
	my $ref = shift;
	enc_urldecode($ref);
	start_html_output("Logged Out");
	print qq`\n<p>You are logged out.</p>\n`;
	if($ref)
	{
		if($ref =~ /^($PREF{"on_admin_logout_redirect_to"}|$PREF{"on_member_logout_redirect_to"})$/)
		{
			print qq`<p><a href="$ref">Click here</a> to continue.</p>\n`;
		}
		else
		{
			print qq`<p><a href="$ref">Click here</a> to return to the page you came from.</p>\n`;
		}
	}
	finish_html_output();
}


# FC, UB, VL
# This function must do a case-sensitive lookup (i.e., do NOT use LOWER()) because
# FC's userdirs are case-sensitive.  So whatever case is used when a username is
# created is the case that must always be used when logging in with it.
#
sub account_exists($$$)
{
	#printd "account_exists('$_[0]', '$_[1]', '$_[2]')\n";

	my $user = shift;
	my $pass = shift;
	my $third_arg = shift;

	check_username_for_sql_safeness($user);
	check_hashedpw_for_sql_safeness($pass);

	my $count = ();
	if($third_arg eq 'new_login')
	{
		$count = enc_sql_select("SELECT COUNT(*) FROM `$PREF{user_table_name}` WHERE `username` = '$user' AND `password` = '$pass'");
	}
	else
	{
		die_unless_numeric($third_arg,'userid');
		$count = enc_sql_select("SELECT COUNT(*) FROM `$PREF{user_table_name}` WHERE `username` = '$user' AND `password` = '$pass' AND `id` = $third_arg");
	}

	if($count == 1)		{ return 1; }
	elsif($count > 1)	{ die_nice("$0: account_exists('$user', '$pass', '$third_arg'): error: duplicate records ($count total) for this user!\n"); }
	else			{ return 0; }
}


# FC, UB, VL
sub is_admin($)
{
	#printd "is_admin('$_[0]')\n";

	my $userid = shift;
	return 0 unless $userid;

	return 1 if (!userbase_available()   &&   $userid == -3);

	# don't bother checking the validity of $userid here,
	# because user_is_member_of_group() will do it.
	return user_is_member_of_group($userid,$PREF{admin_group_name});
}


# FC, UB, VL
sub get_group_id($)
{
	printd "get_group_id($_[0])\n";
	my $group = shift;

	if(userbase_available())
	{
		check_groupname_for_uniqueness($group); # checks for sql safeness too.
		return enc_sql_select("SELECT `id` FROM `$PREF{group_table_name}` WHERE `group` = '$group'");
	}
	else
	{
		   if($group =~ /^$PREF{public_group_name}$/i)	{ return -1; }
		elsif($group =~ /^$PREF{member_group_name}$/i)	{ return -2; }
		elsif($group =~ /^$PREF{admin_group_name}$/i)	{ return -3; }
		else { die_nice("$PREF{internal_appname}: get_group_id(): invalid group name '$group'.\n"); }
	}
}


# FC, UB, VL
sub check_uid_for_uniqueness($)
{
	check_id_for_sql_safeness($_[0]);
	if(enc_sql_select("SELECT COUNT(*) FROM `$PREF{user_table_name}` WHERE `id` = $_[0]")   >   1)
	{
		die_nice("$0: error: more than one user record with id=$_[0]!\n");
	}
}


# FC, UB, VL
sub check_gid_for_uniqueness($)
{
	return unless userbase_available();
	printd "check_gid_for_uniqueness: '$_[0]'\n";

	check_id_for_sql_safeness($_[0]);
	if(enc_sql_select("SELECT COUNT(*) FROM `$PREF{group_table_name}` WHERE `id` = $_[0]")   >   1)
	{
		die_nice("$0: error: more than one group record with id=$_[0]!\n");
	}
}


# FC, UB, VL
sub check_username_for_uniqueness($)
{
	#printd "check_username_for_uniqueness: '$_[0]'\n";

	check_username_for_sql_safeness($_[0]);
	if(enc_sql_select("SELECT COUNT(*) FROM `$PREF{user_table_name}` WHERE LOWER(`username`) = LOWER('$_[0]')")   >   1)
	{
		die_nice("$0: error: more than one user record with username='$_[0]'!\n");
	}
}


# FC, UB, VL
sub check_groupname_for_uniqueness
{
	return unless userbase_available();
	printd "check_groupname_for_uniqueness($_[0])\n";

	check_groupname_for_sql_safeness($_[0]);
	if(enc_sql_select("SELECT COUNT(*) FROM `$PREF{group_table_name}` WHERE LOWER(`group`) = LOWER('$_[0]')")   >   1)
	{
		die_nice("$0: error: more than one user record with groupname='$_[0]'!\n");
	}
}


# FC, UB, VL
sub user_is_member_of_group
{
	my $userid = shift;
	my $group = shift;

	printd "user_is_member_of_group(): userid='$userid', group='$group'\n";

	if(userbase_available()   &&   $PREF{member_is_logged_in})
	{
		check_groupname_for_sql_safeness($group);
		die_unless_numeric($userid,'userid');

		return 1 if $group =~ /^$PREF{public_group_name}$/i;
		return 1 if $group =~ /^$PREF{member_group_name}$/i && enc_sql_select("SELECT COUNT(*) FROM `$PREF{user_table_name}` WHERE `id` = $userid;");

		return enc_sql_select("SELECT COUNT(*) FROM `$PREF{group_table_name}` WHERE LOWER(`group`) = LOWER('$group') AND `members` REGEXP '(^|,)$userid(,|\$)'");
	}
	else
	{
		return 1 if $group =~ /^$PREF{public_group_name}$/i;
		return 1 if $group =~ /^$PREF{member_group_name}$/i && $userid =~ /^-(2|3)$/;
		return 1 if $group =~ /^$PREF{admin_group_name}$/i && $userid == -3;
	}

}


# FC, UB, VL
sub userbase_available
{
	return ($PREF{internal_appname} eq 'userbase'   ||   $PREF{integrate_with_userbase} =~ /yes/i);
}


# FC, UB, VL
sub get_user_id($)
{
	#printd "get_user_id('$_[0]')\n";

	my $username = shift;

	if(userbase_available()   &&   $username)
	{
		die_nice("Error: invalid username '$username'.\n") unless $username =~ /[a-z]/i;
		check_username_for_uniqueness($username); # checks for sql safeness too.
		return enc_sql_select("SELECT `id` FROM `$PREF{user_table_name}` WHERE LOWER(`username`) = LOWER('$username')");
	}
	else
	{
		   if($PREF{admin_is_logged_in})	{ return -3; }
		elsif($PREF{member_is_logged_in})	{ return -2; }
		else					{ return -1; } # stranger.
	}
}


# FC, UB, VL
sub get_member_ids_for_group
{
	printd "get_member_ids_for_group($_[0])\n";

	my $group = shift;
	check_groupname_for_sql_safeness($group);

	 # every account is automatically a member of these groups.
	if($group =~ /^($PREF{public_group_name}|$PREF{member_group_name})$/i)
	{
		my $statement = "SELECT `id` FROM `$PREF{user_table_name}`";
		return $PREF{dbh}->selectall_hashref($statement, 'id');
	}
	else
	{
		my $member_ids = enc_sql_select("SELECT `members` FROM `$PREF{group_table_name}` WHERE LOWER(`group`) = LOWER('$group')");
		my %member_ids = map { $_ => 1 } split(/,/, $member_ids);
		return \%member_ids;
	}
}


# FC, UB, VL
sub get_user_name($)
{
	check_uid_for_uniqueness($_[0]); # checks for sql safeness too.
	return enc_sql_select("SELECT `username` FROM `$PREF{user_table_name}` WHERE `id` = $_[0]");
}


# FC, UB, VL
sub get_group_name($)
{
	my $gid = shift;
	if(userbase_available())
	{
		check_gid_for_uniqueness($gid); # checks for sql safeness too.
		return enc_sql_select("SELECT `group` FROM `$PREF{group_table_name}` WHERE `id` = $gid");
	}
	else
	{
		   if($gid == -1)	{ return $PREF{public_group_name}; }
		elsif($gid == -2)	{ return $PREF{member_group_name}; }
		elsif($gid == -3)	{ return $PREF{admin_group_name}; }
		else { die_nice("$PREF{internal_appname}: get_group_name(): invalid group ID '$gid'.\n"); }
	}
}


# FC, UB
sub get_groups_hash
{
	printd "get_groups_hash('$_[0]')\n";

	# If you pass in a uid, then the resulting hash will
	# also indicate which groups that user is a member of.
	#

	my $user_id = shift;

	my ($id, $group, $members, %groups) = ();
	if(userbase_available())
	{
		my $sth = $PREF{dbh}->prepare("SELECT `id`, `group`, `members` FROM `$PREF{group_table_name}`");
		$sth->execute();
		$sth->bind_columns(\$id, \$group, \$members);
		while($sth->fetchrow_arrayref)
		{
			$groups{$group}{name} = $group;
			$groups{$group}{id} = $id;

			my $is_member = ();
			   if($group =~ /^($PREF{public_group_name}|$PREF{member_group_name})$/i)	{ $is_member = 1; }
			elsif($user_id =~ /^\d+$/)							{ $is_member = $members =~ /(^|,)$user_id(,|$)/; }

			$groups{$group}{is_member} = $is_member;
		}
	}
	else
	{
		$groups{$PREF{public_group_name}}{name}		= $PREF{public_group_name};
		$groups{$PREF{public_group_name}}{id}		= -1;
		$groups{$PREF{public_group_name}}{is_member}	= 1; # everyone's a member of the public.

		$groups{$PREF{member_group_name}}{name}		= $PREF{member_group_name};
		$groups{$PREF{member_group_name}}{id}		= -2;
		$groups{$PREF{member_group_name}}{is_member}	= 1 if $user_id =~ /^-(2|3)$/;

		$groups{$PREF{admin_group_name}}{name}		= $PREF{admin_group_name};
		$groups{$PREF{admin_group_name}}{id}		= -3;
		$groups{$PREF{admin_group_name}}{is_member}	= 1 if $user_id =~ /^-3$/;
	}

	return \%groups;
}


# BL, UB, VL
# This function must do a case-insensitive lookup (i.e. use LOWER() on both sides)
# so that we never create a username multiple times with different cases.
#
sub username_is_taken
{
	return 0 unless userbase_available();
	my $user = shift;
	check_username_for_sql_safeness($user);
	return enc_sql_select("SELECT COUNT(*) FROM `$PREF{user_table_name}` WHERE LOWER(`username`) = LOWER('$user')");
}


# UB, VL
sub ask_pw($$)
{
	my ($ask) = ($_[0] =~ /^(....)/);
	return $ask ? $ask : $_[0];
}


sub groupname_is_valid				{ return ($_[0] =~ /^[0-9A-Za-z_]+$/   &&   $_[0] =~ /^[A-Za-z]/	&&	length($_[0]) < $PREF{max_groupname_length});		} # FC, UB, VL
sub username_is_valid				{ return ($_[0] =~ /^[0-9A-Za-z_]+$/   &&   $_[0] =~ /^[A-Za-z]/	&&	$_[0] =~ /^....$/);					} # FC, UB, VL
sub hashedpw_is_valid				{ return ($_[0] =~ /^[0-9A-Za-z]+$/					&&	$_[0] =~ /^..?.?.?$/);					} # FC, UB, VL
sub sessionid_is_valid				{ return  $_[0] =~ /^[0-9A-Za-z]+$/					&&	length($_[0]) < $PREF{max_hashedpw_length};		} # FC, UB, VL


sub check_hashedpw_for_sql_safeness		{ die_nice("Invalid hashed password: '$_[0]'") unless hashedpw_is_valid($_[0]);								} # FC, UB, VL
sub check_username_for_sql_safeness		{ die_nice("Invalid username: '$_[0]'") unless username_is_valid($_[0]);								} # FC, UB, VL
sub check_groupname_for_sql_safeness		{ die_nice("Invalid groupname: '$_[0]'") unless groupname_is_valid($_[0]);								} # FC, UB, VL
sub check_sessionid_for_sql_safeness		{ die_nice("Invalid session ID: '$_[0]'") unless sessionid_is_valid($_[0]);								} # FC, UB, VL
sub check_id_for_sql_safeness			{ die_nice("Invalid ID: '$_[0]'") unless $_[0] =~ /^(\d+|-[123])$/;									} # FC, UB, VL