# FILE: adm-misc.pl
# DESCRIPTION: Miscellaneous Administration Subroutines
#-------------------------------------------------------------------------------
# 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 $PARAMS $DCONF);

###
### MISC_admin
###
### Run miscellaneous features (color wheel, log out, version manager,
### quota utility, initial administration password)
###

sub MISC_admin {
	my ($FORMref) = @_;
	undef my $subst;
	undef my $args;
	$subst->{'general'}->{'menu'} = $FORMref->{'menu'};
	if ($FORMref->{'action'} =~ /^taskman-(\w+)$/) {
		if ($1 eq "kill") {
			unlink "$DCONF->{admin_dir}/data/dtaskman.pid";
			unlink "$DCONF->{admin_dir}/data/schedule.pid";
		} elsif ($1 eq "start") {
			dreq("dtaskman");
			unlink "$DCONF->{admin_dir}/data/dtaskman.pid";
			unlink "$DCONF->{admin_dir}/data/schedule.pid";
			sleep 2;
			taskman_init();
		}
		$subst->{general}->{op} = $1;
		screen_out("tmansucc", $subst);	
	}
	if ($FORMref->{'action'} eq "color") {
		$subst->{'general'}->{'formname'} =	$FORMref->{formname};
		$subst->{'general'}->{'field'} =	$FORMref->{field};
		$subst->{'general'}->{'context'} =	$FORMref->{context};
		$subst->{'general'}->{'forwhat'} =	$FORMref->{forwhat};
		undef my @carr;
		undef my @aarr;
		undef my @barr;
		foreach my $x ("0","3","6","9","c","f") {
			push (@aarr, { color => "$x$x"} );
		}
		foreach my $x ("0","3","6","9","c","f") {
			foreach my $y ("0","3","6","9","c","f") {
				push (@barr, { color => "$x$x$y$y"} );
			}
		}
		$subst->{'aarr'} = \@aarr;
		$subst->{'barr'} = \@barr;
		screen_out("colorwhl", $subst);
	}
	if ($FORMref->{'action'} eq "logout") {
		undef my $cookie_out;
		foreach my $cookie (keys(%{$FORMref->{COOKIE}})) {
			next if $cookie eq "lastvisit";
			next if $cookie eq "offset";
			next if $cookie eq "lastsession";
			$cookie_out .= cookie_string_format($cookie, "undef", "Wednesday, 16-Aug-2000 00:00:00 GMT");
		}
		if ($FORMref->{COOKIE}->{uid} =~ m|^([\d\-]+)$|) {
			unlink "$DCONF->{admin_dir}/data/tokens/$FORMref->{COOKIE}->{uid}.txt";
		}
		screen_out("logout", undef, $cookie_out);
	}
	if ($FORMref->{'action'} eq "version_mgr") {
		my $result = check_password($FORMref->{username}, undef, { type_required => 'moderator' }, $FORMref->{'COOKIE'});
		bad_login( { bad_username => 1 } ) if scalar(@{ $result }) == 0;
		bad_login( { superuser_required => 1 } ) if $result->[0]->{user} ne $DCONF->{superuser};
		version_manager($FORMref, $subst, $result);
	}
	if ($FORMref->{'action'} eq "quotaon") {
		my $result = check_password($FORMref->{username}, undef, { type_required => 'moderator' }, $FORMref->{'COOKIE'});
		bad_login( { bad_username => 1 } ) if scalar(@{ $result }) == 0;
		bad_login( { superuser_required => 1 } ) if $result->[0]->{user} ne $DCONF->{superuser};
		unlink("$DCONF->{admin_dir}/backups/QUOTA.txt") || error_message("Enable Error", "Could not remove file QUOTA.txt from your &quot;backups&quot; directory!");
		$FORMref->{action} = "quota";
		$FORMref->{menu} = 0;
	}
	if ($FORMref->{'action'} eq "quotatest") {
		my $result = check_password($FORMref->{username}, undef, { type_required => 'moderator' }, $FORMref->{'COOKIE'});
		bad_login( { bad_username => 1 } ) if scalar(@{ $result }) == 0;
		bad_login( { superuser_required => 1 } ) if $result->[0]->{user} ne $DCONF->{superuser};
		my $filename = "$DCONF->{admin_dir}/backups/quotatest-file";
		if (-e "$filename") {
			unlink($filename) || error_message("Quota test error", "Test file <B>$filename</B> exists!  Please remove this file before proceeding.");
		}
		my $time = time;
		my $quota_exists = 0;
		if (!-e "$DCONF->{admin_dir}/backups/QUOTA.txt") {
			open (SAFEGUARD, ">$DCONF->{admin_dir}/backups/QUOTA.txt");
			print SAFEGUARD "$time\nShut+down+for+quota+testing\n";
			close (SAFEGUARD);
		} else {
			$quota_exists = 1;
		}
		my $bytepattern = "x" x 10000;
		my $sized = $FORMref->{'size'}; $sized =~ s/\D//g;
		undef my $subst;
		$subst->{'result'}->{'sizereq'} = $sized;
		error_message("Invalid size") if ($sized < 1 || $sized > 50);
		my $sizeflag = 0;
		undef $!;
		for (my $size = 1; $size <= 1000000*$sized; $size += 10000) {
			if (open (FILE, ">>$filename")) {
				print FILE $bytepattern;
				close (FILE);
				if (-s $filename < $size) {
					$sizeflag = 1;
					$subst->{'result'}->{'achieved'} = int((-s $filename) / 1000) / 1000;
					last;
				}
			} else {
				$subst->{'result'}->{'achieved'} = int((-s $filename) / 1000) / 1000;
				$sizeflag = 1;
				$subst->{'result'}->{'explanation'} = $!;
			}
		}
		$subst->{'result'}->{'sizeflag'} = $sizeflag;
		$subst->{'result'}->{'explanation'} = $!;
		if (!$quota_exists) {
			if (!unlink("$DCONF->{admin_dir}/backups/QUOTA.txt")) {
				$subst->{'result'}->{'warn'} = 1;
			}
		}
		if (-e $filename) {
			if (!unlink("$filename")) {
				$subst->{'result'}->{'stillthere'} = 1;
			}
		}
		$subst->{'general'}->{'username'} = $FORMref->{'username'};
		$subst->{'general'}->{'url'} = "$PARAMS->{cgiurl}?action=quota&username=$FORMref->{username}";
		screen_out("quotatst", $subst);
	}
	if ($FORMref->{'action'} eq "quota") {
		my $result = check_password($FORMref->{username}, undef, { type_required => 'moderator' }, $FORMref->{'COOKIE'});
		bad_login( { bad_username => 1 } ) if scalar(@{ $result }) == 0;
		bad_login( { superuser_required => 1 } ) if $result->[0]->{user} ne $DCONF->{superuser};
		$subst->{'general'}->{'username'} = $result->[0]->{'user'};
		$subst->{'general'}->{'url'} = "$PARAMS->{cgiurl}?action=quota&username=$FORMref->{username}";
		if ($PARAMS->{do_not_write_files}) {
			$subst->{'event'}->{'isevent'} = 1;
			if (open (ADMIN, "$DCONF->{admin_dir}/backups/QUOTA.txt")) {
				my @admin = <ADMIN>;
				close (ADMIN);
				my $date = $admin[0]; chomp $date;
				$subst->{'event'}->{'errdate'} = &get_date_time("long", $date);
				$subst->{'event'}->{'description'} = &unescape($admin[1]);
			} else {
				$subst->{'event'}->{'isevent'} = 0;
			}
		} else {
			$subst->{'event'}->{'isevent'} = 0;
		}
		if ($subst->{'general'}->{'menu'} == 0) {
			my @dirs = ($DCONF->{admin_dir}, "$DCONF->{admin_dir}/source", "$DCONF->{admin_dir}/backups", "$DCONF->{admin_dir}/secure", "$DCONF->{admin_dir}/profiles", "$DCONF->{admin_dir}/msg_index");
			push (@dirs, "$DCONF->{html_dir}", "$DCONF->{html_dir}/$DCONF->{icon_dir}", "$DCONF->{html_dir}/clipart", "$DCONF->{script_dir}");
			opendir (DIR, "$DCONF->{message_dir}");
			while (my $dir = readdir(DIR)) {
				next if $dir !~ m|^\d+$|;
				push (@dirs, "$DCONF->{message_dir}/$dir");
			}
			closedir(DIR);
			opendir (DIR, "$DCONF->{secdir}");
			while (my $dir2 = readdir(DIR)) {
				next if $dir2 !~ m|^\d+$|;
				push (@dirs, "$DCONF->{secdir}/$dir2");
			}
			closedir(DIR);
			undef my @lgfiles;
			foreach my $dirname (@dirs) {
				opendir(DIR, $dirname);
				while (my $dirf = readdir(DIR)) {
					my $s = -s "$dirname/$dirf";
					if ($s > 1000000) {
						undef my $hashref;
						$hashref->{'filename'} = "$dirname/$dirf";
						$hashref->{'filesize'} = int($s / 1000);
						push (@lgfiles, $hashref);
					}
				}
				closedir(DIR);
			}
			$subst->{'lgfile'}->{'count'} = scalar(@lgfiles);
			$subst->{'lgfiles'} = \@lgfiles;
		}
		if ($subst->{general}->{menu} == 1) {
			foreach my $ind ('locks', 'backups') {
				if (open(FILE, "> $DCONF->{admin_dir}/$ind/testfile")) {
					close (FILE);
					if (unlink("$DCONF->{admin_dir}/$ind/testfile")) {
						$subst->{tests}->{$ind} = "";
						if (-e "$DCONF->{admin_dir}/$ind/testfile") {
							$subst->{tests}->{$ind} = "File still exists after removal!";
						}
					} else {
						$subst->{tests}->{$ind} = "System error: $!";
					}
				} else {
					$subst->{tests}->{$ind} = "Couldn't create: $!";
				}
			}
		}
		screen_out("quota", $subst);
	}
	if ($FORMref->{'action'} eq "first_pass") {
		my $result = check_password($FORMref->{username}, $FORMref->{password}, { type_required => 'moderator', no_cookies => 1, blank_ok => 1 });
		bad_login( { bad_username => 1 } ) if scalar(@{ $result }) == 0;
		bad_login( { superuser_required => 1 } ) if $result->[0]->{user} ne $DCONF->{superuser};
		if ((@{$result})[0]->{'pass'} eq "") {
			$subst->{'general'}->{'username'} = $result->[0]->{'user'};
			$subst->{'general'}->{'firstreg'} = ($result->[0]->{email} eq "email" || $result->[0]->{email} eq "") ? 1 : 0;
			$subst->{'sugg'}->{'email'} = $1 if $DCONF->{contact} =~ /<a href="?mailto:(.*?)"?>/i;
			$subst->{'sugg'}->{'fullname'} = $2 if $DCONF->{contact} =~ m%<a href="?mailto:(.*?)"?>(.*?)</a>%i;
			screen_out("adm1pass", $subst);
		} else {
			bad_login( { bad_username => 1 } );
		}
	}
	if ($FORMref->{'action'} eq "firstpass") {
		my $result = check_password($FORMref->{username}, $FORMref->{password}, { type_required => 'moderator', no_cookies => 1, blank_ok => 1 });
		bad_login( { bad_username => 1 } ) if scalar(@{ $result }) == 0;
		bad_login( { superuser_required => 1 } ) if $result->[0]->{user} ne $DCONF->{superuser};
		bad_login( { bad_username => 1 } ) if $result->[0]->{pass} ne "";
		my ($pass1, $pass2) = prepare_userpass_p($FORMref->{pass1}, $FORMref->{pass2});
		error_message(read_language()->{PROFILE_CHPASS_ERROR}, read_language()->{PROFILE_CHPASS_ERROR_MATCH}, 0, 1) if $pass1 ne $pass2;
		error_message(read_language()->{PROFILE_CHPASS_ERROR}, read_language()->{PROFILE_CHPASS_ERROR_LENGTH}, 0, 1) if length($pass2) < 1;
		my $ctime = ($result->[0]->{ctime} == 0 ? lpad(time, "0", 10) : $result->[0]->{ctime});
		my $atime = time;
		dreq("fcn-acct");
		my $email = ( $result->[0]->{email} eq "" ? $FORMref->{email} : $result->[0]->{email} );
		my $fullname = ( $result->[0]->{fullname} eq "" ? $FORMref->{fullname} : $result->[0]->{fullname} );
		my ($s, $f) = update_account({ ctime => $ctime, user => $result->[0]->{user}, new_password => $pass1, email => $email, fullname => $fullname }, "passwd", undef);
		dreq("adm-menu", "topic-pg");
		regenerate_topic_page();
		append_serial();
		if ($DCONF->{pro}) {
			dreq("fcn-prfl-PRO");
			my $prfl = get_enhanced_profile('passwd', $DCONF->{superuser});
			if (ref $prfl ne 'ARRAY' || scalar @{$prfl} == 0) {
				my @a = ();
				my $u = {};
				$u->{username} = $DCONF->{superuser};
				$u->{database} = 'passwd';
				my %j = map { $_, 1 } split(//, $GLOBAL_OPTIONS->{default_prefs}); $u->{pref} = \%j;
				$u->{status} = 10;
				push @a, $u;	
				update_enhanced_profile_file(\@a);
			}
		}
		if (scalar(@{ $s }) == 1) {
			my $subst = {};
			$subst->{'general'}->{'skipreg'} = $FORMref->{'skipreg'};
			$subst->{'general'}->{'email'} = $FORMref->{'email'};
			$subst->{'general'}->{'name'} =  $FORMref->{'fullname'};
			screen_out("register", $subst);
		}
	}
}

###
### test_seek_tell
###
### Sees if your operating system will properly support fast-update of account info
###

sub test_seek_tell {
	my $testfile = "$DCONF->{admin_dir}/data/testseektell.txt";
	my $teststr = "123456789012345678901234567890\n";
	if (open (TESTFILE, "> $testfile")) {
		print TESTFILE $teststr;
		close (TESTFILE);
		chmod (oct($DCONF->{perms0666}), $testfile);
		sysopen FASTUPDATE, $testfile, 2;
		seek FASTUPDATE, 10, 0;
		syswrite FASTUPDATE, "ABCDEFGHIJ", 10;
		close FASTUPDATE;
		open (TESTFILE, "< $testfile");
		my @tf = <TESTFILE>;
		close (TESTFILE);
		unlink $testfile;
		return 1 if $tf[0] eq "1234567890ABCDEFGHIJ1234567890\n";
		return 0;
	} else {
		error_message("Test seek/tell error", "Could not write to file $testfile");
	}
}

###
### version_manager
###
### Version Manager screen
###

sub version_manager {
	my ($FORMref, $subst, $result) = @_;
	if ($GLOBAL_OPTIONS->{version_nocontact} != 1 && $FORMref->{menu} == 0) {
		my $result = eval '
			my ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname("www.discusware.com");
			my $discusware_ip = defined $addrs[0] ? sprintf "%d.%d.%d.%d", unpack("C4",$addrs[0]) : "208.171.52.98";
			use IO::Socket;
			my $sock = IO::Socket::INET->new( Proto => "tcp", PeerAddr => $discusware_ip, PeerPort => 1897 );
			undef if ! defined $sock;
			$sock->autoflush(1);
			print $sock join("\t" => $PARAMS->{serial}, $DCONF->{pro_license}, join("", $DCONF->{script_url}, "/", "discus.", $DCONF->{cgi_extension}), "\015\012");
			my $buf = "";
			my $n;
			1 while $n = sysread($sock, $buf, 8*1024, length($buf));
			undef unless defined($n);
			$buf;
		';
		if ($@) {
			log_error("adm-misc.pl", "version_manager", "Error connecting to DiscusWare version server: \$\@=$@, \$\!=$!") if $@ ne "";
		}
		$result =~ s/\r\n$//;
		($subst->{'vminfo'}->{'update'}, $subst->{'vminfo'}->{'latest'}, $subst->{'vminfo'}->{'urgent_notice'}) = split(/:/, $result);
		if ($subst->{'vminfo'}->{'update'} == 5) {
			dreq("adm-opts"); options_save( { wfstjpo_wfsjgz => 1, TRANSLATE_NAME => 1 } );
		} elsif ($subst->{'vminfo'}->{'update'} <= 3 && $subst->{'vminfo'}->{'update'} >= 1) {
			dreq("adm-opts"); options_save( { wfstjpo_wfsjgz => 0, TRANSLATE_NAME => 1 } );
		}
	} else {
		$subst->{'vminfo'}->{'update'} = -1;
		$subst->{'vminfo'}->{'latest'} = "";
		$subst->{'vminfo'}->{'urgent_notice'} = "";
	}
	$subst->{'general'}->{'username'} = $result->[0]->{'user'};
	$subst->{'general'}->{'url'} = "$PARAMS->{cgiurl}?action=version_mgr&username=$result->[0]->{user}";
	$subst->{'general'}->{'version'} = join(".", $PARAMS->{release}, $PARAMS->{revision});
	if ($FORMref->{menu} == 1) {
		my @file = ();
		if (open(FILE, "$DCONF->{script_dir}/board-contact.$DCONF->{cgi_extension}")) {
			@file = <FILE>;
			close (FILE);
		} elsif (open(FILE, "./board-contact.$DCONF->{cgi_extension}")) {
			@file = <FILE>;
			close (FILE);
		} elsif (-e "/usr/local/bin/perl") {
			@file = ('/usr/local/bin/perl');
		} else {
			@file = ('/usr/bin/perl');
		}
		my $x = $file[0];
		$x =~ s/^#!//;
		$x =~ s/\s+$//;
		$subst->{'upgradeinfo'}->{'pathperl'} = $x;
		if (open(DC, "$DCONF->{admin_dir}/discus.conf")) {
			my @dc = <DC>;
			close (DC);
			$subst->{'upgradeinfo'}->{'discusconf'} = escape(join("", @dc));
		}
		if (-e "$DCONF->{admin_dir}/patch.txt") {
			my $J = readfile("$DCONF->{admin_dir}/patch.txt", "version_manager", { no_lock => 1, no_unlock => 1, zero_ok => 1 });
			my $v = shift @{ $J };
			$subst->{patch}->{used} = 1;
			($subst->{patch}->{olds}, $subst->{patch}->{news}, $subst->{patch}->{oldv}, $subst->{patch}->{newv}) = split(/\s+/, $v);
			my @cs = ();
			foreach my $file (@{$J}) {
				my ($path, $checksum) = split(/\t/, $file);
				next if $file =~ m%^/\./%;
				my $X = readfile_binary($path);
				my $i = {};
				$i->{file} = $path;
				$i->{shortfile} = $' if $path =~ /.*\//;
				if (! defined $X) {
					$i->{error} = 1;
				} else {
					my @j = stat $path;
					$i->{size} = $j[7];
					$i->{mtime} = $j[9];
					if ($checksum != unpack("%16C*", $X)) {
						$i->{error} = 2;
					}
				}
				push @cs, $i;
			}
			@cs = sort {$a->{file} cmp $b->{file}} @cs;
			$subst->{patcharr} = \@cs;
		}
	}
	$subst->{general}->{menu} = $FORMref->{menu};
	dreq("topic-pg");
	bless $subst;
	$subst->topic_page_board_info(board_topics(undef, undef, undef, 1, 1));
	screen_out("version", $subst);
}

1;
