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-misc.pl < prev    next >
Text File  |  2009-11-06  |  15KB  |  400 lines
  1. # FILE: adm-misc.pl
  2. # DESCRIPTION: Miscellaneous Administration Subroutines
  3. #-------------------------------------------------------------------------------
  4. # DISCUS COPYRIGHT NOTICE
  5. #
  6. # Discus is copyright (c) 2002 by DiscusWare, LLC, all rights reserved.
  7. # The use of Discus is governed by the Discus License Agreement which is
  8. # available from the Discus WWW site at:
  9. #    http://www.discusware.com/discus/license
  10. #
  11. # Pursuant to the Discus License Agreement, this copyright notice may not be
  12. # removed or altered in any way.
  13. #-------------------------------------------------------------------------------
  14.  
  15. use strict;
  16. use vars qw($GLOBAL_OPTIONS $PARAMS $DCONF);
  17.  
  18. ###
  19. ### MISC_admin
  20. ###
  21. ### Run miscellaneous features (color wheel, log out, version manager,
  22. ### quota utility, initial administration password)
  23. ###
  24.  
  25. sub MISC_admin {
  26.     my ($FORMref) = @_;
  27.     undef my $subst;
  28.     undef my $args;
  29.     $subst->{'general'}->{'menu'} = $FORMref->{'menu'};
  30.     if ($FORMref->{'action'} =~ /^taskman-(\w+)$/) {
  31.         if ($1 eq "kill") {
  32.             unlink "$DCONF->{admin_dir}/data/dtaskman.pid";
  33.             unlink "$DCONF->{admin_dir}/data/schedule.pid";
  34.         } elsif ($1 eq "start") {
  35.             dreq("dtaskman");
  36.             unlink "$DCONF->{admin_dir}/data/dtaskman.pid";
  37.             unlink "$DCONF->{admin_dir}/data/schedule.pid";
  38.             sleep 2;
  39.             taskman_init();
  40.         }
  41.         $subst->{general}->{op} = $1;
  42.         screen_out("tmansucc", $subst);    
  43.     }
  44.     if ($FORMref->{'action'} eq "color") {
  45.         $subst->{'general'}->{'formname'} =    $FORMref->{formname};
  46.         $subst->{'general'}->{'field'} =    $FORMref->{field};
  47.         $subst->{'general'}->{'context'} =    $FORMref->{context};
  48.         $subst->{'general'}->{'forwhat'} =    $FORMref->{forwhat};
  49.         undef my @carr;
  50.         undef my @aarr;
  51.         undef my @barr;
  52.         foreach my $x ("0","3","6","9","c","f") {
  53.             push (@aarr, { color => "$x$x"} );
  54.         }
  55.         foreach my $x ("0","3","6","9","c","f") {
  56.             foreach my $y ("0","3","6","9","c","f") {
  57.                 push (@barr, { color => "$x$x$y$y"} );
  58.             }
  59.         }
  60.         $subst->{'aarr'} = \@aarr;
  61.         $subst->{'barr'} = \@barr;
  62.         screen_out("colorwhl", $subst);
  63.     }
  64.     if ($FORMref->{'action'} eq "logout") {
  65.         undef my $cookie_out;
  66.         foreach my $cookie (keys(%{$FORMref->{COOKIE}})) {
  67.             next if $cookie eq "lastvisit";
  68.             next if $cookie eq "offset";
  69.             next if $cookie eq "lastsession";
  70.             $cookie_out .= cookie_string_format($cookie, "undef", "Wednesday, 16-Aug-2000 00:00:00 GMT");
  71.         }
  72.         if ($FORMref->{COOKIE}->{uid} =~ m|^([\d\-]+)$|) {
  73.             unlink "$DCONF->{admin_dir}/data/tokens/$FORMref->{COOKIE}->{uid}.txt";
  74.         }
  75.         screen_out("logout", undef, $cookie_out);
  76.     }
  77.     if ($FORMref->{'action'} eq "version_mgr") {
  78.         my $result = check_password($FORMref->{username}, undef, { type_required => 'moderator' }, $FORMref->{'COOKIE'});
  79.         bad_login( { bad_username => 1 } ) if scalar(@{ $result }) == 0;
  80.         bad_login( { superuser_required => 1 } ) if $result->[0]->{user} ne $DCONF->{superuser};
  81.         version_manager($FORMref, $subst, $result);
  82.     }
  83.     if ($FORMref->{'action'} eq "quotaon") {
  84.         my $result = check_password($FORMref->{username}, undef, { type_required => 'moderator' }, $FORMref->{'COOKIE'});
  85.         bad_login( { bad_username => 1 } ) if scalar(@{ $result }) == 0;
  86.         bad_login( { superuser_required => 1 } ) if $result->[0]->{user} ne $DCONF->{superuser};
  87.         unlink("$DCONF->{admin_dir}/backups/QUOTA.txt") || error_message("Enable Error", "Could not remove file QUOTA.txt from your "backups" directory!");
  88.         $FORMref->{action} = "quota";
  89.         $FORMref->{menu} = 0;
  90.     }
  91.     if ($FORMref->{'action'} eq "quotatest") {
  92.         my $result = check_password($FORMref->{username}, undef, { type_required => 'moderator' }, $FORMref->{'COOKIE'});
  93.         bad_login( { bad_username => 1 } ) if scalar(@{ $result }) == 0;
  94.         bad_login( { superuser_required => 1 } ) if $result->[0]->{user} ne $DCONF->{superuser};
  95.         my $filename = "$DCONF->{admin_dir}/backups/quotatest-file";
  96.         if (-e "$filename") {
  97.             unlink($filename) || error_message("Quota test error", "Test file <B>$filename</B> exists!  Please remove this file before proceeding.");
  98.         }
  99.         my $time = time;
  100.         my $quota_exists = 0;
  101.         if (!-e "$DCONF->{admin_dir}/backups/QUOTA.txt") {
  102.             open (SAFEGUARD, ">$DCONF->{admin_dir}/backups/QUOTA.txt");
  103.             print SAFEGUARD "$time\nShut+down+for+quota+testing\n";
  104.             close (SAFEGUARD);
  105.         } else {
  106.             $quota_exists = 1;
  107.         }
  108.         my $bytepattern = "x" x 10000;
  109.         my $sized = $FORMref->{'size'}; $sized =~ s/\D//g;
  110.         undef my $subst;
  111.         $subst->{'result'}->{'sizereq'} = $sized;
  112.         error_message("Invalid size") if ($sized < 1 || $sized > 50);
  113.         my $sizeflag = 0;
  114.         undef $!;
  115.         for (my $size = 1; $size <= 1000000*$sized; $size += 10000) {
  116.             if (open (FILE, ">>$filename")) {
  117.                 print FILE $bytepattern;
  118.                 close (FILE);
  119.                 if (-s $filename < $size) {
  120.                     $sizeflag = 1;
  121.                     $subst->{'result'}->{'achieved'} = int((-s $filename) / 1000) / 1000;
  122.                     last;
  123.                 }
  124.             } else {
  125.                 $subst->{'result'}->{'achieved'} = int((-s $filename) / 1000) / 1000;
  126.                 $sizeflag = 1;
  127.                 $subst->{'result'}->{'explanation'} = $!;
  128.             }
  129.         }
  130.         $subst->{'result'}->{'sizeflag'} = $sizeflag;
  131.         $subst->{'result'}->{'explanation'} = $!;
  132.         if (!$quota_exists) {
  133.             if (!unlink("$DCONF->{admin_dir}/backups/QUOTA.txt")) {
  134.                 $subst->{'result'}->{'warn'} = 1;
  135.             }
  136.         }
  137.         if (-e $filename) {
  138.             if (!unlink("$filename")) {
  139.                 $subst->{'result'}->{'stillthere'} = 1;
  140.             }
  141.         }
  142.         $subst->{'general'}->{'username'} = $FORMref->{'username'};
  143.         $subst->{'general'}->{'url'} = "$PARAMS->{cgiurl}?action=quota&username=$FORMref->{username}";
  144.         screen_out("quotatst", $subst);
  145.     }
  146.     if ($FORMref->{'action'} eq "quota") {
  147.         my $result = check_password($FORMref->{username}, undef, { type_required => 'moderator' }, $FORMref->{'COOKIE'});
  148.         bad_login( { bad_username => 1 } ) if scalar(@{ $result }) == 0;
  149.         bad_login( { superuser_required => 1 } ) if $result->[0]->{user} ne $DCONF->{superuser};
  150.         $subst->{'general'}->{'username'} = $result->[0]->{'user'};
  151.         $subst->{'general'}->{'url'} = "$PARAMS->{cgiurl}?action=quota&username=$FORMref->{username}";
  152.         if ($PARAMS->{do_not_write_files}) {
  153.             $subst->{'event'}->{'isevent'} = 1;
  154.             if (open (ADMIN, "$DCONF->{admin_dir}/backups/QUOTA.txt")) {
  155.                 my @admin = <ADMIN>;
  156.                 close (ADMIN);
  157.                 my $date = $admin[0]; chomp $date;
  158.                 $subst->{'event'}->{'errdate'} = &get_date_time("long", $date);
  159.                 $subst->{'event'}->{'description'} = &unescape($admin[1]);
  160.             } else {
  161.                 $subst->{'event'}->{'isevent'} = 0;
  162.             }
  163.         } else {
  164.             $subst->{'event'}->{'isevent'} = 0;
  165.         }
  166.         if ($subst->{'general'}->{'menu'} == 0) {
  167.             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");
  168.             push (@dirs, "$DCONF->{html_dir}", "$DCONF->{html_dir}/$DCONF->{icon_dir}", "$DCONF->{html_dir}/clipart", "$DCONF->{script_dir}");
  169.             opendir (DIR, "$DCONF->{message_dir}");
  170.             while (my $dir = readdir(DIR)) {
  171.                 next if $dir !~ m|^\d+$|;
  172.                 push (@dirs, "$DCONF->{message_dir}/$dir");
  173.             }
  174.             closedir(DIR);
  175.             opendir (DIR, "$DCONF->{secdir}");
  176.             while (my $dir2 = readdir(DIR)) {
  177.                 next if $dir2 !~ m|^\d+$|;
  178.                 push (@dirs, "$DCONF->{secdir}/$dir2");
  179.             }
  180.             closedir(DIR);
  181.             undef my @lgfiles;
  182.             foreach my $dirname (@dirs) {
  183.                 opendir(DIR, $dirname);
  184.                 while (my $dirf = readdir(DIR)) {
  185.                     my $s = -s "$dirname/$dirf";
  186.                     if ($s > 1000000) {
  187.                         undef my $hashref;
  188.                         $hashref->{'filename'} = "$dirname/$dirf";
  189.                         $hashref->{'filesize'} = int($s / 1000);
  190.                         push (@lgfiles, $hashref);
  191.                     }
  192.                 }
  193.                 closedir(DIR);
  194.             }
  195.             $subst->{'lgfile'}->{'count'} = scalar(@lgfiles);
  196.             $subst->{'lgfiles'} = \@lgfiles;
  197.         }
  198.         if ($subst->{general}->{menu} == 1) {
  199.             foreach my $ind ('locks', 'backups') {
  200.                 if (open(FILE, "> $DCONF->{admin_dir}/$ind/testfile")) {
  201.                     close (FILE);
  202.                     if (unlink("$DCONF->{admin_dir}/$ind/testfile")) {
  203.                         $subst->{tests}->{$ind} = "";
  204.                         if (-e "$DCONF->{admin_dir}/$ind/testfile") {
  205.                             $subst->{tests}->{$ind} = "File still exists after removal!";
  206.                         }
  207.                     } else {
  208.                         $subst->{tests}->{$ind} = "System error: $!";
  209.                     }
  210.                 } else {
  211.                     $subst->{tests}->{$ind} = "Couldn't create: $!";
  212.                 }
  213.             }
  214.         }
  215.         screen_out("quota", $subst);
  216.     }
  217.     if ($FORMref->{'action'} eq "first_pass") {
  218.         my $result = check_password($FORMref->{username}, $FORMref->{password}, { type_required => 'moderator', no_cookies => 1, blank_ok => 1 });
  219.         bad_login( { bad_username => 1 } ) if scalar(@{ $result }) == 0;
  220.         bad_login( { superuser_required => 1 } ) if $result->[0]->{user} ne $DCONF->{superuser};
  221.         if ((@{$result})[0]->{'pass'} eq "") {
  222.             $subst->{'general'}->{'username'} = $result->[0]->{'user'};
  223.             $subst->{'general'}->{'firstreg'} = ($result->[0]->{email} eq "email" || $result->[0]->{email} eq "") ? 1 : 0;
  224.             $subst->{'sugg'}->{'email'} = $1 if $DCONF->{contact} =~ /<a href="?mailto:(.*?)"?>/i;
  225.             $subst->{'sugg'}->{'fullname'} = $2 if $DCONF->{contact} =~ m%<a href="?mailto:(.*?)"?>(.*?)</a>%i;
  226.             screen_out("adm1pass", $subst);
  227.         } else {
  228.             bad_login( { bad_username => 1 } );
  229.         }
  230.     }
  231.     if ($FORMref->{'action'} eq "firstpass") {
  232.         my $result = check_password($FORMref->{username}, $FORMref->{password}, { type_required => 'moderator', no_cookies => 1, blank_ok => 1 });
  233.         bad_login( { bad_username => 1 } ) if scalar(@{ $result }) == 0;
  234.         bad_login( { superuser_required => 1 } ) if $result->[0]->{user} ne $DCONF->{superuser};
  235.         bad_login( { bad_username => 1 } ) if $result->[0]->{pass} ne "";
  236.         my ($pass1, $pass2) = prepare_userpass_p($FORMref->{pass1}, $FORMref->{pass2});
  237.         error_message(read_language()->{PROFILE_CHPASS_ERROR}, read_language()->{PROFILE_CHPASS_ERROR_MATCH}, 0, 1) if $pass1 ne $pass2;
  238.         error_message(read_language()->{PROFILE_CHPASS_ERROR}, read_language()->{PROFILE_CHPASS_ERROR_LENGTH}, 0, 1) if length($pass2) < 1;
  239.         my $ctime = ($result->[0]->{ctime} == 0 ? lpad(time, "0", 10) : $result->[0]->{ctime});
  240.         my $atime = time;
  241.         dreq("fcn-acct");
  242.         my $email = ( $result->[0]->{email} eq "" ? $FORMref->{email} : $result->[0]->{email} );
  243.         my $fullname = ( $result->[0]->{fullname} eq "" ? $FORMref->{fullname} : $result->[0]->{fullname} );
  244.         my ($s, $f) = update_account({ ctime => $ctime, user => $result->[0]->{user}, new_password => $pass1, email => $email, fullname => $fullname }, "passwd", undef);
  245.         dreq("adm-menu", "topic-pg");
  246.         regenerate_topic_page();
  247.         append_serial();
  248.         if ($DCONF->{pro}) {
  249.             dreq("fcn-prfl-PRO");
  250.             my $prfl = get_enhanced_profile('passwd', $DCONF->{superuser});
  251.             if (ref $prfl ne 'ARRAY' || scalar @{$prfl} == 0) {
  252.                 my @a = ();
  253.                 my $u = {};
  254.                 $u->{username} = $DCONF->{superuser};
  255.                 $u->{database} = 'passwd';
  256.                 my %j = map { $_, 1 } split(//, $GLOBAL_OPTIONS->{default_prefs}); $u->{pref} = \%j;
  257.                 $u->{status} = 10;
  258.                 push @a, $u;    
  259.                 update_enhanced_profile_file(\@a);
  260.             }
  261.         }
  262.         if (scalar(@{ $s }) == 1) {
  263.             my $subst = {};
  264.             $subst->{'general'}->{'skipreg'} = $FORMref->{'skipreg'};
  265.             $subst->{'general'}->{'email'} = $FORMref->{'email'};
  266.             $subst->{'general'}->{'name'} =  $FORMref->{'fullname'};
  267.             screen_out("register", $subst);
  268.         }
  269.     }
  270. }
  271.  
  272. ###
  273. ### test_seek_tell
  274. ###
  275. ### Sees if your operating system will properly support fast-update of account info
  276. ###
  277.  
  278. sub test_seek_tell {
  279.     my $testfile = "$DCONF->{admin_dir}/data/testseektell.txt";
  280.     my $teststr = "123456789012345678901234567890\n";
  281.     if (open (TESTFILE, "> $testfile")) {
  282.         print TESTFILE $teststr;
  283.         close (TESTFILE);
  284.         chmod (oct($DCONF->{perms0666}), $testfile);
  285.         sysopen FASTUPDATE, $testfile, 2;
  286.         seek FASTUPDATE, 10, 0;
  287.         syswrite FASTUPDATE, "ABCDEFGHIJ", 10;
  288.         close FASTUPDATE;
  289.         open (TESTFILE, "< $testfile");
  290.         my @tf = <TESTFILE>;
  291.         close (TESTFILE);
  292.         unlink $testfile;
  293.         return 1 if $tf[0] eq "1234567890ABCDEFGHIJ1234567890\n";
  294.         return 0;
  295.     } else {
  296.         error_message("Test seek/tell error", "Could not write to file $testfile");
  297.     }
  298. }
  299.  
  300. ###
  301. ### version_manager
  302. ###
  303. ### Version Manager screen
  304. ###
  305.  
  306. sub version_manager {
  307.     my ($FORMref, $subst, $result) = @_;
  308.     if ($GLOBAL_OPTIONS->{version_nocontact} != 1 && $FORMref->{menu} == 0) {
  309.         my $result = eval '
  310.             my ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname("www.discusware.com");
  311.             my $discusware_ip = defined $addrs[0] ? sprintf "%d.%d.%d.%d", unpack("C4",$addrs[0]) : "208.171.52.98";
  312.             use IO::Socket;
  313.             my $sock = IO::Socket::INET->new( Proto => "tcp", PeerAddr => $discusware_ip, PeerPort => 1897 );
  314.             undef if ! defined $sock;
  315.             $sock->autoflush(1);
  316.             print $sock join("\t" => $PARAMS->{serial}, $DCONF->{pro_license}, join("", $DCONF->{script_url}, "/", "discus.", $DCONF->{cgi_extension}), "\015\012");
  317.             my $buf = "";
  318.             my $n;
  319.             1 while $n = sysread($sock, $buf, 8*1024, length($buf));
  320.             undef unless defined($n);
  321.             $buf;
  322.         ';
  323.         if ($@) {
  324.             log_error("adm-misc.pl", "version_manager", "Error connecting to DiscusWare version server: \$\@=$@, \$\!=$!") if $@ ne "";
  325.         }
  326.         $result =~ s/\r\n$//;
  327.         ($subst->{'vminfo'}->{'update'}, $subst->{'vminfo'}->{'latest'}, $subst->{'vminfo'}->{'urgent_notice'}) = split(/:/, $result);
  328.         if ($subst->{'vminfo'}->{'update'} == 5) {
  329.             dreq("adm-opts"); options_save( { wfstjpo_wfsjgz => 1, TRANSLATE_NAME => 1 } );
  330.         } elsif ($subst->{'vminfo'}->{'update'} <= 3 && $subst->{'vminfo'}->{'update'} >= 1) {
  331.             dreq("adm-opts"); options_save( { wfstjpo_wfsjgz => 0, TRANSLATE_NAME => 1 } );
  332.         }
  333.     } else {
  334.         $subst->{'vminfo'}->{'update'} = -1;
  335.         $subst->{'vminfo'}->{'latest'} = "";
  336.         $subst->{'vminfo'}->{'urgent_notice'} = "";
  337.     }
  338.     $subst->{'general'}->{'username'} = $result->[0]->{'user'};
  339.     $subst->{'general'}->{'url'} = "$PARAMS->{cgiurl}?action=version_mgr&username=$result->[0]->{user}";
  340.     $subst->{'general'}->{'version'} = join(".", $PARAMS->{release}, $PARAMS->{revision});
  341.     if ($FORMref->{menu} == 1) {
  342.         my @file = ();
  343.         if (open(FILE, "$DCONF->{script_dir}/board-contact.$DCONF->{cgi_extension}")) {
  344.             @file = <FILE>;
  345.             close (FILE);
  346.         } elsif (open(FILE, "./board-contact.$DCONF->{cgi_extension}")) {
  347.             @file = <FILE>;
  348.             close (FILE);
  349.         } elsif (-e "/usr/local/bin/perl") {
  350.             @file = ('/usr/local/bin/perl');
  351.         } else {
  352.             @file = ('/usr/bin/perl');
  353.         }
  354.         my $x = $file[0];
  355.         $x =~ s/^#!//;
  356.         $x =~ s/\s+$//;
  357.         $subst->{'upgradeinfo'}->{'pathperl'} = $x;
  358.         if (open(DC, "$DCONF->{admin_dir}/discus.conf")) {
  359.             my @dc = <DC>;
  360.             close (DC);
  361.             $subst->{'upgradeinfo'}->{'discusconf'} = escape(join("", @dc));
  362.         }
  363.         if (-e "$DCONF->{admin_dir}/patch.txt") {
  364.             my $J = readfile("$DCONF->{admin_dir}/patch.txt", "version_manager", { no_lock => 1, no_unlock => 1, zero_ok => 1 });
  365.             my $v = shift @{ $J };
  366.             $subst->{patch}->{used} = 1;
  367.             ($subst->{patch}->{olds}, $subst->{patch}->{news}, $subst->{patch}->{oldv}, $subst->{patch}->{newv}) = split(/\s+/, $v);
  368.             my @cs = ();
  369.             foreach my $file (@{$J}) {
  370.                 my ($path, $checksum) = split(/\t/, $file);
  371.                 next if $file =~ m%^/\./%;
  372.                 my $X = readfile_binary($path);
  373.                 my $i = {};
  374.                 $i->{file} = $path;
  375.                 $i->{shortfile} = $' if $path =~ /.*\//;
  376.                 if (! defined $X) {
  377.                     $i->{error} = 1;
  378.                 } else {
  379.                     my @j = stat $path;
  380.                     $i->{size} = $j[7];
  381.                     $i->{mtime} = $j[9];
  382.                     if ($checksum != unpack("%16C*", $X)) {
  383.                         $i->{error} = 2;
  384.                     }
  385.                 }
  386.                 push @cs, $i;
  387.             }
  388.             @cs = sort {$a->{file} cmp $b->{file}} @cs;
  389.             $subst->{patcharr} = \@cs;
  390.         }
  391.     }
  392.     $subst->{general}->{menu} = $FORMref->{menu};
  393.     dreq("topic-pg");
  394.     bless $subst;
  395.     $subst->topic_page_board_info(board_topics(undef, undef, undef, 1, 1));
  396.     screen_out("version", $subst);
  397. }
  398.  
  399. 1;
  400.