# FILE: authpass.pl
# DESCRIPTION: Authentication routines & read account files
#-------------------------------------------------------------------------------
# DISCUS COPYRIGHT NOTICE
#
# Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
# The use of Discus is governed by the Discus License Agreement which is
# available from the Discus WWW site at:
#    http://www.discusware.com/discus/license
#
# Pursuant to the Discus License Agreement, this copyright notice may not be
# removed or altered in any way.
#-------------------------------------------------------------------------------

use strict;
use vars qw($GLOBAL_OPTIONS $DCONF $PARAMS);

###
### check_password
###
### Checks a moderator or user's password against the database.  Default operation
### is to update the "last access" time but not the "last search" time.  Control
### these through $args->{silent} and $args->{new_message}, respectively.
###

sub check_password {
	my ($username, $guess, $args, $cookies) = @_;
	my $suspended = 0;
	$username = prepare_userpass($username);
	$guess = prepare_userpass_p($guess);
	my @result = ();
	return \@result if $username eq "";
	my $file = "passwd,users";
	$file = "passwd" if $args->{type_required} eq "moderator";
	$file = "users" if $args->{type_required} eq "user";
	performance_string("NOTE: Authentication of [$username :: $file] at check_password") if $GLOBAL_OPTIONS->{performance_monitoring};
	my $new_message = (defined $args->{new_message} ? 1 : 0);
	$new_message = 0 if defined $args->{silent};
	my $timecache = time;
	$username = $args->{authenticated} if $username eq "";
	my $fast_update = 1;
	if ($PARAMS->{'emergency_access'} && -e "$DCONF->{admin_dir}/data/emergency-fail.txt" && $DCONF->{superuser} eq $username) {
		dreq("emergpw");
		my $x = validate_emergency_password($guess, $cookies, $args);
		if ($x ne "") {
			$GLOBAL_OPTIONS->{database} = 0;
			return [ { database => 'passwd', user => $username, pass => $x } ];	
		}
	}	
	$GLOBAL_OPTIONS->{u_last_access_info} = 0 if ($DCONF->{pro} && $GLOBAL_OPTIONS->{database} == 1);
	$fast_update = 0 if ($guess eq "" && $GLOBAL_OPTIONS->{u_last_access_info} >= 1);
	$fast_update = 0 if ($cookies->{uid} ne "" && $GLOBAL_OPTIONS->{u_last_access_info} >= 2);
	$fast_update = 0 if ($new_message == 0 && $GLOBAL_OPTIONS->{u_last_access_info} >= 3);
	$fast_update = 1 if $new_message;
	$fast_update = 0 if ($args->{no_record} == 1);
	my ($u, $f);
	if ($PARAMS->{'emergency_access'}) {
		open (OUT, "> $DCONF->{admin_dir}/data/emergency-fail.txt");
		close (OUT);
	}	
	if ($fast_update) {
		($u, $f) = read_account_file($file, { $username => 1 }, { authenticate_password => 1, update_time => 1 - $args->{silent}, new_message => $args->{new_message}, no_lock => (1 - $fast_update), no_unlock => $fast_update, dbh => $args->{dbh}, fast_update => $fast_update });
	} else {
		($u, $f) = read_account_file($file, { $username => 1 }, { update_time => 1 - $args->{silent}, new_message => $args->{new_message}, no_lock => 1, no_unlock => 1, dbh => $args->{dbh}, fast_update => 0 });
	}
	if ($PARAMS->{'emergency_access'}) {
		unlink "$DCONF->{admin_dir}/data/emergency-fail.txt";
	}
	my $expired = 0;
	foreach my $x (@{ $u->{$username} }) {
		my $ok = 0;
		if ($args->{authenticated} eq $username) {
			$ok = 0;
		} else {
			my $pass = $x->{'pass'};
			if ($pass =~ /^\*.*?\|\|([^\*].*)$/) {
				$pass = $1;
			} elsif ($pass =~ m%^(.*?)\|\|(.*)$%) {
				my ($actual_pass, $temp_pass) = ($1, $2);
				$pass = $actual_pass;
				$pass = $' if $pass =~ m|^\*|;
			}
			$ok = 1 if crypt($guess, $pass) eq $pass;
			$ok = 0 if $pass eq "";
			$ok = 1 if $username eq $DCONF->{superuser} && $pass eq "" && $guess eq "" && $args->{blank_ok};
			if ($ok == 0 && $cookies->{pass} eq crypt($pass, "cookie") && ($guess eq "" || $guess eq "adminlogin")) {
				$ok = 1;
				if ($GLOBAL_OPTIONS->{mod_session_expire_inactivity} > 0 && $GLOBAL_OPTIONS->{mod_session_expire}) {
					if (60*$GLOBAL_OPTIONS->{mod_session_expire_inactivity} < ($timecache - $x->{atime})) {
						$expired = 1; $ok = 0;
					}
				}
			}
			$ok = 0 if $guess ne "" && $pass eq "";
			$ok = 1 if $cookies->{cpwd} eq crypt($pass, "cookie") && ! $args->{nocookies} && ($guess eq "" || $guess eq "adminlogin" || $guess =~ /^x+$/);
			$ok = 0 if $pass eq "" && $username ne $DCONF->{superuser};
			if ($PARAMS->{'emergency_access'} && $DCONF->{superuser} eq $username) {
				dreq("emergpw");
				my $xy = validate_emergency_password($guess, $cookies, $args);
				if ($xy ne "") {
					$ok = 1;
					$x->{pass} = $xy;
				}
			}	
			if ($ok == 1 && $x->{pass} =~ m|^\*|) {
				if ($DCONF->{pro} && ! $args->{no_dump} && $x->{pass} =~ m%^(.*?)\|\|(.*)%) {
					my ($actual_pass, $temp_pass) = ($1, $2);
					if ($actual_pass =~ m|^\*|) {
						my @u = split(/,/, $file);
						foreach my $u (@u) {
							unlock("$DCONF->{admin_dir}/$u.txt");
						}
						return (\@result, $x, $guess) if $args->{no_suspend};
						dreq("suspend-PRO");
						suspended_account($x, $guess);
					}
				}
			}
			$ok = 0 if ($cookies->{access} && ! $args->{skip_naughtyboy_cookie});
		}
		if ($ok == 1) {
			push (@result, \%{$x});
			fastupdate_account_file($f, $x->{user}, { database => $x->{database}, timecache => $timecache, new_message => $new_message, dbh => $args->{dbh} }) if $fast_update;
		}
	}
	if ($fast_update) {
		if ($GLOBAL_OPTIONS->{database} == 0 || ! $DCONF->{pro}) {
			fastupdate_kill($f);
		} else {
			dreq("sql-acct-PRO");
			sql_fast_update(\@result, { update_time => 1 - $args->{silent}, new_message => $args->{new_message}, no_lock => (1 - $fast_update), no_unlock => $fast_update, dbh => $args->{dbh}, fast_update => $fast_update });
		}
	}
	if (scalar(@result) == 0 && $expired == 1) {
		dreq("admin-pl");
		bad_login({session_expired => 1});
	}
	return \@result;
}

