# FILE: adm-menu.pl
# DESCRIPTION: Administration login screen and main menu
#-------------------------------------------------------------------------------
# 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);

###
### MENU_admin
###
### Controls Main Menu and administration login screen
###

sub MENU_admin {
	my ($FORMref) = @_;
	my $timecache = time;
	dreq("template", "maintain");
	cleaning_jobs();
	my $subst = {};
	if ($FORMref->{'cmd'} eq "start") {
		my $username = defined $FORMref->{username} ? $FORMref->{username} : $FORMref->{COOKIE}->{admuser};
		my $result = check_password($username, undef, { type_required => "moderator" }, $FORMref->{COOKIE});
		my ($topic, $page) = split(/\//, $FORMref->{startfrom});
		my $gp = GetPage($topic, $page, { no_error => 1 });
		if ($gp->{head}->{me_number} == $page) {
			if (scalar @{$result} > 0) {
				dreq("fcn-priv");
				if (check_topic_authorization($result->[0]->{user}, $topic, undef)) {
					$subst->{general}->{screen} = "adminhere";
					($subst->{general}->{topic}, $subst->{general}->{page}) = split(/\//, $FORMref->{'startfrom'});
					$subst->{general}->{username} = $result->[0]->{user};
					screen_out("uimain", $subst);			
				}
			}
			$subst->{general}->{screen} = "admin";
			$subst->{'general'}->{'startfrom'} = $FORMref->{'startfrom'};
			screen_out("uimain", $subst);			
		} else {
			$subst->{'general'}->{'username'} = $FORMref->{COOKIE}->{admuser};
			screen_out("admlogin", $subst);
		}
	}	
	if ($FORMref->{'action'} eq "") {
		$subst->{'general'}->{'username'} = $FORMref->{COOKIE}->{admuser};
		$subst->{'general'}->{'startfrom'} = $FORMref->{startfrom};
		screen_out("admlogin", $subst);
	}
	if ($FORMref->{'action'} eq "qmenu") {
		my $result = check_password($FORMref->{COOKIE}->{admuser}, undef, { type_required => "moderator" }, $FORMref->{COOKIE});
		bad_login({ bad_menu_username => 1 }) if scalar(@{$result}) == 0;
		$subst->{general}->{username} = $result->[0]->{user};
		$subst->{general}->{is_superuser} = $result->[0]->{user} eq $DCONF->{superuser} ? 1 : 0;
		my ($successref, $failref) = update_admin_log($subst->{'general'}->{'username'}, $timecache);
		$successref->{'where'} = "?" if $successref->{'where'} eq "";
		$successref->{'date'} = "?" if $successref->{'date'} eq "";
		$subst->{'logdata'} = $successref;
		$subst->{'failures'} = $failref;
		$subst->{'general'}->{'failcount'} = scalar(@{ $failref });
		$DCONF->{html_url} =~ m|http://([^/]+)|i; my $html_host = $1;
		$DCONF->{script_url} =~ m|http://([^/]+)|i; my $script_host = $1;
		$subst->{'general'}->{'hostmatch'} = 1 if $html_host eq $script_host;
		if ($DCONF->{pro}) {
			dreq("selfreg-PRO","queue2-PRO");
			$subst->{'general'}->{'userqueue'} = scalar(@{count_queued_users($result->[0]->{user})});
			my $y = queue_moderator_list($result->[0]->{user});
			$subst->{'general'}->{'msgqueue'} = scalar(@{ $y });
		}
		screen_out("admmenu", $subst, undef);
	}
	if ($FORMref->{'action'} eq "menu") {
		my $timecache = time;
		my $flag = 0;
		$flag = 1 if $FORMref->{timetoken} > $timecache;
		$flag = 1 if (($timecache - $FORMref->{timetoken}) > (60 * $GLOBAL_OPTIONS->{mod_session_expire_inactivity}));
		if ($flag == 1 && $GLOBAL_OPTIONS->{mod_session_expire} == 1 && $GLOBAL_OPTIONS->{mod_session_expire_inactivity} > 0) {
			$subst->{'general'}->{'startfrom'} = $FORMref->{'startfrom'};
			$subst->{'general'}->{'username'} = $FORMref->{COOKIE}->{'admuser'};
			screen_out("admlogin", $subst);
		}		
		my $result = check_password($FORMref->{'username'}, $FORMref->{'password'}, { type_required => "moderator", nocookies => 1, blank_ok => 1 });
		if (scalar(@{$result}) == 0) {
			$FORMref->{username} = prepare_userpass($FORMref->{username});
			my @data = ("$FORMref->{username};$ENV{REMOTE_HOST};$ENV{REMOTE_ADDR};$timecache;WRONG\n");
			appendfile("$DCONF->{admin_dir}/adminlog.txt", \@data, "MENU_admin", undef);
			if ($DCONF->{pro} && ($GLOBAL_OPTIONS->{mod_fails} || $GLOBAL_OPTIONS->{mod_fails_mail})) {
				dreq("adm-msc-PRO");
				track_moderator_failure($FORMref);
			}	
			bad_login({ bad_menu_username => 1 });
		}
		$subst->{'general'}->{'username'} = $result->[0]->{'user'};
		$subst->{'general'}->{'is_superuser'} = 1 if $DCONF->{superuser} eq $subst->{'general'}->{'username'};
		my ($successref, $failref) = update_admin_log($subst->{'general'}->{'username'}, $timecache);
		$successref->{'where'} = "?" if $successref->{'where'} eq "";
		$successref->{'date'} = "?" if $successref->{'date'} eq "";
		$subst->{'logdata'} = $successref;
		$subst->{'failures'} = $failref;
		$subst->{'general'}->{'failcount'} = scalar(@{ $failref });
		my $version_upgrade = check_upgrade();
		if ($version_upgrade == 1) {
			$subst->{'general'}->{'url'} = "$PARAMS->{cgiurl}?action=pm-mgr_1&username=$result->[0]->{user}" if $FORMref->{'startfrom'} !~ m|^(\d+)/(\d+)$|;
			$subst->{'general'}->{'url'} = "$PARAMS->{cgiurl}?action=pm-page_editor&HTTP_REFERER=/$FORMref->{'startfrom'}&username=$result->[0]->{user}&menu=2" if $FORMref->{'startfrom'} =~ m|^(\d+)/(\d+)$|;
			if ($DCONF->{pro}) {
				dreq("selfreg-PRO","queue2-PRO");
				$subst->{'general'}->{'userqueue'} = scalar(@{count_queued_users($result->[0]->{user})});
				my $y = queue_moderator_list($result->[0]->{user});
				$subst->{'general'}->{'msgqueue'} = scalar(@{ $y });
			}
		} else {
			$subst->{'general'}->{'url'} = "$PARAMS->{cgiurl}?action=upgrade&username=$result->[0]->{user}";
			$subst->{general}->{upgrade} = 1;
			$subst->{general}->{upgrade} = 2 if $result->[0]->{user} eq $DCONF->{superuser};
			dreq("adm-opts");
			options_save({ maintenance => 2 }) if $GLOBAL_OPTIONS->{maintenance} == 0;
		}
		$DCONF->{html_url} =~ m|http://([^/]+)|i; my $html_host = $1;
		$DCONF->{script_url} =~ m|http://([^/]+)|i; my $script_host = $1;
		$subst->{'general'}->{'hostmatch'} = 1 if $html_host eq $script_host;
		if ($result->[0]->{'pass'} eq "") {
			$subst->{'general'}->{'first_pw'} = 1;
			$subst->{'general'}->{'url'} = "$PARAMS->{cgiurl}?action=first_pass&username=$result->[0]->{user}";
		}
		my $pass_challenge = crypt($result->[0]->{'pass'}, "cookie");
		my $COOKIE_STRING = "";
		$COOKIE_STRING .= cookie_string_format("admuser", $result->[0]->{user}, undef);
		$COOKIE_STRING .= cookie_string_format("pass", $pass_challenge, undef);
		screen_out("admmenu", $subst, $COOKIE_STRING);
	}
}

###
### update_admin_log
###
### Provides logging of successful or failed login attempts
###

sub update_admin_log {
	my ($USER_mod, $timecache) = @_;
	my $a = readfile("$DCONF->{admin_dir}/adminlog.txt", "MENU_admin", { no_unlock => 1, zero_ok => 1 });
	my $flc = 0;
	my @flc = ();
	undef my $successref;
	my @a = @{ $a };
	foreach my $line (@a) {
		if ($line =~ m|^$USER_mod;([^;]*);([^;]*);(\d+);(.*)|) {
			my ($rh, $ra, $dt, $ok) = ($1, $2, $3, $4);
			if ($ok !~ m|ok|) {
				$flc += 1;
				undef my $failref;
				$failref->{'date'} = (get_date_time('long', $dt))[0];
				$failref->{'where'} = "$rh [$ra]" if $rh ne "";
				$failref->{'where'} = "$ra" if $rh eq "";
				push (@flc, $failref);
			} else {
				$successref->{'date'} = get_date_time('short', $dt);
				$successref->{'where'} = "$rh [$ra]" if $rh ne "";
				$successref->{'where'} = "$ra" if $rh eq "";
			}
			$line = "";
		} elsif ($line =~ m|^;|) {
			$line = "";
		}
	}
	@a = grep(/\S/, @a);
	push (@a, "$USER_mod;$ENV{'REMOTE_HOST'};$ENV{'REMOTE_ADDR'};$timecache;ok\n");
	writefile("$DCONF->{admin_dir}/adminlog.txt", \@a, "MENU_admin", { no_lock => 1 });
	return ($successref, \@flc);
}

###
### check_upgrade
###
### Determines if you have upgraded your files to version 4.0
###

sub check_upgrade {
	my $x = check_first_install_serial();
	return $x if defined $x;
	if (-e "$DCONF->{admin_dir}/data/topicprv.txt") { # You have version 4.0 now
		append_serial();
		return 1;
	}
	my $t = board_topics(undef, undef, undef, 1);
	if (scalar(@{$t}) == 0) { # Fresh installation of version 4.0, first access
		append_serial();
		return 1;
	}
	if (-e "$DCONF->{admin_dir}/upgrade.txt") {
		# This was version 3.10
		return 0;  # Invoke automatic upgrade procedure
	} elsif (-e "$DCONF->{admin_dir}/posting.txt") {
		# This was version 3.00/3.01
		upgrade_error_message(1);
	} elsif (-e "$DCONF->{admin_dir}/frontpage_conf.txt") {
		# This was version 2.50
		upgrade_error_message(2);
	} elsif (-s "$DCONF->{admin_dir}/source/src-board-subs-common" > 6000) {
		# This was version 2.40
		upgrade_error_message(3);
	} else {
		# This was version 2.30 or before
		upgrade_error_message(4);
	}
}

###
### upgrade_error_message
###
### Kindly tells you that your version is too old to upgrade
###

sub upgrade_error_message {
	my ($code) = @_;
	my $subst = {};
	$subst->{general}->{upgrade} = 1;
	$subst->{general}->{code} = $code;
	screen_out("badlogin", $subst);	
}

###
### check_first_install_serial
###
### Checks the serial number from (version 4.0 or above)
###

sub check_first_install_serial {
	my ($result) = @_;
	if ($DCONF->{pro} && ! -e "$DCONF->{admin_dir}/data/pro.txt") {
		dreq("pro-init-PRO");
		create_discus_pro_files();
	}
	return undef if ! -e "$DCONF->{admin_dir}/data/serial.txt";
	my $u = readfile("$DCONF->{admin_dir}/data/serial.txt", "check_first_install_serial", { no_lock => 1, no_unlock => 1 });
	return parse_serial($u->[scalar(@{$u})-1], $result);
}

###
### parse_serial
###
### Checks to see if any supplemental upgrades are needed
###

sub parse_serial {
	my ($input, $result) = @_;
	chomp $input;
	my @inp = split(/\./, $input);
	my @inp_save = @inp;
	my $serial_compare = join(".", splice @inp, 0, 4);
	return 1 if $serial_compare eq $PARAMS->{serial};
	append_serial();
	my ($pro, $major, $minor, $revision) = @inp_save;
	#
	# If any upgrades are needed since the very first release of 4.0
	# they will appear here
	#
	return 1;	
}

###
### append_serial
###
### Writes version information into the serial file
###

sub append_serial {
	if (! -d "$DCONF->{admin_dir}/data") {
		unlink "$DCONF->{admin_dir}/data";
		mkdir("$DCONF->{admin_dir}/data", oct($DCONF->{perms0777}));
		chmod(oct($DCONF->{perms0777}), "$DCONF->{admin_dir}/data");
	}
	my @u = ( join("", join(".", $PARAMS->{serial}, time), "\n") );
	appendfile("$DCONF->{admin_dir}/data/serial.txt", \@u, "append_serial", { no_lock => 1, no_unlock => 1 });
}

1;
