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 >
Wrap
Text File
|
2009-11-06
|
13KB
|
334 lines
# FILE: fcn-usrp.pl
# DESCRIPTION: User privilege modification functions (Access Manager, mainly)
#-------------------------------------------------------------------------------
# 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);
###
### check_postread_priv
###
### Tests whether a certain individual is permitted to post (or read) the
### topic in question. Input parameters include:
###
### topic Topic number
### username Username of incoming user
### password Password of incoming user
### cookie Cookie reference in $FORMref
### remote_addr Remote address of visitor
### remote_host Remote host of visitor
### type Privilege type ('p' for posting or 'r' for reading)
###
sub check_postread_priv {
my ($input, $privcache, $allback) = @_;
dreq("authpass");
$privcache = read_topic_privilege_file(1) if ! defined $privcache;
$input->{remote_addr} = (defined $input->{remote_addr} ? $input->{remote_addr} : $ENV{'REMOTE_ADDR'});
$input->{remote_host} = (defined $input->{remote_host} ? $input->{remote_host} : $ENV{'REMOTE_HOST'});
my ($result, $user_pw, $mod_pw, $susp) = _check_postread_priv($input, {}, $privcache, undef, undef);
return $result if ! $allback;
return ($result, $user_pw, $mod_pw, $susp);
}
###
### _check_postread_priv
###
### Internal checking function
###
sub _check_postread_priv {
my ($input, $result, $privcache, $user_pw_result, $moderator_pw_result) = @_;
my $suspend_flag = 0;
{ # Public and IP-based privileges
$result->{public} = ip_address_compare($privcache->{ $input->{topic} }->{ $input->{type} }->{ip}->{':list:'}, $input->{remote_addr}, $input->{remote_host});
}
{ # User-based posting privileges
if (! defined $user_pw_result) {
my ($upw, $x, $guess) = check_password( $input->{username}, $input->{password}, { no_suspend => $input->{no_suspend}, type_required => "user" }, $input->{cookie} );
if (ref $x eq 'HASH') {
$user_pw_result = [ $x ];
$suspend_flag = 1;
} else {
$user_pw_result = $upw;
}
}
last if ref $user_pw_result ne 'ARRAY';
last if scalar(@{ $user_pw_result }) == 0;
$result->{profile_hash} = $user_pw_result->[0];
$result->{profile_hash}->{database} = "users";
$result->{user}->{account} = 1;
if ($privcache->{ $input->{topic} }->{ $input->{type} }->{user}->{'*'}) {
$result->{user}->{valid} = 1;
} elsif ($result->{public}) {
$result->{user}->{valid} = 1;
} else {
my @grp = grep(/\S/, split(/\//, $user_pw_result->[0]->{groups}));
foreach my $i (@grp) {
$result->{user}->{valid} = 1 if $privcache->{$input->{topic} }->{ $input->{type} }->{user}->{$i};
}
}
}
{ # Moderator-based posting privileges
if (! defined $moderator_pw_result) {
$moderator_pw_result = check_password( $input->{username}, $input->{password}, { type_required => "moderator" }, $input->{cookie} ) ;
}
last if scalar(@{ $moderator_pw_result }) == 0;
$result->{type}->{is_moderator} = 1;
$result->{moderator}->{account} = 1;
$result->{type}->{is_superuser} = 1 if $input->{username} eq $DCONF->{superuser};
$result->{profile_hash} = $moderator_pw_result->[0];
$result->{profile_hash}->{database} = "passwd";
if ($privcache->{ $input->{topic} }->{ $input->{type} }->{moderator}->{':list:'} eq "*") {
$result->{moderator}->{valid} = 1;
} elsif ($privcache->{ $input->{topic} }->{ $input->{type} }->{moderator}->{':list:'} eq "**") {
dreq("fcn-priv");
$result->{moderator}->{valid} = check_topic_authorization($input->{username}, $input->{topic});
} elsif ($result->{public}) {
$result->{moderator}->{valid} = 1;
} else {
$result->{moderator}->{valid} = 1 if $privcache->{$input->{topic} }->{ $input->{type} }->{moderator}->{prepare_userpass($input->{username})};
}
}
{ # Special Password posting privileges
my $special_pass = $privcache->{ $input->{topic} }->{ $input->{type} }->{special};
last if $special_pass eq "";
dreq("authpass");
my $q = prepare_userpass_p($input->{password});
my $test_pass = crypt($q, "ab");
last if $test_pass ne $special_pass;
$result->{special} = 1;
}
$result->{authorized} = ($result->{special} + $result->{user}->{valid} + $result->{moderator}->{valid} + $result->{public});
$result->{options} = $privcache->{ $input->{topic} }->{'o'};
$result->{options_string} = $privcache->{ $input->{topic} }->{'options_string'};
$result->{queue} = $privcache->{ $input->{topic} }->{'q'};
if ($DCONF->{pro} && $result->{profile_hash}) {
dreq("fcn-prfl-PRO");
my $x = enhance_result_profile($result->{profile_hash});
$result->{profile_hash} = $x->[0];
}
return ($result, $user_pw_result, $moderator_pw_result, $suspend_flag);
}
###
### ip_address_compare
###
### IP address comparison
###
sub ip_address_compare {
my ($ip_block, $remote_addr, $remote_host) = @_;
$remote_addr = defined $remote_addr ? $remote_addr : $ENV{'REMOTE_ADDR'};
$remote_host = defined $remote_addr ? $remote_host : $ENV{'REMOTE_HOST'};
if ($DCONF->{pro}) {
dreq("bannedip-PRO");
return ip_address_compare_pro($ip_block, $remote_addr, $remote_host);
} else {
return 1 if $ip_block eq "*";
return 0;
}
}
###
### read_topic_privilege_file
###
### Low-level reading of the topic privileges file
###
sub read_topic_privilege_file {
my ($filelock, $noerr) = @_;
my $file = undef;
my $e = -e "$DCONF->{admin_dir}/data/topicprv.txt";
return {} if ! $e;
if ($filelock == 0) {
$file = readfile("$DCONF->{admin_dir}/data/topicprv.txt", "read_topic_privilege_file", { zero_ok => 1 });
} else {
$file = readfile("$DCONF->{admin_dir}/data/topicprv.txt", "read_topic_privilege_file", { zero_ok => 1, no_lock => 1, no_unlock => 1 });
}
my $result = {};
foreach my $line (@{ $file }) {
chomp $line;
push (@{ $result->{filecache} }, $line);
my ($topic, $type, $ip_based, $user_based, $moderator_based, $special) = split(/:/, $line);
next if $topic !~ /^\d+$/;
if ($type eq "p" || $type eq "r") {
$result->{$topic}->{$type}->{ip}->{':list:'} = $ip_based;
$result->{$topic}->{$type}->{user}->{':list:'} = $user_based;
$result->{$topic}->{$type}->{moderator}->{':list:'} = $moderator_based;
$result->{$topic}->{$type}->{special} = $special;
foreach my $id ('ip', 'user', 'moderator') {
my @s = split(/,/, $result->{$topic}->{$type}->{$id}->{':list:'});
foreach my $s (@s) {
if ($s =~ m|^!(.*)|) {
$result->{$topic}->{$type}->{$id}->{$s} = -1;
} else {
$result->{$topic}->{$type}->{$id}->{$s} = 1;
}
}
}
} elsif ($type eq "cr") {
$result->{$topic}->{$type}->{ip}->{':list:'} = $ip_based;
} elsif ($type eq "o") {
$result->{$topic}->{'o'}->{'anon'} = 1 if $ip_based =~ m|a|i;
$result->{$topic}->{'o'}->{'email'} = 1 if $ip_based =~ m|e|i;
$result->{$topic}->{'o'}->{'fullname'} = 1 if $ip_based =~ m|f|i;
$result->{$topic}->{'o'}->{'profile'} = 1 if $ip_based =~ m|p|i;
$result->{$topic}->{'o'}->{'ip_on_post'} = $1 if $ip_based =~ m|i(\d)|i;
$result->{$topic}->{'o'}->{'ip_on_post_anon'} = $1 if $ip_based =~ m|j(\d)|i;
$result->{$topic}->{'options_string'} = $ip_based;
} elsif ($type eq "q") {
$result->{$topic}->{'q'}->{'public'} = 1 if $ip_based =~ m|p|i;
$result->{$topic}->{'q'}->{'users'} = 1 if $ip_based =~ m|u|i;
$result->{$topic}->{'q'}->{'moderators'} = 1 if $ip_based =~ m|m|i;
$result->{$topic}->{'q'}->{'special'} = 1 if $ip_based =~ m|s|i;
}
}
foreach my $topic (keys %{$result}) {
next if ref $result->{$topic} ne 'HASH';
if (! defined $result->{$topic}->{'r'}) {
my $type = 'r';
$result->{$topic}->{$type}->{ip}->{':list:'} = "*";
$result->{$topic}->{$type}->{ip}->{'*'} = 1;
$result->{$topic}->{$type}->{user}->{':list:'} = "";
$result->{$topic}->{$type}->{moderator}->{':list:'} = "";
$result->{$topic}->{$type}->{special} = "";
push @{ $result->{filecache} }, "$topic:r:*:::\n";
}
}
return $result;
}
###
### write_topic_privilege_file
###
### Low-level writing of the topic privileges file
###
sub write_topic_privilege_file {
my ($actions, $args) = @_;
my @newfile = ();
undef my $classify;
foreach my $a (@{ $actions }) {
my ($act, $topc, $type, $ip, $user, $mod, $spec) = ($a->{action}, $a->{topic}, $a->{type}, $a->{ip}, $a->{user}, $a->{moderator}, $a->{special});
foreach my $tpc (split(/,/, $topc)) {
$ip = "*" if $type eq "r" && $DCONF->{pro} == 0;
if ($act eq "add_topic" || $act eq "set_equal" || $type eq "o" || $type eq "q") {
if ($type eq "o") {
my $s = "";
if (defined $a->{define}) {
$s = $a->{define};
} else {
$s .= "a" if $a->{anon};
$s .= "e" if $a->{email};
$s .= "f" if $a->{fullname};
$s .= "p" if $a->{profile};
$s .= "i" . (0+$a->{ip_on_post});
$s .= "j" . (0+$a->{ip_on_post_anon});
}
push (@newfile, "$tpc:o:$s\n");
$classify->{$tpc}->{'o'}->{added} = 1;
} elsif ($type eq "q") {
my $s = "";
if (defined $a->{define}) {
$s = $a->{define};
} else {
$s .= "m" if $a->{moderators};
$s .= "p" if $a->{public};
$s .= "s" if $a->{special};
$s .= "u" if $a->{users};
}
push (@newfile, "$tpc:q:$s\n");
$classify->{$tpc}->{'q'}->{added} = 1;
} else {
foreach my $t (split(/,/, $type)) {
push (@newfile, "$tpc:$t:$ip:$user:$mod:$spec\n");
$classify->{$tpc}->{$t}->{added} = 1;
}
}
} else {
foreach my $t (split(/,/, $type)) {
if ($act eq "del_topic") {
$classify->{$tpc}->{'delete'} = 1;
} elsif ($act eq "add_priv") {
$classify->{$tpc}->{$t}->{'action'} = "add";
foreach my $k ('ip', 'user', 'moderator', 'special') {
$classify->{$tpc}->{$t}->{$k}->{add}->{$a->{$k}} = 1 if defined $a->{$k};
}
} elsif ($act eq "add_apriv") {
$classify->{$tpc}->{$t}->{'action'} = "adda";
foreach my $k ('ip', 'user', 'moderator', 'special') {
$classify->{$tpc}->{$t}->{$k}->{add}->{$a->{$k}} = 2 if defined $a->{$k};
}
} elsif ($act eq "del_priv") {
$classify->{$tpc}->{$t}->{'action'} = "del";
foreach my $k ('ip', 'user', 'moderator', 'special') {
$classify->{$tpc}->{$t}->{$k}->{del}->{$a->{$k}} = 0 if defined $a->{$k};
}
}
}
}
}
}
my $file = readfile("$DCONF->{admin_dir}/data/topicprv.txt", "write_topic_privilege_file", { zero_ok => 1, no_unlock => 1, create => 1 });
foreach my $line (@{ $file }) {
my $line_manip = $line; chomp $line_manip;
my ($topic, $type, $ip_based, $user_based, $moderator_based, $special) = split(/:/, $line_manip);
next if $classify->{$topic}->{'delete'};
next if $classify->{$topic}->{$type}->{added};
if (! defined $classify->{$topic}->{$type}->{action} && ! defined $classify->{$topic}->{$type}->{added}) {
push (@newfile, $line);
next;
}
if ($classify->{$topic}->{$type}->{'action'} eq "set") {
my $j = $classify->{$topic}->{$type};
$line_manip = "$topic:$type:$j->{ip}:$j->{user}:$j->{moderator}:$j->{special}\n";
push (@newfile, $line_manip);
next;
}
if ($classify->{$topic}->{$type}->{'action'} eq "add" || $classify->{$topic}->{$type}->{'action'} eq "adda" || $classify->{$topic}->{$type}->{'action'} eq "del") {
my $cta = $classify->{$topic}->{$type}->{'action'};
$cta = "add" if $cta eq "adda";
my $k = {};
$k->{'ip'} = $ip_based;
$k->{'user'} = $user_based;
$k->{'moderator'} = $moderator_based;
foreach my $m ("ip", "user", "moderator") {
my @pnew = ();
foreach my $a (split(/,/, $k->{$m})) {
if ($classify->{$topic}->{$type}->{'action'} ne "del") {
push @pnew, $a if ! $classify->{$topic}->{$type}->{$m}->{del}->{$a};
} else {
push @pnew, $a;
}
}
my $i = $classify->{$topic}->{$type}->{$m}->{$cta};
if (ref $i eq 'HASH') {
foreach my $a (keys %{$i}) {
push @pnew, $a if $classify->{$topic}->{$type}->{$m}->{add}->{$a} == 1;
unshift @pnew, $a if $classify->{$topic}->{$type}->{$m}->{add}->{$a} == 2;
}
}
$k->{$m} = join(",", @pnew);
print "$m: $k->{$m}<br>\n";
}
$line_manip = "$topic:$type:$k->{ip}:$k->{user}:$k->{moderator}:$k->{special}\n";
push @newfile, $line_manip;
next;
}
}
writefile("$DCONF->{admin_dir}/data/topicprv.txt", \@newfile, "write_topic_privilege_file", { no_lock => 1, zero_ok => 1 });
}
1;