home *** CD-ROM | disk | FTP | other *** search
/ rtsi.com / 2014.01.www.rtsi.com.tar / www.rtsi.com / OS9 / FAQ / discus_admin_1357211388 / source / fcn-usrp.pl < prev    next >
Text File  |  2009-11-06  |  13KB  |  334 lines
  1. # FILE: fcn-usrp.pl
  2. # DESCRIPTION: User privilege modification functions (Access Manager, mainly)
  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. ### check_postread_priv
  20. ###
  21. ### Tests whether a certain individual is permitted to post (or read) the
  22. ### topic in question.  Input parameters include:
  23. ###
  24. ###        topic            Topic number
  25. ###        username        Username of incoming user
  26. ###        password        Password of incoming user
  27. ###        cookie            Cookie reference in $FORMref
  28. ###        remote_addr        Remote address of visitor
  29. ###        remote_host        Remote host of visitor
  30. ###        type            Privilege type ('p' for posting or 'r' for reading)
  31. ###
  32.  
  33. sub check_postread_priv {
  34.     my ($input, $privcache, $allback) = @_;
  35.     dreq("authpass");
  36.     $privcache = read_topic_privilege_file(1) if ! defined $privcache;
  37.     $input->{remote_addr} = (defined $input->{remote_addr} ? $input->{remote_addr} : $ENV{'REMOTE_ADDR'});
  38.     $input->{remote_host} = (defined $input->{remote_host} ? $input->{remote_host} : $ENV{'REMOTE_HOST'});
  39.     my ($result, $user_pw, $mod_pw, $susp) = _check_postread_priv($input, {}, $privcache, undef, undef);
  40.     return $result if ! $allback;
  41.     return ($result, $user_pw, $mod_pw, $susp);
  42. }
  43.  
  44. ###
  45. ### _check_postread_priv
  46. ###
  47. ### Internal checking function
  48. ###
  49.  
  50. sub _check_postread_priv {
  51.     my ($input, $result, $privcache, $user_pw_result, $moderator_pw_result) = @_;
  52.     my $suspend_flag = 0;
  53.     { # Public and IP-based privileges
  54.         $result->{public} = ip_address_compare($privcache->{ $input->{topic} }->{ $input->{type} }->{ip}->{':list:'}, $input->{remote_addr}, $input->{remote_host});
  55.     }
  56.     { # User-based posting privileges
  57.         if (! defined $user_pw_result) {
  58.             my ($upw, $x, $guess) = check_password( $input->{username}, $input->{password}, { no_suspend => $input->{no_suspend}, type_required => "user" }, $input->{cookie} );
  59.             if (ref $x eq 'HASH') {
  60.                 $user_pw_result = [ $x ];
  61.                 $suspend_flag = 1;
  62.             } else {
  63.                 $user_pw_result = $upw;
  64.             }
  65.         }
  66.         last if ref $user_pw_result ne 'ARRAY';
  67.         last if scalar(@{ $user_pw_result }) == 0;
  68.         $result->{profile_hash} = $user_pw_result->[0];
  69.         $result->{profile_hash}->{database} = "users";
  70.         $result->{user}->{account} = 1;
  71.         if ($privcache->{ $input->{topic} }->{ $input->{type} }->{user}->{'*'}) {
  72.             $result->{user}->{valid} = 1;
  73.         } elsif ($result->{public}) {
  74.             $result->{user}->{valid} = 1;
  75.         } else {
  76.             my @grp = grep(/\S/, split(/\//, $user_pw_result->[0]->{groups}));
  77.             foreach my $i (@grp) {
  78.                 $result->{user}->{valid} = 1 if $privcache->{$input->{topic} }->{ $input->{type} }->{user}->{$i};
  79.             }
  80.         }
  81.     }
  82.     { # Moderator-based posting privileges
  83.         if (! defined $moderator_pw_result) {
  84.             $moderator_pw_result = check_password( $input->{username}, $input->{password}, { type_required => "moderator" }, $input->{cookie} ) ;
  85.         }
  86.         last if scalar(@{ $moderator_pw_result }) == 0;
  87.         $result->{type}->{is_moderator} = 1;
  88.         $result->{moderator}->{account} = 1;
  89.         $result->{type}->{is_superuser} = 1 if $input->{username} eq $DCONF->{superuser};
  90.         $result->{profile_hash} = $moderator_pw_result->[0];
  91.         $result->{profile_hash}->{database} = "passwd";
  92.         if ($privcache->{ $input->{topic} }->{ $input->{type} }->{moderator}->{':list:'} eq "*") {
  93.             $result->{moderator}->{valid} = 1;
  94.         } elsif ($privcache->{ $input->{topic} }->{ $input->{type} }->{moderator}->{':list:'} eq "**") {
  95.             dreq("fcn-priv");
  96.             $result->{moderator}->{valid} = check_topic_authorization($input->{username}, $input->{topic});
  97.         } elsif ($result->{public}) {
  98.             $result->{moderator}->{valid} = 1;
  99.         } else {
  100.             $result->{moderator}->{valid} = 1 if $privcache->{$input->{topic} }->{ $input->{type} }->{moderator}->{prepare_userpass($input->{username})};
  101.         }
  102.     }
  103.     { # Special Password posting privileges
  104.         my $special_pass = $privcache->{ $input->{topic} }->{ $input->{type} }->{special};
  105.         last if $special_pass eq "";
  106.         dreq("authpass");
  107.         my $q = prepare_userpass_p($input->{password});
  108.         my $test_pass = crypt($q, "ab");
  109.         last if $test_pass ne $special_pass;
  110.         $result->{special} = 1;
  111.     }
  112.     $result->{authorized} = ($result->{special} + $result->{user}->{valid} + $result->{moderator}->{valid} + $result->{public});
  113.     $result->{options} = $privcache->{ $input->{topic} }->{'o'};
  114.     $result->{options_string} = $privcache->{ $input->{topic} }->{'options_string'};
  115.     $result->{queue} = $privcache->{ $input->{topic} }->{'q'};
  116.     if ($DCONF->{pro} && $result->{profile_hash}) {
  117.         dreq("fcn-prfl-PRO");
  118.         my $x = enhance_result_profile($result->{profile_hash});
  119.         $result->{profile_hash} = $x->[0];
  120.     }
  121.     return ($result, $user_pw_result, $moderator_pw_result, $suspend_flag);
  122. }
  123.  
  124. ###
  125. ### ip_address_compare
  126. ###
  127. ### IP address comparison
  128. ###
  129.  
  130. sub ip_address_compare {
  131.     my ($ip_block, $remote_addr, $remote_host) = @_;
  132.     $remote_addr = defined $remote_addr ? $remote_addr : $ENV{'REMOTE_ADDR'};
  133.     $remote_host = defined $remote_addr ? $remote_host : $ENV{'REMOTE_HOST'};
  134.     if ($DCONF->{pro}) {
  135.         dreq("bannedip-PRO");
  136.         return ip_address_compare_pro($ip_block, $remote_addr, $remote_host);
  137.     } else {
  138.         return 1 if $ip_block eq "*";
  139.         return 0;
  140.     }
  141. }
  142.  
  143. ###
  144. ### read_topic_privilege_file
  145. ###
  146. ### Low-level reading of the topic privileges file
  147. ###
  148.  
  149. sub read_topic_privilege_file {
  150.     my ($filelock, $noerr) = @_;
  151.     my $file = undef;
  152.     my $e = -e "$DCONF->{admin_dir}/data/topicprv.txt";
  153.     return {} if ! $e;
  154.     if ($filelock == 0) {
  155.         $file = readfile("$DCONF->{admin_dir}/data/topicprv.txt", "read_topic_privilege_file", { zero_ok => 1 });
  156.     } else {
  157.         $file = readfile("$DCONF->{admin_dir}/data/topicprv.txt", "read_topic_privilege_file", { zero_ok => 1, no_lock => 1, no_unlock => 1 });
  158.     }
  159.     my $result = {};
  160.     foreach my $line (@{ $file }) {
  161.         chomp $line;
  162.         push (@{ $result->{filecache} }, $line);
  163.         my ($topic, $type, $ip_based, $user_based, $moderator_based, $special) = split(/:/, $line);
  164.         next if $topic !~ /^\d+$/;
  165.         if ($type eq "p" || $type eq "r") {
  166.             $result->{$topic}->{$type}->{ip}->{':list:'} = $ip_based;
  167.             $result->{$topic}->{$type}->{user}->{':list:'} = $user_based;
  168.             $result->{$topic}->{$type}->{moderator}->{':list:'} = $moderator_based;
  169.             $result->{$topic}->{$type}->{special} = $special;
  170.             foreach my $id ('ip', 'user', 'moderator') {
  171.                 my @s = split(/,/, $result->{$topic}->{$type}->{$id}->{':list:'});
  172.                 foreach my $s (@s) {
  173.                     if ($s =~ m|^!(.*)|) {
  174.                         $result->{$topic}->{$type}->{$id}->{$s} = -1;
  175.                     } else {
  176.                         $result->{$topic}->{$type}->{$id}->{$s} = 1;
  177.                     }
  178.                 }
  179.             }
  180.         } elsif ($type eq "cr") {
  181.             $result->{$topic}->{$type}->{ip}->{':list:'} = $ip_based;
  182.         } elsif ($type eq "o") {
  183.             $result->{$topic}->{'o'}->{'anon'} = 1 if $ip_based =~ m|a|i;
  184.             $result->{$topic}->{'o'}->{'email'} = 1 if $ip_based =~ m|e|i;
  185.             $result->{$topic}->{'o'}->{'fullname'} = 1 if $ip_based =~ m|f|i;
  186.             $result->{$topic}->{'o'}->{'profile'} = 1 if $ip_based =~ m|p|i;
  187.             $result->{$topic}->{'o'}->{'ip_on_post'} = $1 if $ip_based =~ m|i(\d)|i;
  188.             $result->{$topic}->{'o'}->{'ip_on_post_anon'} = $1 if $ip_based =~ m|j(\d)|i;
  189.             $result->{$topic}->{'options_string'} = $ip_based;
  190.         } elsif ($type eq "q") {
  191.             $result->{$topic}->{'q'}->{'public'} = 1 if $ip_based =~ m|p|i;
  192.             $result->{$topic}->{'q'}->{'users'} = 1 if $ip_based =~ m|u|i;
  193.             $result->{$topic}->{'q'}->{'moderators'} = 1 if $ip_based =~ m|m|i;
  194.             $result->{$topic}->{'q'}->{'special'} = 1 if $ip_based =~ m|s|i;
  195.         }
  196.     }
  197.     foreach my $topic (keys %{$result}) {
  198.         next if ref $result->{$topic} ne 'HASH';
  199.         if (! defined $result->{$topic}->{'r'}) {
  200.             my $type = 'r';
  201.             $result->{$topic}->{$type}->{ip}->{':list:'} = "*";
  202.             $result->{$topic}->{$type}->{ip}->{'*'} = 1;
  203.             $result->{$topic}->{$type}->{user}->{':list:'} = "";
  204.             $result->{$topic}->{$type}->{moderator}->{':list:'} = "";
  205.             $result->{$topic}->{$type}->{special} = "";
  206.             push @{ $result->{filecache} }, "$topic:r:*:::\n";
  207.         }
  208.     }
  209.     return $result;
  210. }
  211.  
  212. ###
  213. ### write_topic_privilege_file
  214. ###
  215. ### Low-level writing of the topic privileges file
  216. ###
  217.  
  218. sub write_topic_privilege_file {
  219.     my ($actions, $args) = @_;
  220.     my @newfile = ();
  221.     undef my $classify;
  222.     foreach my $a (@{ $actions }) {
  223.         my ($act, $topc, $type, $ip, $user, $mod, $spec) = ($a->{action}, $a->{topic}, $a->{type}, $a->{ip}, $a->{user}, $a->{moderator}, $a->{special});
  224.         foreach my $tpc (split(/,/, $topc)) {
  225.             $ip = "*" if $type eq "r" && $DCONF->{pro} == 0;
  226.             if ($act eq "add_topic" || $act eq "set_equal" || $type eq "o" || $type eq "q") {
  227.                 if ($type eq "o") {
  228.                     my $s = "";
  229.                     if (defined $a->{define}) {
  230.                         $s = $a->{define};
  231.                     } else {
  232.                         $s .= "a" if $a->{anon};
  233.                         $s .= "e" if $a->{email};
  234.                         $s .= "f" if $a->{fullname};
  235.                         $s .= "p" if $a->{profile};
  236.                         $s .= "i" . (0+$a->{ip_on_post});
  237.                         $s .= "j" . (0+$a->{ip_on_post_anon});
  238.                     }
  239.                     push (@newfile, "$tpc:o:$s\n");
  240.                     $classify->{$tpc}->{'o'}->{added} = 1;
  241.                 } elsif ($type eq "q") {
  242.                     my $s = "";
  243.                     if (defined $a->{define}) {
  244.                         $s = $a->{define};
  245.                     } else {
  246.                         $s .= "m" if $a->{moderators};
  247.                         $s .= "p" if $a->{public};
  248.                         $s .= "s" if $a->{special};
  249.                         $s .= "u" if $a->{users};
  250.                     }
  251.                     push (@newfile, "$tpc:q:$s\n");
  252.                     $classify->{$tpc}->{'q'}->{added} = 1;
  253.                 } else {
  254.                     foreach my $t (split(/,/, $type)) {
  255.                         push (@newfile, "$tpc:$t:$ip:$user:$mod:$spec\n");
  256.                         $classify->{$tpc}->{$t}->{added} = 1;
  257.                     }
  258.                 }
  259.             } else {
  260.                 foreach my $t (split(/,/, $type)) {
  261.                     if ($act eq "del_topic") {
  262.                         $classify->{$tpc}->{'delete'} = 1;
  263.                     } elsif ($act eq "add_priv") {
  264.                         $classify->{$tpc}->{$t}->{'action'} = "add";
  265.                         foreach my $k ('ip', 'user', 'moderator', 'special') {
  266.                             $classify->{$tpc}->{$t}->{$k}->{add}->{$a->{$k}} = 1 if defined $a->{$k};
  267.                         }
  268.                     } elsif ($act eq "add_apriv") {
  269.                         $classify->{$tpc}->{$t}->{'action'} = "adda";
  270.                         foreach my $k ('ip', 'user', 'moderator', 'special') {
  271.                             $classify->{$tpc}->{$t}->{$k}->{add}->{$a->{$k}} = 2 if defined $a->{$k};
  272.                         }
  273.                     } elsif ($act eq "del_priv") {
  274.                         $classify->{$tpc}->{$t}->{'action'} = "del";
  275.                         foreach my $k ('ip', 'user', 'moderator', 'special') {
  276.                             $classify->{$tpc}->{$t}->{$k}->{del}->{$a->{$k}} = 0 if defined $a->{$k};
  277.                         }
  278.                     }
  279.                 }
  280.             }
  281.         }
  282.     }
  283.     my $file = readfile("$DCONF->{admin_dir}/data/topicprv.txt", "write_topic_privilege_file", { zero_ok => 1, no_unlock => 1, create => 1 });
  284.     foreach my $line (@{ $file }) {
  285.         my $line_manip = $line; chomp $line_manip;
  286.         my ($topic, $type, $ip_based, $user_based, $moderator_based, $special) = split(/:/, $line_manip);
  287.         next if $classify->{$topic}->{'delete'};
  288.         next if $classify->{$topic}->{$type}->{added};
  289.         if (! defined $classify->{$topic}->{$type}->{action} && ! defined $classify->{$topic}->{$type}->{added}) {
  290.             push (@newfile, $line);
  291.             next;
  292.         }
  293.         if ($classify->{$topic}->{$type}->{'action'} eq "set") {
  294.             my $j = $classify->{$topic}->{$type};
  295.             $line_manip = "$topic:$type:$j->{ip}:$j->{user}:$j->{moderator}:$j->{special}\n";
  296.             push (@newfile, $line_manip);
  297.             next;
  298.         }
  299.         if ($classify->{$topic}->{$type}->{'action'} eq "add" || $classify->{$topic}->{$type}->{'action'} eq "adda" || $classify->{$topic}->{$type}->{'action'} eq "del") {
  300.             my $cta = $classify->{$topic}->{$type}->{'action'};
  301.             $cta = "add" if $cta eq "adda";
  302.             my $k = {};
  303.             $k->{'ip'} = $ip_based;
  304.             $k->{'user'} = $user_based;
  305.             $k->{'moderator'} = $moderator_based;
  306.             foreach my $m ("ip", "user", "moderator") {
  307.                 my @pnew = ();
  308.                 foreach my $a (split(/,/, $k->{$m})) {
  309.                     if ($classify->{$topic}->{$type}->{'action'} ne "del") {
  310.                         push @pnew, $a if ! $classify->{$topic}->{$type}->{$m}->{del}->{$a};
  311.                     } else {
  312.                         push @pnew, $a;
  313.                     }
  314.                 }
  315.                 my $i = $classify->{$topic}->{$type}->{$m}->{$cta};
  316.                 if (ref $i eq 'HASH') {
  317.                     foreach my $a (keys %{$i}) {
  318.                         push @pnew, $a if $classify->{$topic}->{$type}->{$m}->{add}->{$a} == 1;
  319.                         unshift @pnew, $a if $classify->{$topic}->{$type}->{$m}->{add}->{$a} == 2;
  320.                     }
  321.                 }    
  322.                 $k->{$m} = join(",", @pnew);
  323.                 print "$m: $k->{$m}<br>\n";
  324.             }
  325.             $line_manip = "$topic:$type:$k->{ip}:$k->{user}:$k->{moderator}:$k->{special}\n";
  326.             push @newfile, $line_manip;
  327.             next;
  328.         }
  329.     }
  330.     writefile("$DCONF->{admin_dir}/data/topicprv.txt", \@newfile, "write_topic_privilege_file", { no_lock => 1, zero_ok => 1 });
  331. }
  332.  
  333. 1;
  334.