###
### condition_match
###
### Checks to see if a condition is met
###

sub condition_match {
	my ($rec, $condition) = @_;
	if (defined $condition->{suspend}) {
		my @g = ();
		if (ref $condition->{suspend} eq 'ARRAY') {
			@g = @{$condition->{suspend}};
		} elsif (ref $condition->{suspend} eq 'HASH') {
			@g = keys %{$condition->{suspend}};
		} else {
			@g = ( $condition->{suspend} );
		}
		@g = map { quotemeta($_) } @g;
		foreach my $pat (@g) {
			return 0 if $rec->{pass} !~ m%^\*.*\|\|$pat%;
		}
	}
	if (defined $condition->{nosuspend}) {
		my @g = ();
		if (ref $condition->{nosuspend} eq 'ARRAY') {
			@g = @{$condition->{nosuspend}};
		} elsif (ref $condition->{nosuspend} eq 'HASH') {
			@g = keys %{$condition->{nosuspend}};
		} else {
			@g = ( $condition->{nosuspend} );
		}
		@g = map { quotemeta($_) } @g;
		foreach my $pat (@g) {
			return 0 if $rec->{pass} =~ m%^\*.*\|\|$pat%;
		}
	}
	if (defined $condition->{group}) {
		my @g = ref $condition->{group} eq 'ARRAY' ? @{$condition->{group}} : ($condition->{group});
		my %x = map { $_, 1 } grep { /\S/ } split(/\//, $rec->{groups});
		my $flag = 0;
		foreach my $g (@g) {
			if ($x{$g->{group}} == 1) {
				$flag = 1; last;
			}
		}
		return 0 if $flag == 0;
	}
	return 1;
}

###
### grab_fields
###
### Gets desired fields from account query
###

sub grab_fields {
	my ($record_in, $param_ref) = @_;
	return $record_in if ref $param_ref->{return_fields} ne 'HASH';
	my %z = map { $_, $record_in->{$_} } keys %{$param_ref->{return_fields}};
	return \%z;
}

###
### read_account_file
###
### Reads in users.txt, passwd.txt, or the database and returns selected users
### or all users in a convenient format.  Use of this routine to read the user
### base makes the rest of the functions independent of whether you are using
### the MySQL back end, flat text files, or separated text files.
###

sub read_account_file {
	my ($database, $username_ref, $param_ref) = @_;
	undef my $result;
	$PARAMS->{dbh} = database_dbh();
	my $fast_update = {};
	$param_ref->{returnformat} = "standard" if $param_ref->{returnformat} eq "";
	if ($GLOBAL_OPTIONS->{database} == 1 && $DCONF->{pro}) {
		dreq("sql-acct-PRO");
		return sql_read_account_file($database, $username_ref, $param_ref);
	} else {
		my @files = ();
		if ($DCONF->{pro} && $GLOBAL_OPTIONS->{split_user_files} && $database =~ m|users|) {
			dreq("userfile-PRO");
			@files = userfile_build_list($database, $username_ref);
		} else {
			my @f = split(/,/, $database);
			foreach my $l (@f) {
				push (@files, "$DCONF->{admin_dir}/$l.txt");
			}
		}
		foreach my $file (@files) {
			my $data = undef;
			my $tellresult = undef;
			my $db_read = ($file =~ m|passwd| ? "passwd" : "users");
			$data = readfile($file, "read_account_file", { no_lock => $param_ref->{no_lock}, no_unlock => $param_ref->{no_unlock}, zero_ok => 1, create => 1, 'tell' => 0 }) if ! $param_ref->{fast_update};
			($data, $tellresult) = readfile($file, "read_account_file", { no_unlock => 1, zero_ok => 1, create => 1, 'tell' => 1 }) if $param_ref->{fast_update};
			my $w = 0;
W:			while (my $k = shift @{ $data }) {
				my @k = split(/:/, $k, 2);
				next if $k[0] eq "#";
				my $teller = defined $tellresult ? shift @{ $tellresult } : undef;
				if (defined $username_ref) {
					next W if ! $username_ref->{$k[0]};
				}
				my $ref = user_line_as_hash($k);
				next W if $ref->{user} eq "DISABLEANON";
				next W if $ref->{user} eq "UPDATED300";
				next W if $ref->{user} eq "PUBLIC";
				if (defined $param_ref->{condition}) {
					next W if ! condition_match($ref, $param_ref->{condition});
				}
				$ref->{database} = $db_read;
				push (@{ $result->{ $ref->{user} } }, \%{ $ref }) if $param_ref->{returnformat} eq "standard";
				$result->{ $ref->{user} } = \%{ $ref } if $param_ref->{returnformat} eq "single_hash";
				push (@{ $result }, \%{ $ref }) if $param_ref->{returnformat} eq "single_array";
				if ($param_ref->{fast_update}) {
					my $l = undef;
					if (defined $fast_update->{$ref->{user}}->{file}) {
						if (ref $fast_update->{$ref->{user}}->{file} eq 'ARRAY') {
							my @i = @{$fast_update->{$ref->{user}}->{file}};
							push @i, $file;
							$l->{file} = \@i;
						} else {
							my @i = ($fast_update->{$ref->{user}}->{file});
							push @i, $file;
							$l->{file} = \@i;
						}
					} else {
						$l->{file} = $file;
					}
					if (defined $fast_update->{$ref->{user}}->{position}) {
						if (ref $fast_update->{$ref->{user}}->{position} eq 'ARRAY') {
							my @i = @{$fast_update->{$ref->{user}}->{position}};
							push @i, $teller;
							$l->{position} = \@i;
						} else {
							my @i = ($fast_update->{$ref->{user}}->{position});
							push @i, $teller;
							$l->{position} = \@i;
						}
					} else {
						$l->{position} = $teller;
					}
					if (defined $fast_update->{$ref->{user}}->{uline}) {
						if (ref $fast_update->{$ref->{user}}->{uline} eq 'ARRAY') {
							my @i = @{$fast_update->{$ref->{user}}->{uline}};
							push @i, $k;
							$l->{uline} = \@i;
						} else {
							my @i = ($fast_update->{$ref->{user}}->{uline});
							push @i, $k;
							$l->{uline} = \@i;
						}
					} else {
						$l->{uline} = $k;
					}
					$fast_update->{$ref->{user}} = $l;
					$w++;
				}
			}
			if ($w == 0) {
				unlock($file) if $param_ref->{fast_update};
			}
		}
		return $result if ! $param_ref->{fast_update};
		return ($result, $fast_update);
	}
}

###
### user_line_as_hash
###
### Converts a line of raw input to a useful, easy manipulated hash
###

sub user_line_as_hash {
	my @r = ();
	my @s = ('user', 'pass', 'email', 'fullname', 'edit', 'notify', 'ctime', 'stime', 'atime', 'groups');
	my $ss = scalar(@s);
	while (my $x = shift) {
		chomp $x;
		my @x = split(/:/, $x, $ss);
		my @stemp = @s;
		undef my $i;
		while (my $s = shift @s) {
			$i->{$s} = shift @x;
			$i->{$s} = "" if $s eq "email" && $i->{$s} eq "email";
			$i->{$s} = "" if $s eq "fullname" && $i->{$s} eq "fullname";
		}
		if ($i->{stime} =~ /\D/) {
			$i->{ip_addr} = $i->{stime}; $i->{stime} = 0;
		}
		if ($i->{atime} =~ /\D/) {
			$i->{ip_host} = $i->{atime}; $i->{atime} = 0;
		}
		$i->{ctime} = $' if $i->{ctime} =~ /.*\D/;
		push (@r, $i);
	}
	return $r[0] if scalar(@r) == 1;
	return \@r;
}

###
### generate_user_line
###
### Inverse of user_line_as_hash; turns a hash into a line to write into users.txt, etc.
###

sub generate_user_line {
	my ($hashref) = @_;
	my @s = ('user', 'pass', 'email', 'fullname', 'edit', 'notify', 'ctime', 'stime', 'atime', 'groups');
	my @r = ();
	foreach my $s (@s) {
		push (@r, $hashref->{$s});
	}
	return join("", join(":", @r), "\n");
}

###
### prepare_userpass
###
### Removes certain non-alphanumeric characters and converts to lower case
###

sub prepare_userpass {
	my @out = ();
	my $z = chr(0);
	my $y = quotemeta(chr(47));
	my $w = quotemeta(chr(58));
	my $v = quotemeta(chr(94));
	my $u = quotemeta(chr(96));
	my $t = quotemeta(chr(123));
	my $s = quotemeta(chr(125));
	while (my $x = shift @_) {
		$x =~ s/^\s+//;
		$x =~ s/\s+$//;
		$x = case_lower($x);
		$x =~ s/\s+/_/g;
		$x =~ s/[$z-$y$w-$v$u$t-$s]//g;
		push (@out, $x);
	}
	return @out if scalar(@out) > 1;
	return $out[0] if scalar(@out) <= 1;
}

###
### prepare_userpass_p
###
### Password version of 'prepare_userpass_p' which recognizes an option
### to SKIP the conversion of the username to lower-case letters
###

sub prepare_userpass_p {
	my @out = @_;
	if ($GLOBAL_OPTIONS->{password_no_prepare}) {
		return $out[0] if scalar @out <= 1;
		return @out;
	}
	return prepare_userpass(@out);
}

###
### lpad
###
### Pads a string on the left with a given character so that the string will
### always have the correct length.  Used for fixed-width fields.
###

sub lpad {
	my ($st, $ch, $len) = @_;
	if (length($st) < $len) {
		return join("", $ch x ($len - length($st)), $st);
	} elsif ($len > $ch) {
		return substr($st, 0, $len);
	} else {
		return $st;
	}
}

###
### userpass_field_dump
###
### Names of the fields in the user database
###

sub userpass_field_dump {
	my $string = "user pass email fullname edit notify ctime stime atime groups picture";
	$string .= " prefs favorites signature status posts ";
	for (my $i = 1; $i <= 20; $i++) {
		$string .= "personal$i\n";
	}
	for (my $i = 1; $i <= 10; $i++) {
		$string .= "custom$i\n";
		$string .= "customdesc$i\n";
	}
	my @fields = split(/\s+/, $string);
	@fields = grep(/\S/, @fields);
	return \@fields;
}

###
### fastupdate_kill
###
### Called when there is no more fast updating to be done.
###

sub fastupdate_kill {
	my ($fastupdate) = @_;
	if ($GLOBAL_OPTIONS->{database} == 1 && $DCONF->{pro}) {
		my $dbh = $fastupdate->{dbh};
		return 0 if ! defined $dbh;
		return 1;
	} else {
		my $unlocked = undef;
		foreach my $k (keys(%{ $fastupdate })) {
			my @f = ref $fastupdate->{$k}->{file} eq 'ARRAY' ? @{$fastupdate->{$k}->{file}} : ($fastupdate->{$k}->{file});
			foreach my $fi (@f) {
				next if $unlocked->{$fi};
				unlock($fi);
				$unlocked->{$fi} = 1;
			}
		}
	}
}

###
### fastupdate_account_file
###
### Performs a fast update of the account file to set the last access time of
### a moderator or user.
###

sub fastupdate_account_file {
	my ($fastupdate, $user, $params) = @_;
	return 0 if $params->{database} eq "";
	return 0 if ($GLOBAL_OPTIONS->{no_update_access_time} && ! $params->{new_message});
	return 0 if ($GLOBAL_OPTIONS->{database} && $DCONF->{pro});
	my $timecache = defined $params->{timecache} ? $params->{timecache} : time;
	if (ref $fastupdate->{$user}->{file} eq 'ARRAY') {
		my @fi = @{ $fastupdate->{$user}->{file} };
		my @ul = @{ $fastupdate->{$user}->{uline} };
		my @ps = @{ $fastupdate->{$user}->{position} };
		foreach my $fi (@fi) {
			my $o = {};
			$o->{file} = $fi;
			$o->{uline} = shift @ul;
			$o->{position} = shift @ps;
			next if $fi =~ /users\.txt/ && $params->{database} ne "users";
			next if $fi =~ /passwd\.txt/ && $params->{database} ne "passwd";
			_fastupd($fi, $o, $timecache, $params);
		}
	} else {
		_fastupd($fastupdate->{$user}->{file}, $fastupdate->{$user}, $timecache, $params);
	}
}

sub _fastupd {
	my ($fi, $fu, $timecache, $params) = @_;
	my $ref = user_line_as_hash($fu->{uline});
	$ref->{atime} = lpad($timecache, "0", 10);
	$ref->{stime} = lpad($timecache, "0", 10) if $params->{new_message};
	my $linenew = generate_user_line($ref);
	if (length $fu->{uline} == length $linenew && can_seek_tell()) {
		sysopen FASTUPDATE, $fi, 2;
		seek FASTUPDATE, $fu->{position}, 0;
		syswrite FASTUPDATE, $linenew, length($linenew);
		close FASTUPDATE;
	} else {
		$ref->{action} = "update";
		dreq("fcn-acct");
		write_account_file($params->{database}, [ $ref ], { fastupdate => 1 });
	}
	performance_string("> fastupdate_account_file for $ref->{user}, $fu->{position}, $fi");
	$PARAMS->{file_access}->{$fi}->{write}++;
	$PARAMS->{files_written}++;
	$PARAMS->{file_access}->{$fi}->{read} += 0;
}

###
### can_seek_tell
###
### Checks to see if the seek/tell routine can be used for fast updates
### Note (4.00.b26+): due to many problems with this routine, we are disabling
### it by default.  To enable, add "can_seek_tell=1" to your discus.conf file,
### without the quotes.
###

sub can_seek_tell {
	return 0 if ! defined $DCONF->{can_seek_tell};
	return $DCONF->{can_seek_tell};

	return $PARAMS->{can_seek_tell} if defined $PARAMS->{can_seek_tell};
	return $DCONF->{can_seek_tell} if defined $DCONF->{can_seek_tell};
	return 0 if $DCONF->{NT} || $DCONF->{platform} eq "NT";
	return 0 if $^O eq "MSWin32";
	my $checksum = 0;
	foreach my $k (keys %{$DCONF}) {
		$checksum += unpack("%16C*", $DCONF->{$k});
	}
	my $cst = join("_", $checksum, "can_seek_tell");
	if (defined $GLOBAL_OPTIONS->{$cst}) {
		$PARAMS->{can_seek_tell} = $GLOBAL_OPTIONS->{$cst};
	} else {
		dreq("adm-misc", "adm-opts");
		my $can = test_seek_tell();
		options_save({ $cst => $can });
		$PARAMS->{can_seek_tell} = $can;
	}
}

1;
