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
/
authpass.pl
< prev
next >
Wrap
Text File
|
2009-11-06
|
18KB
|
554 lines
# FILE: authpass.pl
# DESCRIPTION: Authentication routines & read account files
#-------------------------------------------------------------------------------
# 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_password
###
### Checks a moderator or user's password against the database. Default operation
### is to update the "last access" time but not the "last search" time. Control
### these through $args->{silent} and $args->{new_message}, respectively.
###
sub check_password {
my ($username, $guess, $args, $cookies) = @_;
my $suspended = 0;
$username = prepare_userpass($username);
$guess = prepare_userpass_p($guess);
my @result = ();
return \@result if $username eq "";
my $file = "passwd,users";
$file = "passwd" if $args->{type_required} eq "moderator";
$file = "users" if $args->{type_required} eq "user";
performance_string("NOTE: Authentication of [$username :: $file] at check_password") if $GLOBAL_OPTIONS->{performance_monitoring};
my $new_message = (defined $args->{new_message} ? 1 : 0);
$new_message = 0 if defined $args->{silent};
my $timecache = time;
$username = $args->{authenticated} if $username eq "";
my $fast_update = 1;
if ($PARAMS->{'emergency_access'} && -e "$DCONF->{admin_dir}/data/emergency-fail.txt" && $DCONF->{superuser} eq $username) {
dreq("emergpw");
my $x = validate_emergency_password($guess, $cookies, $args);
if ($x ne "") {
$GLOBAL_OPTIONS->{database} = 0;
return [ { database => 'passwd', user => $username, pass => $x } ];
}
}
$GLOBAL_OPTIONS->{u_last_access_info} = 0 if ($DCONF->{pro} && $GLOBAL_OPTIONS->{database} == 1);
$fast_update = 0 if ($guess eq "" && $GLOBAL_OPTIONS->{u_last_access_info} >= 1);
$fast_update = 0 if ($cookies->{uid} ne "" && $GLOBAL_OPTIONS->{u_last_access_info} >= 2);
$fast_update = 0 if ($new_message == 0 && $GLOBAL_OPTIONS->{u_last_access_info} >= 3);
$fast_update = 1 if $new_message;
$fast_update = 0 if ($args->{no_record} == 1);
my ($u, $f);
if ($PARAMS->{'emergency_access'}) {
open (OUT, "> $DCONF->{admin_dir}/data/emergency-fail.txt");
close (OUT);
}
if ($fast_update) {
($u, $f) = read_account_file($file, { $username => 1 }, { authenticate_password => 1, update_time => 1 - $args->{silent}, new_message => $args->{new_message}, no_lock => (1 - $fast_update), no_unlock => $fast_update, dbh => $args->{dbh}, fast_update => $fast_update });
} else {
($u, $f) = read_account_file($file, { $username => 1 }, { update_time => 1 - $args->{silent}, new_message => $args->{new_message}, no_lock => 1, no_unlock => 1, dbh => $args->{dbh}, fast_update => 0 });
}
if ($PARAMS->{'emergency_access'}) {
unlink "$DCONF->{admin_dir}/data/emergency-fail.txt";
}
my $expired = 0;
foreach my $x (@{ $u->{$username} }) {
my $ok = 0;
if ($args->{authenticated} eq $username) {
$ok = 0;
} else {
my $pass = $x->{'pass'};
if ($pass =~ /^\*.*?\|\|([^\*].*)$/) {
$pass = $1;
} elsif ($pass =~ m%^(.*?)\|\|(.*)$%) {
my ($actual_pass, $temp_pass) = ($1, $2);
$pass = $actual_pass;
$pass = $' if $pass =~ m|^\*|;
}
$ok = 1 if crypt($guess, $pass) eq $pass;
$ok = 0 if $pass eq "";
$ok = 1 if $username eq $DCONF->{superuser} && $pass eq "" && $guess eq "" && $args->{blank_ok};
if ($ok == 0 && $cookies->{pass} eq crypt($pass, "cookie") && ($guess eq "" || $guess eq "adminlogin")) {
$ok = 1;
if ($GLOBAL_OPTIONS->{mod_session_expire_inactivity} > 0 && $GLOBAL_OPTIONS->{mod_session_expire}) {
if (60*$GLOBAL_OPTIONS->{mod_session_expire_inactivity} < ($timecache - $x->{atime})) {
$expired = 1; $ok = 0;
}
}
}
$ok = 0 if $guess ne "" && $pass eq "";
$ok = 1 if $cookies->{cpwd} eq crypt($pass, "cookie") && ! $args->{nocookies} && ($guess eq "" || $guess eq "adminlogin" || $guess =~ /^x+$/);
$ok = 0 if $pass eq "" && $username ne $DCONF->{superuser};
if ($PARAMS->{'emergency_access'} && $DCONF->{superuser} eq $username) {
dreq("emergpw");
my $xy = validate_emergency_password($guess, $cookies, $args);
if ($xy ne "") {
$ok = 1;
$x->{pass} = $xy;
}
}
if ($ok == 1 && $x->{pass} =~ m|^\*|) {
if ($DCONF->{pro} && ! $args->{no_dump} && $x->{pass} =~ m%^(.*?)\|\|(.*)%) {
my ($actual_pass, $temp_pass) = ($1, $2);
if ($actual_pass =~ m|^\*|) {
my @u = split(/,/, $file);
foreach my $u (@u) {
unlock("$DCONF->{admin_dir}/$u.txt");
}
return (\@result, $x, $guess) if $args->{no_suspend};
dreq("suspend-PRO");
suspended_account($x, $guess);
}
}
}
$ok = 0 if ($cookies->{access} && ! $args->{skip_naughtyboy_cookie});
}
if ($ok == 1) {
push (@result, \%{$x});
fastupdate_account_file($f, $x->{user}, { database => $x->{database}, timecache => $timecache, new_message => $new_message, dbh => $args->{dbh} }) if $fast_update;
}
}
if ($fast_update) {
if ($GLOBAL_OPTIONS->{database} == 0 || ! $DCONF->{pro}) {
fastupdate_kill($f);
} else {
dreq("sql-acct-PRO");
sql_fast_update(\@result, { update_time => 1 - $args->{silent}, new_message => $args->{new_message}, no_lock => (1 - $fast_update), no_unlock => $fast_update, dbh => $args->{dbh}, fast_update => $fast_update });
}
}
if (scalar(@result) == 0 && $expired == 1) {
dreq("admin-pl");
bad_login({session_expired => 1});
}
return \@result;
}
###
### condition_match
###
### Checks to see if a condition is met
###
sub condition_match {
my ($rec, $condition) = @_;
if (defined $condition->{suspend}) {
my @g = ();
if (ref $condition->{suspend} eq 'ARRAY') {
@g = @{$condition->{suspend}};
} elsif (ref $condition->{suspend} eq 'HASH') {
@g = keys %{$condition->{suspend}};
} else {
@g = ( $condition->{suspend} );
}
@g = map { quotemeta($_) } @g;
foreach my $pat (@g) {
return 0 if $rec->{pass} !~ m%^\*.*\|\|$pat%;
}
}
if (defined $condition->{nosuspend}) {
my @g = ();
if (ref $condition->{nosuspend} eq 'ARRAY') {
@g = @{$condition->{nosuspend}};
} elsif (ref $condition->{nosuspend} eq 'HASH') {
@g = keys %{$condition->{nosuspend}};
} else {
@g = ( $condition->{nosuspend} );
}
@g = map { quotemeta($_) } @g;
foreach my $pat (@g) {
return 0 if $rec->{pass} =~ m%^\*.*\|\|$pat%;
}
}
if (defined $condition->{group}) {
my @g = ref $condition->{group} eq 'ARRAY' ? @{$condition->{group}} : ($condition->{group});
my %x = map { $_, 1 } grep { /\S/ } split(/\//, $rec->{groups});
my $flag = 0;
foreach my $g (@g) {
if ($x{$g->{group}} == 1) {
$flag = 1; last;
}
}
return 0 if $flag == 0;
}
return 1;
}
###
### grab_fields
###
### Gets desired fields from account query
###
sub grab_fields {
my ($record_in, $param_ref) = @_;
return $record_in if ref $param_ref->{return_fields} ne 'HASH';
my %z = map { $_, $record_in->{$_} } keys %{$param_ref->{return_fields}};
return \%z;
}
###
### read_account_file
###
### Reads in users.txt, passwd.txt, or the database and returns selected users
### or all users in a convenient format. Use of this routine to read the user
### base makes the rest of the functions independent of whether you are using
### the MySQL back end, flat text files, or separated text files.
###
sub read_account_file {
my ($database, $username_ref, $param_ref) = @_;
undef my $result;
$PARAMS->{dbh} = database_dbh();
my $fast_update = {};
$param_ref->{returnformat} = "standard" if $param_ref->{returnformat} eq "";
if ($GLOBAL_OPTIONS->{database} == 1 && $DCONF->{pro}) {
dreq("sql-acct-PRO");
return sql_read_account_file($database, $username_ref, $param_ref);
} else {
my @files = ();
if ($DCONF->{pro} && $GLOBAL_OPTIONS->{split_user_files} && $database =~ m|users|) {
dreq("userfile-PRO");
@files = userfile_build_list($database, $username_ref);
} else {
my @f = split(/,/, $database);
foreach my $l (@f) {
push (@files, "$DCONF->{admin_dir}/$l.txt");
}
}
foreach my $file (@files) {
my $data = undef;
my $tellresult = undef;
my $db_read = ($file =~ m|passwd| ? "passwd" : "users");
$data = readfile($file, "read_account_file", { no_lock => $param_ref->{no_lock}, no_unlock => $param_ref->{no_unlock}, zero_ok => 1, create => 1, 'tell' => 0 }) if ! $param_ref->{fast_update};
($data, $tellresult) = readfile($file, "read_account_file", { no_unlock => 1, zero_ok => 1, create => 1, 'tell' => 1 }) if $param_ref->{fast_update};
my $w = 0;
W: while (my $k = shift @{ $data }) {
my @k = split(/:/, $k, 2);
next if $k[0] eq "#";
my $teller = defined $tellresult ? shift @{ $tellresult } : undef;
if (defined $username_ref) {
next W if ! $username_ref->{$k[0]};
}
my $ref = user_line_as_hash($k);
next W if $ref->{user} eq "DISABLEANON";
next W if $ref->{user} eq "UPDATED300";
next W if $ref->{user} eq "PUBLIC";
if (defined $param_ref->{condition}) {
next W if ! condition_match($ref, $param_ref->{condition});
}
$ref->{database} = $db_read;
push (@{ $result->{ $ref->{user} } }, \%{ $ref }) if $param_ref->{returnformat} eq "standard";
$result->{ $ref->{user} } = \%{ $ref } if $param_ref->{returnformat} eq "single_hash";
push (@{ $result }, \%{ $ref }) if $param_ref->{returnformat} eq "single_array";
if ($param_ref->{fast_update}) {
my $l = undef;
if (defined $fast_update->{$ref->{user}}->{file}) {
if (ref $fast_update->{$ref->{user}}->{file} eq 'ARRAY') {
my @i = @{$fast_update->{$ref->{user}}->{file}};
push @i, $file;
$l->{file} = \@i;
} else {
my @i = ($fast_update->{$ref->{user}}->{file});
push @i, $file;
$l->{file} = \@i;
}
} else {
$l->{file} = $file;
}
if (defined $fast_update->{$ref->{user}}->{position}) {
if (ref $fast_update->{$ref->{user}}->{position} eq 'ARRAY') {
my @i = @{$fast_update->{$ref->{user}}->{position}};
push @i, $teller;
$l->{position} = \@i;
} else {
my @i = ($fast_update->{$ref->{user}}->{position});
push @i, $teller;
$l->{position} = \@i;
}
} else {
$l->{position} = $teller;
}
if (defined $fast_update->{$ref->{user}}->{uline}) {
if (ref $fast_update->{$ref->{user}}->{uline} eq 'ARRAY') {
my @i = @{$fast_update->{$ref->{user}}->{uline}};
push @i, $k;
$l->{uline} = \@i;
} else {
my @i = ($fast_update->{$ref->{user}}->{uline});
push @i, $k;
$l->{uline} = \@i;
}
} else {
$l->{uline} = $k;
}
$fast_update->{$ref->{user}} = $l;
$w++;
}
}
if ($w == 0) {
unlock($file) if $param_ref->{fast_update};
}
}
return $result if ! $param_ref->{fast_update};
return ($result, $fast_update);
}
}
###
### user_line_as_hash
###
### Converts a line of raw input to a useful, easy manipulated hash
###
sub user_line_as_hash {
my @r = ();
my @s = ('user', 'pass', 'email', 'fullname', 'edit', 'notify', 'ctime', 'stime', 'atime', 'groups');
my $ss = scalar(@s);
while (my $x = shift) {
chomp $x;
my @x = split(/:/, $x, $ss);
my @stemp = @s;
undef my $i;
while (my $s = shift @s) {
$i->{$s} = shift @x;
$i->{$s} = "" if $s eq "email" && $i->{$s} eq "email";
$i->{$s} = "" if $s eq "fullname" && $i->{$s} eq "fullname";
}
if ($i->{stime} =~ /\D/) {
$i->{ip_addr} = $i->{stime}; $i->{stime} = 0;
}
if ($i->{atime} =~ /\D/) {
$i->{ip_host} = $i->{atime}; $i->{atime} = 0;
}
$i->{ctime} = $' if $i->{ctime} =~ /.*\D/;
push (@r, $i);
}
return $r[0] if scalar(@r) == 1;
return \@r;
}
###
### generate_user_line
###
### Inverse of user_line_as_hash; turns a hash into a line to write into users.txt, etc.
###
sub generate_user_line {
my ($hashref) = @_;
my @s = ('user', 'pass', 'email', 'fullname', 'edit', 'notify', 'ctime', 'stime', 'atime', 'groups');
my @r = ();
foreach my $s (@s) {
push (@r, $hashref->{$s});
}
return join("", join(":", @r), "\n");
}
###
### prepare_userpass
###
### Removes certain non-alphanumeric characters and converts to lower case
###
sub prepare_userpass {
my @out = ();
my $z = chr(0);
my $y = quotemeta(chr(47));
my $w = quotemeta(chr(58));
my $v = quotemeta(chr(94));
my $u = quotemeta(chr(96));
my $t = quotemeta(chr(123));
my $s = quotemeta(chr(125));
while (my $x = shift @_) {
$x =~ s/^\s+//;
$x =~ s/\s+$//;
$x = case_lower($x);
$x =~ s/\s+/_/g;
$x =~ s/[$z-$y$w-$v$u$t-$s]//g;
push (@out, $x);
}
return @out if scalar(@out) > 1;
return $out[0] if scalar(@out) <= 1;
}
###
### prepare_userpass_p
###
### Password version of 'prepare_userpass_p' which recognizes an option
### to SKIP the conversion of the username to lower-case letters
###
sub prepare_userpass_p {
my @out = @_;
if ($GLOBAL_OPTIONS->{password_no_prepare}) {
return $out[0] if scalar @out <= 1;
return @out;
}
return prepare_userpass(@out);
}
###
### lpad
###
### Pads a string on the left with a given character so that the string will
### always have the correct length. Used for fixed-width fields.
###
sub lpad {
my ($st, $ch, $len) = @_;
if (length($st) < $len) {
return join("", $ch x ($len - length($st)), $st);
} elsif ($len > $ch) {
return substr($st, 0, $len);
} else {
return $st;
}
}
###
### userpass_field_dump
###
### Names of the fields in the user database
###
sub userpass_field_dump {
my $string = "user pass email fullname edit notify ctime stime atime groups picture";
$string .= " prefs favorites signature status posts ";
for (my $i = 1; $i <= 20; $i++) {
$string .= "personal$i\n";
}
for (my $i = 1; $i <= 10; $i++) {
$string .= "custom$i\n";
$string .= "customdesc$i\n";
}
my @fields = split(/\s+/, $string);
@fields = grep(/\S/, @fields);
return \@fields;
}
###
### fastupdate_kill
###
### Called when there is no more fast updating to be done.
###
sub fastupdate_kill {
my ($fastupdate) = @_;
if ($GLOBAL_OPTIONS->{database} == 1 && $DCONF->{pro}) {
my $dbh = $fastupdate->{dbh};
return 0 if ! defined $dbh;
return 1;
} else {
my $unlocked = undef;
foreach my $k (keys(%{ $fastupdate })) {
my @f = ref $fastupdate->{$k}->{file} eq 'ARRAY' ? @{$fastupdate->{$k}->{file}} : ($fastupdate->{$k}->{file});
foreach my $fi (@f) {
next if $unlocked->{$fi};
unlock($fi);
$unlocked->{$fi} = 1;
}
}
}
}
###
### fastupdate_account_file
###
### Performs a fast update of the account file to set the last access time of
### a moderator or user.
###
sub fastupdate_account_file {
my ($fastupdate, $user, $params) = @_;
return 0 if $params->{database} eq "";
return 0 if ($GLOBAL_OPTIONS->{no_update_access_time} && ! $params->{new_message});
return 0 if ($GLOBAL_OPTIONS->{database} && $DCONF->{pro});
my $timecache = defined $params->{timecache} ? $params->{timecache} : time;
if (ref $fastupdate->{$user}->{file} eq 'ARRAY') {
my @fi = @{ $fastupdate->{$user}->{file} };
my @ul = @{ $fastupdate->{$user}->{uline} };
my @ps = @{ $fastupdate->{$user}->{position} };
foreach my $fi (@fi) {
my $o = {};
$o->{file} = $fi;
$o->{uline} = shift @ul;
$o->{position} = shift @ps;
next if $fi =~ /users\.txt/ && $params->{database} ne "users";
next if $fi =~ /passwd\.txt/ && $params->{database} ne "passwd";
_fastupd($fi, $o, $timecache, $params);
}
} else {
_fastupd($fastupdate->{$user}->{file}, $fastupdate->{$user}, $timecache, $params);
}
}
sub _fastupd {
my ($fi, $fu, $timecache, $params) = @_;
my $ref = user_line_as_hash($fu->{uline});
$ref->{atime} = lpad($timecache, "0", 10);
$ref->{stime} = lpad($timecache, "0", 10) if $params->{new_message};
my $linenew = generate_user_line($ref);
if (length $fu->{uline} == length $linenew && can_seek_tell()) {
sysopen FASTUPDATE, $fi, 2;
seek FASTUPDATE, $fu->{position}, 0;
syswrite FASTUPDATE, $linenew, length($linenew);
close FASTUPDATE;
} else {
$ref->{action} = "update";
dreq("fcn-acct");
write_account_file($params->{database}, [ $ref ], { fastupdate => 1 });
}
performance_string("> fastupdate_account_file for $ref->{user}, $fu->{position}, $fi");
$PARAMS->{file_access}->{$fi}->{write}++;
$PARAMS->{files_written}++;
$PARAMS->{file_access}->{$fi}->{read} += 0;
}
###
### can_seek_tell
###
### Checks to see if the seek/tell routine can be used for fast updates
### Note (4.00.b26+): due to many problems with this routine, we are disabling
### it by default. To enable, add "can_seek_tell=1" to your discus.conf file,
### without the quotes.
###
sub can_seek_tell {
return 0 if ! defined $DCONF->{can_seek_tell};
return $DCONF->{can_seek_tell};
return $PARAMS->{can_seek_tell} if defined $PARAMS->{can_seek_tell};
return $DCONF->{can_seek_tell} if defined $DCONF->{can_seek_tell};
return 0 if $DCONF->{NT} || $DCONF->{platform} eq "NT";
return 0 if $^O eq "MSWin32";
my $checksum = 0;
foreach my $k (keys %{$DCONF}) {
$checksum += unpack("%16C*", $DCONF->{$k});
}
my $cst = join("_", $checksum, "can_seek_tell");
if (defined $GLOBAL_OPTIONS->{$cst}) {
$PARAMS->{can_seek_tell} = $GLOBAL_OPTIONS->{$cst};
} else {
dreq("adm-misc", "adm-opts");
my $can = test_seek_tell();
options_save({ $cst => $can });
$PARAMS->{can_seek_tell} = $can;
}
}
1;