home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
rtsi.com
/
2014.01.www.rtsi.com.tar
/
www.rtsi.com
/
OS9
/
FAQ
/
cgi-bin
/
discus4_00
/
source
/
adm-misc.pl
< prev
next >
Wrap
Text File
|
2009-11-06
|
15KB
|
400 lines
# 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 "backups" 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;