home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
rtsi.com
/
2014.01.www.rtsi.com.tar
/
www.rtsi.com
/
OS9
/
FAQ
/
discus_admin_1357211388
/
source
/
adm-menu.pl
< prev
next >
Wrap
Text File
|
2009-11-06
|
11KB
|
286 lines
# 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;