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 >
Text File  |  2009-11-06  |  11KB  |  286 lines
  1. # FILE: adm-menu.pl
  2. # DESCRIPTION: Administration login screen and main menu
  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 $DCONF $PARAMS);
  17.  
  18. ###
  19. ### MENU_admin
  20. ###
  21. ### Controls Main Menu and administration login screen
  22. ###
  23.  
  24. sub MENU_admin {
  25.     my ($FORMref) = @_;
  26.     my $timecache = time;
  27.     dreq("template", "maintain");
  28.     cleaning_jobs();
  29.     my $subst = {};
  30.     if ($FORMref->{'cmd'} eq "start") {
  31.         my $username = defined $FORMref->{username} ? $FORMref->{username} : $FORMref->{COOKIE}->{admuser};
  32.         my $result = check_password($username, undef, { type_required => "moderator" }, $FORMref->{COOKIE});
  33.         my ($topic, $page) = split(/\//, $FORMref->{startfrom});
  34.         my $gp = GetPage($topic, $page, { no_error => 1 });
  35.         if ($gp->{head}->{me_number} == $page) {
  36.             if (scalar @{$result} > 0) {
  37.                 dreq("fcn-priv");
  38.                 if (check_topic_authorization($result->[0]->{user}, $topic, undef)) {
  39.                     $subst->{general}->{screen} = "adminhere";
  40.                     ($subst->{general}->{topic}, $subst->{general}->{page}) = split(/\//, $FORMref->{'startfrom'});
  41.                     $subst->{general}->{username} = $result->[0]->{user};
  42.                     screen_out("uimain", $subst);            
  43.                 }
  44.             }
  45.             $subst->{general}->{screen} = "admin";
  46.             $subst->{'general'}->{'startfrom'} = $FORMref->{'startfrom'};
  47.             screen_out("uimain", $subst);            
  48.         } else {
  49.             $subst->{'general'}->{'username'} = $FORMref->{COOKIE}->{admuser};
  50.             screen_out("admlogin", $subst);
  51.         }
  52.     }    
  53.     if ($FORMref->{'action'} eq "") {
  54.         $subst->{'general'}->{'username'} = $FORMref->{COOKIE}->{admuser};
  55.         $subst->{'general'}->{'startfrom'} = $FORMref->{startfrom};
  56.         screen_out("admlogin", $subst);
  57.     }
  58.     if ($FORMref->{'action'} eq "qmenu") {
  59.         my $result = check_password($FORMref->{COOKIE}->{admuser}, undef, { type_required => "moderator" }, $FORMref->{COOKIE});
  60.         bad_login({ bad_menu_username => 1 }) if scalar(@{$result}) == 0;
  61.         $subst->{general}->{username} = $result->[0]->{user};
  62.         $subst->{general}->{is_superuser} = $result->[0]->{user} eq $DCONF->{superuser} ? 1 : 0;
  63.         my ($successref, $failref) = update_admin_log($subst->{'general'}->{'username'}, $timecache);
  64.         $successref->{'where'} = "?" if $successref->{'where'} eq "";
  65.         $successref->{'date'} = "?" if $successref->{'date'} eq "";
  66.         $subst->{'logdata'} = $successref;
  67.         $subst->{'failures'} = $failref;
  68.         $subst->{'general'}->{'failcount'} = scalar(@{ $failref });
  69.         $DCONF->{html_url} =~ m|http://([^/]+)|i; my $html_host = $1;
  70.         $DCONF->{script_url} =~ m|http://([^/]+)|i; my $script_host = $1;
  71.         $subst->{'general'}->{'hostmatch'} = 1 if $html_host eq $script_host;
  72.         if ($DCONF->{pro}) {
  73.             dreq("selfreg-PRO","queue2-PRO");
  74.             $subst->{'general'}->{'userqueue'} = scalar(@{count_queued_users($result->[0]->{user})});
  75.             my $y = queue_moderator_list($result->[0]->{user});
  76.             $subst->{'general'}->{'msgqueue'} = scalar(@{ $y });
  77.         }
  78.         screen_out("admmenu", $subst, undef);
  79.     }
  80.     if ($FORMref->{'action'} eq "menu") {
  81.         my $timecache = time;
  82.         my $flag = 0;
  83.         $flag = 1 if $FORMref->{timetoken} > $timecache;
  84.         $flag = 1 if (($timecache - $FORMref->{timetoken}) > (60 * $GLOBAL_OPTIONS->{mod_session_expire_inactivity}));
  85.         if ($flag == 1 && $GLOBAL_OPTIONS->{mod_session_expire} == 1 && $GLOBAL_OPTIONS->{mod_session_expire_inactivity} > 0) {
  86.             $subst->{'general'}->{'startfrom'} = $FORMref->{'startfrom'};
  87.             $subst->{'general'}->{'username'} = $FORMref->{COOKIE}->{'admuser'};
  88.             screen_out("admlogin", $subst);
  89.         }        
  90.         my $result = check_password($FORMref->{'username'}, $FORMref->{'password'}, { type_required => "moderator", nocookies => 1, blank_ok => 1 });
  91.         if (scalar(@{$result}) == 0) {
  92.             $FORMref->{username} = prepare_userpass($FORMref->{username});
  93.             my @data = ("$FORMref->{username};$ENV{REMOTE_HOST};$ENV{REMOTE_ADDR};$timecache;WRONG\n");
  94.             appendfile("$DCONF->{admin_dir}/adminlog.txt", \@data, "MENU_admin", undef);
  95.             if ($DCONF->{pro} && ($GLOBAL_OPTIONS->{mod_fails} || $GLOBAL_OPTIONS->{mod_fails_mail})) {
  96.                 dreq("adm-msc-PRO");
  97.                 track_moderator_failure($FORMref);
  98.             }    
  99.             bad_login({ bad_menu_username => 1 });
  100.         }
  101.         $subst->{'general'}->{'username'} = $result->[0]->{'user'};
  102.         $subst->{'general'}->{'is_superuser'} = 1 if $DCONF->{superuser} eq $subst->{'general'}->{'username'};
  103.         my ($successref, $failref) = update_admin_log($subst->{'general'}->{'username'}, $timecache);
  104.         $successref->{'where'} = "?" if $successref->{'where'} eq "";
  105.         $successref->{'date'} = "?" if $successref->{'date'} eq "";
  106.         $subst->{'logdata'} = $successref;
  107.         $subst->{'failures'} = $failref;
  108.         $subst->{'general'}->{'failcount'} = scalar(@{ $failref });
  109.         my $version_upgrade = check_upgrade();
  110.         if ($version_upgrade == 1) {
  111.             $subst->{'general'}->{'url'} = "$PARAMS->{cgiurl}?action=pm-mgr_1&username=$result->[0]->{user}" if $FORMref->{'startfrom'} !~ m|^(\d+)/(\d+)$|;
  112.             $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+)$|;
  113.             if ($DCONF->{pro}) {
  114.                 dreq("selfreg-PRO","queue2-PRO");
  115.                 $subst->{'general'}->{'userqueue'} = scalar(@{count_queued_users($result->[0]->{user})});
  116.                 my $y = queue_moderator_list($result->[0]->{user});
  117.                 $subst->{'general'}->{'msgqueue'} = scalar(@{ $y });
  118.             }
  119.         } else {
  120.             $subst->{'general'}->{'url'} = "$PARAMS->{cgiurl}?action=upgrade&username=$result->[0]->{user}";
  121.             $subst->{general}->{upgrade} = 1;
  122.             $subst->{general}->{upgrade} = 2 if $result->[0]->{user} eq $DCONF->{superuser};
  123.             dreq("adm-opts");
  124.             options_save({ maintenance => 2 }) if $GLOBAL_OPTIONS->{maintenance} == 0;
  125.         }
  126.         $DCONF->{html_url} =~ m|http://([^/]+)|i; my $html_host = $1;
  127.         $DCONF->{script_url} =~ m|http://([^/]+)|i; my $script_host = $1;
  128.         $subst->{'general'}->{'hostmatch'} = 1 if $html_host eq $script_host;
  129.         if ($result->[0]->{'pass'} eq "") {
  130.             $subst->{'general'}->{'first_pw'} = 1;
  131.             $subst->{'general'}->{'url'} = "$PARAMS->{cgiurl}?action=first_pass&username=$result->[0]->{user}";
  132.         }
  133.         my $pass_challenge = crypt($result->[0]->{'pass'}, "cookie");
  134.         my $COOKIE_STRING = "";
  135.         $COOKIE_STRING .= cookie_string_format("admuser", $result->[0]->{user}, undef);
  136.         $COOKIE_STRING .= cookie_string_format("pass", $pass_challenge, undef);
  137.         screen_out("admmenu", $subst, $COOKIE_STRING);
  138.     }
  139. }
  140.  
  141. ###
  142. ### update_admin_log
  143. ###
  144. ### Provides logging of successful or failed login attempts
  145. ###
  146.  
  147. sub update_admin_log {
  148.     my ($USER_mod, $timecache) = @_;
  149.     my $a = readfile("$DCONF->{admin_dir}/adminlog.txt", "MENU_admin", { no_unlock => 1, zero_ok => 1 });
  150.     my $flc = 0;
  151.     my @flc = ();
  152.     undef my $successref;
  153.     my @a = @{ $a };
  154.     foreach my $line (@a) {
  155.         if ($line =~ m|^$USER_mod;([^;]*);([^;]*);(\d+);(.*)|) {
  156.             my ($rh, $ra, $dt, $ok) = ($1, $2, $3, $4);
  157.             if ($ok !~ m|ok|) {
  158.                 $flc += 1;
  159.                 undef my $failref;
  160.                 $failref->{'date'} = (get_date_time('long', $dt))[0];
  161.                 $failref->{'where'} = "$rh [$ra]" if $rh ne "";
  162.                 $failref->{'where'} = "$ra" if $rh eq "";
  163.                 push (@flc, $failref);
  164.             } else {
  165.                 $successref->{'date'} = get_date_time('short', $dt);
  166.                 $successref->{'where'} = "$rh [$ra]" if $rh ne "";
  167.                 $successref->{'where'} = "$ra" if $rh eq "";
  168.             }
  169.             $line = "";
  170.         } elsif ($line =~ m|^;|) {
  171.             $line = "";
  172.         }
  173.     }
  174.     @a = grep(/\S/, @a);
  175.     push (@a, "$USER_mod;$ENV{'REMOTE_HOST'};$ENV{'REMOTE_ADDR'};$timecache;ok\n");
  176.     writefile("$DCONF->{admin_dir}/adminlog.txt", \@a, "MENU_admin", { no_lock => 1 });
  177.     return ($successref, \@flc);
  178. }
  179.  
  180. ###
  181. ### check_upgrade
  182. ###
  183. ### Determines if you have upgraded your files to version 4.0
  184. ###
  185.  
  186. sub check_upgrade {
  187.     my $x = check_first_install_serial();
  188.     return $x if defined $x;
  189.     if (-e "$DCONF->{admin_dir}/data/topicprv.txt") { # You have version 4.0 now
  190.         append_serial();
  191.         return 1;
  192.     }
  193.     my $t = board_topics(undef, undef, undef, 1);
  194.     if (scalar(@{$t}) == 0) { # Fresh installation of version 4.0, first access
  195.         append_serial();
  196.         return 1;
  197.     }
  198.     if (-e "$DCONF->{admin_dir}/upgrade.txt") {
  199.         # This was version 3.10
  200.         return 0;  # Invoke automatic upgrade procedure
  201.     } elsif (-e "$DCONF->{admin_dir}/posting.txt") {
  202.         # This was version 3.00/3.01
  203.         upgrade_error_message(1);
  204.     } elsif (-e "$DCONF->{admin_dir}/frontpage_conf.txt") {
  205.         # This was version 2.50
  206.         upgrade_error_message(2);
  207.     } elsif (-s "$DCONF->{admin_dir}/source/src-board-subs-common" > 6000) {
  208.         # This was version 2.40
  209.         upgrade_error_message(3);
  210.     } else {
  211.         # This was version 2.30 or before
  212.         upgrade_error_message(4);
  213.     }
  214. }
  215.  
  216. ###
  217. ### upgrade_error_message
  218. ###
  219. ### Kindly tells you that your version is too old to upgrade
  220. ###
  221.  
  222. sub upgrade_error_message {
  223.     my ($code) = @_;
  224.     my $subst = {};
  225.     $subst->{general}->{upgrade} = 1;
  226.     $subst->{general}->{code} = $code;
  227.     screen_out("badlogin", $subst);    
  228. }
  229.  
  230. ###
  231. ### check_first_install_serial
  232. ###
  233. ### Checks the serial number from (version 4.0 or above)
  234. ###
  235.  
  236. sub check_first_install_serial {
  237.     my ($result) = @_;
  238.     if ($DCONF->{pro} && ! -e "$DCONF->{admin_dir}/data/pro.txt") {
  239.         dreq("pro-init-PRO");
  240.         create_discus_pro_files();
  241.     }
  242.     return undef if ! -e "$DCONF->{admin_dir}/data/serial.txt";
  243.     my $u = readfile("$DCONF->{admin_dir}/data/serial.txt", "check_first_install_serial", { no_lock => 1, no_unlock => 1 });
  244.     return parse_serial($u->[scalar(@{$u})-1], $result);
  245. }
  246.  
  247. ###
  248. ### parse_serial
  249. ###
  250. ### Checks to see if any supplemental upgrades are needed
  251. ###
  252.  
  253. sub parse_serial {
  254.     my ($input, $result) = @_;
  255.     chomp $input;
  256.     my @inp = split(/\./, $input);
  257.     my @inp_save = @inp;
  258.     my $serial_compare = join(".", splice @inp, 0, 4);
  259.     return 1 if $serial_compare eq $PARAMS->{serial};
  260.     append_serial();
  261.     my ($pro, $major, $minor, $revision) = @inp_save;
  262.     #
  263.     # If any upgrades are needed since the very first release of 4.0
  264.     # they will appear here
  265.     #
  266.     return 1;    
  267. }
  268.  
  269. ###
  270. ### append_serial
  271. ###
  272. ### Writes version information into the serial file
  273. ###
  274.  
  275. sub append_serial {
  276.     if (! -d "$DCONF->{admin_dir}/data") {
  277.         unlink "$DCONF->{admin_dir}/data";
  278.         mkdir("$DCONF->{admin_dir}/data", oct($DCONF->{perms0777}));
  279.         chmod(oct($DCONF->{perms0777}), "$DCONF->{admin_dir}/data");
  280.     }
  281.     my @u = ( join("", join(".", $PARAMS->{serial}, time), "\n") );
  282.     appendfile("$DCONF->{admin_dir}/data/serial.txt", \@u, "append_serial", { no_lock => 1, no_unlock => 1 });
  283. }
  284.  
  285. 1;
  286.