loncom/lond - diff

Return to lond CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.374 and 1.398

version 1.374, 2007/05/31 05:17:48	version 1.398, 2008/03/08 03:17:38
Line 33 use strict;	Line 33 use strict;
use lib '/home/httpd/lib/perl/';	use lib '/home/httpd/lib/perl/';
use LONCAPA;	use LONCAPA;
use LONCAPA::Configuration;	use LONCAPA::Configuration;
use Apache::lonnet;

use IO::Socket;	use IO::Socket;
use IO::File;	use IO::File;
Line 53 use File::Find;	Line 52 use File::Find;
use LONCAPA::lonlocal;	use LONCAPA::lonlocal;
use LONCAPA::lonssl;	use LONCAPA::lonssl;
use Fcntl qw(:flock);	use Fcntl qw(:flock);
	use Apache::lonnet;

my $DEBUG = 0; # Non zero to enable debug log entries.	my $DEBUG = 0; # Non zero to enable debug log entries.

Line 135 my @adderrors = ("ok",	Line 135 my @adderrors = ("ok",
"lcuseradd Unable to make www member of users's group",	"lcuseradd Unable to make www member of users's group",
"lcuseradd Unable to su to root",	"lcuseradd Unable to su to root",
"lcuseradd Unable to set password",	"lcuseradd Unable to set password",
"lcuseradd Usrname has invalid characters",	"lcuseradd Username has invalid characters",
"lcuseradd Password has an invalid character",	"lcuseradd Password has an invalid character",
"lcuseradd User already exists",	"lcuseradd User already exists",
"lcuseradd Could not add user.",	"lcuseradd Could not add user.",
Line 996 sub ping_handler {	Line 996 sub ping_handler {
my ($cmd, $tail, $client) = @_;	my ($cmd, $tail, $client) = @_;
Debug("$cmd $tail $client .. $currenthostid:");	Debug("$cmd $tail $client .. $currenthostid:");

Reply( $client,"$currenthostid\n","$cmd:$tail");	Reply( $client,\$currenthostid,"$cmd:$tail");

return 1;	return 1;
}	}
Line 1066 sub establish_key_handler {	Line 1066 sub establish_key_handler {
$key=substr($key,0,32);	$key=substr($key,0,32);
my $cipherkey=pack("H32",$key);	my $cipherkey=pack("H32",$key);
$cipher=new IDEA $cipherkey;	$cipher=new IDEA $cipherkey;
&Reply($replyfd, "$buildkey\n", "$cmd:$tail");	&Reply($replyfd, \$buildkey, "$cmd:$tail");

return 1;	return 1;

Line 1103 sub load_handler {	Line 1103 sub load_handler {

my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'};	my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'};

&Reply( $replyfd, "$loadpercent\n", "$cmd:$tail");	&Reply( $replyfd, \$loadpercent, "$cmd:$tail");

return 1;	return 1;
}	}
Line 1133 sub user_load_handler {	Line 1133 sub user_load_handler {
my ($cmd, $tail, $replyfd) = @_;	my ($cmd, $tail, $replyfd) = @_;

my $userloadpercent=&Apache::lonnet::userload();	my $userloadpercent=&Apache::lonnet::userload();
&Reply($replyfd, "$userloadpercent\n", "$cmd:$tail");	&Reply($replyfd, \$userloadpercent, "$cmd:$tail");

return 1;	return 1;
}	}
Line 1176 sub user_authorization_type {	Line 1176 sub user_authorization_type {
} else {	} else {
$type .= ':';	$type .= ':';
}	}
&Reply( $replyfd, "$type\n", $userinput);	&Reply( $replyfd, \$type, $userinput);
}	}

return 1;	return 1;
Line 1212 sub push_file_handler {	Line 1212 sub push_file_handler {
# process making the request.	# process making the request.

my $reply = &PushFile($userinput);	my $reply = &PushFile($userinput);
&Reply($client, "$reply\n", $userinput);	&Reply($client, \$reply, $userinput);

} else {	} else {
&Failure( $client, "refused\n", $userinput);	&Failure( $client, "refused\n", $userinput);
Line 1264 sub du_handler {	Line 1264 sub du_handler {
chdir($ududir);	chdir($ududir);
find($code,$ududir);	find($code,$ududir);
$total_size=int($total_size/1024);	$total_size=int($total_size/1024);
&Reply($client,"$total_size\n","$cmd:$ududir");	&Reply($client,\$total_size,"$cmd:$ududir");
} else {	} else {
&Failure($client, "bad_directory:$ududir\n","$cmd:$ududir");	&Failure($client, "bad_directory:$ududir\n","$cmd:$ududir");
}	}
Line 1333 sub ls_handler {	Line 1333 sub ls_handler {
$ulsout='no_such_dir';	$ulsout='no_such_dir';
}	}
if ($ulsout eq '') { $ulsout='empty'; }	if ($ulsout eq '') { $ulsout='empty'; }
&Reply($client, "$ulsout\n", $userinput); # This supports debug logging.	&Reply($client, \$ulsout, $userinput); # This supports debug logging.

return 1;	return 1;

Line 1402 sub ls2_handler {	Line 1402 sub ls2_handler {
$ulsout='no_such_dir';	$ulsout='no_such_dir';
}	}
if ($ulsout eq '') { $ulsout='empty'; }	if ($ulsout eq '') { $ulsout='empty'; }
&Reply($client, "$ulsout\n", $userinput); # This supports debug logging.	&Reply($client, \$ulsout, $userinput); # This supports debug logging.
return 1;	return 1;
}	}
&register_handler("ls2", \&ls2_handler, 0, 1, 0);	&register_handler("ls2", \&ls2_handler, 0, 1, 0);
Line 1430 sub reinit_process_handler {	Line 1430 sub reinit_process_handler {
if(&ValidManager($cert)) {	if(&ValidManager($cert)) {
chomp($userinput);	chomp($userinput);
my $reply = &ReinitProcess($userinput);	my $reply = &ReinitProcess($userinput);
&Reply( $client, "$reply\n", $userinput);	&Reply( $client, \$reply, $userinput);
} else {	} else {
&Failure( $client, "refused\n", $userinput);	&Failure( $client, "refused\n", $userinput);
}	}
Line 1514 sub authenticate_handler {	Line 1514 sub authenticate_handler {
# udom - User's domain.	# udom - User's domain.
# uname - Username.	# uname - Username.
# upass - User's password.	# upass - User's password.
	# checkdefauth - Pass to validate_user() to try authentication
	# with default auth type(s) if no user account.

my ($udom,$uname,$upass)=split(/:/,$tail);	my ($udom, $uname, $upass, $checkdefauth)=split(/:/,$tail);
&Debug(" Authenticate domain = $udom, user = $uname, password = $upass");	&Debug(" Authenticate domain = $udom, user = $uname, password = $upass");
chomp($upass);	chomp($upass);
$upass=&unescape($upass);	$upass=&unescape($upass);

my $pwdcorrect = &validate_user($udom, $uname, $upass);	my $pwdcorrect = &validate_user($udom,$uname,$upass,$checkdefauth);
if($pwdcorrect) {	if($pwdcorrect) {
&Reply( $client, "authorized\n", $userinput);	&Reply( $client, "authorized\n", $userinput);
#	#
Line 1605 sub change_password_handler {	Line 1607 sub change_password_handler {
my $result = &change_unix_password($uname, $npass);	my $result = &change_unix_password($uname, $npass);
&logthis("Result of password change for $uname: ".	&logthis("Result of password change for $uname: ".
$result);	$result);
&Reply($client, "$result\n", $userinput);	&Reply($client, \$result, $userinput);
} else {	} else {
# this just means that the current password mode is not	# this just means that the current password mode is not
# one we know how to change (e.g the kerberos auth modes or	# one we know how to change (e.g the kerberos auth modes or
Line 1666 sub add_user_handler {	Line 1668 sub add_user_handler {
}	}
unless ($fperror) {	unless ($fperror) {
my $result=&make_passwd_file($uname, $umode,$npass, $passfilename);	my $result=&make_passwd_file($uname, $umode,$npass, $passfilename);
&Reply($client, $result, $userinput); #BUGBUG - could be fail	&Reply($client,\$result, $userinput); #BUGBUG - could be fail
} else {	} else {
&Failure($client, "$fperror\n", $userinput);	&Failure($client, \$fperror, $userinput);
}	}
}	}
umask($oldumask);	umask($oldumask);
Line 1735 sub change_authentication_handler {	Line 1737 sub change_authentication_handler {
my $result = &change_unix_password($uname, $npass);	my $result = &change_unix_password($uname, $npass);
&logthis("Result of password change for $uname: ".$result);	&logthis("Result of password change for $uname: ".$result);
if ($result eq "ok") {	if ($result eq "ok") {
&Reply($client, "$result\n")	&Reply($client, \$result);
} else {	} else {
&Failure($client, "$result\n");	&Failure($client, \$result);
}	}
} else {	} else {
my $result=&make_passwd_file($uname, $umode,$npass,$passfilename);	my $result=&make_passwd_file($uname, $umode,$npass,$passfilename);
Line 1756 sub change_authentication_handler {	Line 1758 sub change_authentication_handler {
&manage_permissions("/$udom/_au", $udom, $uname, "$umode:");	&manage_permissions("/$udom/_au", $udom, $uname, "$umode:");
}	}
}	}
&Reply($client, $result, $userinput);	&Reply($client, \$result, $userinput);
}	}


Line 2095 sub rename_user_file_handler {	Line 2097 sub rename_user_file_handler {
&register_handler("renameuserfile", \&rename_user_file_handler, 0,1,0);	&register_handler("renameuserfile", \&rename_user_file_handler, 0,1,0);

#	#
	# Checks if the specified user has an active session on the server
	# return ok if so, not_found if not
	#
	# Parameters:
	# cmd - The request keyword that dispatched to tus.
	# tail - The tail of the request (colon separated parameters).
	# client - Filehandle open on the client.
	# Return:
	# 1.
	sub user_has_session_handler {
	my ($cmd, $tail, $client) = @_;

	my ($udom, $uname) = map { &unescape($_) } (split(/:/, $tail));

	&logthis("Looking for $udom $uname");
	opendir(DIR,$perlvar{'lonIDsDir'});
	my $filename;
	while ($filename=readdir(DIR)) {
	last if ($filename=~/^\Q$uname\E_\d+_\Q$udom\E_/);
	}
	if ($filename) {
	&Reply($client, "ok\n", "$cmd:$tail");
	} else {
	&Failure($client, "not_found\n", "$cmd:$tail");
	}
	return 1;

	}
	&register_handler("userhassession", \&user_has_session_handler, 0,1,0);

	#
# Authenticate access to a user file by checking that the token the user's	# Authenticate access to a user file by checking that the token the user's
# passed also exists in their session file	# passed also exists in their session file
#	#
Line 2110 sub token_auth_user_file_handler {	Line 2143 sub token_auth_user_file_handler {
my ($fname, $session) = split(/:/, $tail);	my ($fname, $session) = split(/:/, $tail);

chomp($session);	chomp($session);
my $reply="non_auth\n";	my $reply="non_auth";
my $file = $perlvar{'lonIDsDir'}.'/'.$session.'.id';	my $file = $perlvar{'lonIDsDir'}.'/'.$session.'.id';
if (open(ENVIN,"$file")) {	if (open(ENVIN,"$file")) {
flock(ENVIN,LOCK_SH);	flock(ENVIN,LOCK_SH);
tie(my %disk_env,'GDBM_File',"$file",&GDBM_READER(),0640);	tie(my %disk_env,'GDBM_File',"$file",&GDBM_READER(),0640);
if (exists($disk_env{"userfile.$fname"})) {	if (exists($disk_env{"userfile.$fname"})) {
$reply="ok\n";	$reply="ok";
} else {	} else {
foreach my $envname (keys(%disk_env)) {	foreach my $envname (keys(%disk_env)) {
if ($envname=~ m\|^userfile\.\Q$fname\E\|) {	if ($envname=~ m\|^userfile\.\Q$fname\E\|) {
$reply="ok\n";	$reply="ok";
last;	last;
}	}
}	}
}	}
untie(%disk_env);	untie(%disk_env);
close(ENVIN);	close(ENVIN);
&Reply($client, $reply, "$cmd:$tail");	&Reply($client, \$reply, "$cmd:$tail");
} else {	} else {
&Failure($client, "invalid_token\n", "$cmd:$tail");	&Failure($client, "invalid_token\n", "$cmd:$tail");
}	}
Line 2187 sub subscribe_handler {	Line 2220 sub subscribe_handler {
&register_handler("sub", \&subscribe_handler, 0, 1, 0);	&register_handler("sub", \&subscribe_handler, 0, 1, 0);

#	#
# Determine the version of a resource (?) Or is it return	# Determine the latest version of a resource (it looks for the highest
# the top version of the resource? Not yet clear from the	# past version and then returns that +1)
# code in currentversion.
#	#
# Parameters:	# Parameters:
# $cmd - The command that got us here.	# $cmd - The command that got us here.
# $tail - Tail of the command (remaining parameters).	# $tail - Tail of the command (remaining parameters).
	# (Should consist of an absolute path to a file)
# $client - File descriptor connected to client.	# $client - File descriptor connected to client.
# Returns	# Returns
# 0 - Requested to exit, caller should shut down.	# 0 - Requested to exit, caller should shut down.
Line 2551 sub get_profile_entry {	Line 2584 sub get_profile_entry {
my ($udom,$uname,$namespace,$what) = split(/:/,$tail);	my ($udom,$uname,$namespace,$what) = split(/:/,$tail);
chomp($what);	chomp($what);


my $replystring = read_profile($udom, $uname, $namespace, $what);	my $replystring = read_profile($udom, $uname, $namespace, $what);
my ($first) = split(/:/,$replystring);	my ($first) = split(/:/,$replystring);
if($first ne "error") {	if($first ne "error") {
&Reply($client, "$replystring\n", $userinput);	&Reply($client, \$replystring, $userinput);
} else {	} else {
&Failure($client, $replystring." while attempting get\n", $userinput);	&Failure($client, $replystring." while attempting get\n", $userinput);
}	}
Line 2694 sub get_profile_keys {	Line 2728 sub get_profile_keys {
}	}
if (&untie_user_hash($hashref)) {	if (&untie_user_hash($hashref)) {
$qresult=~s/\&$//;	$qresult=~s/\&$//;
&Reply($client, "$qresult\n", $userinput);	&Reply($client, \$qresult, $userinput);
} else {	} else {
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".	&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
"while attempting keys\n", $userinput);	"while attempting keys\n", $userinput);
Line 2764 sub dump_profile_database {	Line 2798 sub dump_profile_database {
}	}
}	}
chop($qresult);	chop($qresult);
&Reply($client , "$qresult\n", $userinput);	&Reply($client , \$qresult, $userinput);
} else {	} else {
&Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".	&Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
"while attempting currentdump\n", $userinput);	"while attempting currentdump\n", $userinput);
Line 2847 sub dump_with_regexp {	Line 2881 sub dump_with_regexp {
}	}
if (&untie_user_hash($hashref)) {	if (&untie_user_hash($hashref)) {
chop($qresult);	chop($qresult);
&Reply($client, "$qresult\n", $userinput);	&Reply($client, \$qresult, $userinput);
} else {	} else {
&Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".	&Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
"while attempting dump\n", $userinput);	"while attempting dump\n", $userinput);
Line 3055 sub restore_handler {	Line 3089 sub restore_handler {
}	}
if (&untie_user_hash($hashref)) {	if (&untie_user_hash($hashref)) {
$qresult=~s/\&$//;	$qresult=~s/\&$//;
&Reply( $client, "$qresult\n", $userinput);	&Reply( $client, \$qresult, $userinput);
} else {	} else {
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".	&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
"while attempting restore\n", $userinput);	"while attempting restore\n", $userinput);
Line 3136 sub retrieve_chat_handler {	Line 3170 sub retrieve_chat_handler {
$reply.=&escape($_).':';	$reply.=&escape($_).':';
}	}
$reply=~s/\:$//;	$reply=~s/\:$//;
&Reply($client, $reply."\n", $userinput);	&Reply($client, \$reply, $userinput);


return 1;	return 1;
Line 3273 sub put_course_id_handler {	Line 3307 sub put_course_id_handler {
foreach my $pair (@pairs) {	foreach my $pair (@pairs) {
my ($key,$courseinfo) = split(/=/,$pair,2);	my ($key,$courseinfo) = split(/=/,$pair,2);
$courseinfo =~ s/=/:/g;	$courseinfo =~ s/=/:/g;
	if (defined($hashref->{$key})) {
	my $value = &Apache::lonnet::thaw_unescape($hashref->{$key});
	if (ref($value) eq 'HASH') {
	my @items = ('description','inst_code','owner','type');
	my @new_items = split(/:/,$courseinfo,-1);
	my %storehash;
	for (my $i=0; $i<@new_items; $i++) {
	$storehash{$items[$i]} = &unescape($new_items[$i]);
	}
	$hashref->{$key} =
	&Apache::lonnet::freeze_escape(\%storehash);
	my $unesc_key = &unescape($key);
	$hashref->{&escape('lasttime:'.$unesc_key)} = $now;
	next;
	}
	}
my @current_items = split(/:/,$hashref->{$key},-1);	my @current_items = split(/:/,$hashref->{$key},-1);
shift(@current_items); # remove description	shift(@current_items); # remove description
pop(@current_items); # remove last access	pop(@current_items); # remove last access
Line 3289 sub put_course_id_handler {	Line 3339 sub put_course_id_handler {
}	}
}	}
}	}
$hashref->{$key}=$courseinfo.':'.$now;	$hashref->{$key}=$courseinfo.':'.$now;
}	}
if (&untie_domain_hash($hashref)) {	if (&untie_domain_hash($hashref)) {
&Reply( $client, "ok\n", $userinput);	&Reply( $client, "ok\n", $userinput);
Line 3303 sub put_course_id_handler {	Line 3353 sub put_course_id_handler {
." tie(GDBM) Failed ".	." tie(GDBM) Failed ".
"while attempting courseidput\n", $userinput);	"while attempting courseidput\n", $userinput);
}	}


return 1;	return 1;
}	}
&register_handler("courseidput", \&put_course_id_handler, 0, 1, 0);	&register_handler("courseidput", \&put_course_id_handler, 0, 1, 0);

	sub put_course_id_hash_handler {
	my ($cmd, $tail, $client) = @_;
	my $userinput = "$cmd:$tail";
	my ($udom,$mode,$what) = split(/:/, $tail,3);
	chomp($what);
	my $now=time;
	my @pairs=split(/\&/,$what);
	my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());
	if ($hashref) {
	foreach my $pair (@pairs) {
	my ($key,$value)=split(/=/,$pair);
	my $unesc_key = &unescape($key);
	if ($mode ne 'timeonly') {
	if (!defined($hashref->{&escape('lasttime:'.$unesc_key)})) {
	my $curritems = &Apache::lonnet::thaw_unescape($key);
	if (ref($curritems) ne 'HASH') {
	my @current_items = split(/:/,$hashref->{$key},-1);
	my $lasttime = pop(@current_items);
	$hashref->{&escape('lasttime:'.$unesc_key)} = $lasttime;
	} else {
	$hashref->{&escape('lasttime:'.$unesc_key)} = '';
	}
	}
	$hashref->{$key} = $value;
	}
	if ($mode ne 'notime') {
	$hashref->{&escape('lasttime:'.$unesc_key)} = $now;
	}
	}
	if (&untie_domain_hash($hashref)) {
	&Reply($client, "ok\n", $userinput);
	} else {
	&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
	"while attempting courseidputhash\n", $userinput);
	}
	} else {
	&Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
	"while attempting courseidputhash\n", $userinput);
	}
	return 1;
	}
	&register_handler("courseidputhash", \&put_course_id_hash_handler, 0, 1, 0);

# Retrieves the value of a course id resource keyword pattern	# Retrieves the value of a course id resource keyword pattern
# defined since a starting date. Both the starting date and the	# defined since a starting date. Both the starting date and the
# keyword pattern are optional. If the starting date is not supplied it	# keyword pattern are optional. If the starting date is not supplied it
Line 3335 sub put_course_id_handler {	Line 3427 sub put_course_id_handler {
# owner matches the supplied username and/or domain	# owner matches the supplied username and/or domain
# will be returned. Pre-2.2.0 legacy entries from	# will be returned. Pre-2.2.0 legacy entries from
# nohist_courseiddump will only contain usernames.	# nohist_courseiddump will only contain usernames.
	# type - optional parameter for selection
	# regexp_ok - if true, allow the supplied institutional code
	# filter to behave as a regular expression.
	# rtn_as_hash - whether to return the information available for
	# each matched item as a frozen hash of all
	# key, value pairs in the item's hash, or as a
	# colon-separated list of (in order) description,
	# institutional code, and course owner.
	#
# $client - The socket open on the client.	# $client - The socket open on the client.
# Returns:	# Returns:
# 1 - Continue processing.	# 1 - Continue processing.
Line 3342 sub put_course_id_handler {	Line 3443 sub put_course_id_handler {
# a reply is written to $client.	# a reply is written to $client.
sub dump_course_id_handler {	sub dump_course_id_handler {
my ($cmd, $tail, $client) = @_;	my ($cmd, $tail, $client) = @_;

my $userinput = "$cmd:$tail";	my $userinput = "$cmd:$tail";

my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,	my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,
$typefilter,$regexp_ok) =split(/:/,$tail);	$typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly) =split(/:/,$tail);
	my $now = time;
if (defined($description)) {	if (defined($description)) {
$description=&unescape($description);	$description=&unescape($description);
} else {	} else {
Line 3386 sub dump_course_id_handler {	Line 3487 sub dump_course_id_handler {
if (defined($regexp_ok)) {	if (defined($regexp_ok)) {
$regexp_ok=&unescape($regexp_ok);	$regexp_ok=&unescape($regexp_ok);
}	}
	my $unpack = 1;
unless (defined($since)) { $since=0; }	if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' &&
	$typefilter eq '.') {
	$unpack = 0;
	}
	if (!defined($since)) { $since=0; }
my $qresult='';	my $qresult='';
my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());	my $hashref = &tie_domain_hash($udom, "nohist_courseids", &GDBM_WRCREAT());
if ($hashref) {	if ($hashref) {
while (my ($key,$value) = each(%$hashref)) {	while (my ($key,$value) = each(%$hashref)) {
my ($descr,$lasttime,$inst_code,$owner,$type);	my ($unesc_key,$lasttime_key,$lasttime,$is_hash,%val,
my @courseitems = split(/:/,$value);	%unesc_val,$selfenroll_end,$selfenroll_types);
$lasttime = pop(@courseitems);	$unesc_key = &unescape($key);
($descr,$inst_code,$owner,$type)=@courseitems;	if ($unesc_key =~ /^lasttime:/) {
if ($lasttime<$since) { next; }	next;
	} else {
	$lasttime_key = &escape('lasttime:'.$unesc_key);
	}
	if ($hashref->{$lasttime_key} ne '') {
	$lasttime = $hashref->{$lasttime_key};
	next if ($lasttime<$since);
	}
	my $items = &Apache::lonnet::thaw_unescape($value);
	if (ref($items) eq 'HASH') {
	$is_hash = 1;
	if ($unpack \|\| !$rtn_as_hash) {
	$unesc_val{'descr'} = $items->{'description'};
	$unesc_val{'inst_code'} = $items->{'inst_code'};
	$unesc_val{'owner'} = $items->{'owner'};
	$unesc_val{'type'} = $items->{'type'};
	$selfenroll_types = $items->{'selfenroll_types'};
	$selfenroll_end = $items->{'selfenroll_end_date'};
	if ($selfenrollonly) {
	next if (!$selfenroll_types);
	if (($selfenroll_end > 0) && ($selfenroll_end <= $now)) {
	next;
	}
	}
	}
	} else {
	$is_hash = 0;
	my @courseitems = split(/:/,$value);
	$lasttime = pop(@courseitems);
	next if ($lasttime<$since);
	($val{'descr'},$val{'inst_code'},$val{'owner'},$val{'type'}) = @courseitems;
	}
my $match = 1;	my $match = 1;
unless ($description eq '.') {	if ($description ne '.') {
my $unescapeDescr = &unescape($descr);	if (!$is_hash) {
unless (eval('$unescapeDescr=~/\Q$description\E/i')) {	$unesc_val{'descr'} = &unescape($val{'descr'});
	}
	if (eval{$unesc_val{'descr'} !~ /\Q$description\E/i}) {
$match = 0;	$match = 0;
}	}
}	}
unless ($instcodefilter eq '.' \|\| !defined($instcodefilter)) {	if ($instcodefilter ne '.') {
my $unescapeInstcode = &unescape($inst_code);	if (!$is_hash) {
	$unesc_val{'inst_code'} = &unescape($val{'inst_code'});
	}
if ($regexp_ok) {	if ($regexp_ok) {
unless (eval('$unescapeInstcode=~/$instcodefilter/')) {	if (eval{$unesc_val{'inst_code'} !~ /$instcodefilter/}) {
$match = 0;	$match = 0;
}	}
} else {	} else {
unless (eval('$unescapeInstcode=~/\Q$instcodefilter\E/i')) {	if (eval{$unesc_val{'inst_code'} !~ /\Q$instcodefilter\E/i}) {
$match = 0;	$match = 0;
}	}
}	}
}	}
unless ($ownerfilter eq '.' \|\| !defined($ownerfilter)) {	if ($ownerfilter ne '.') {
my $unescapeOwner = &unescape($owner);	if (!$is_hash) {
	$unesc_val{'owner'} = &unescape($val{'owner'});
	}
if (($ownerunamefilter ne '') && ($ownerdomfilter ne '')) {	if (($ownerunamefilter ne '') && ($ownerdomfilter ne '')) {
if ($unescapeOwner =~ /:/) {	if ($unesc_val{'owner'} =~ /:/) {
if (eval('$unescapeOwner !~	if (eval{$unesc_val{'owner'} !~
/\Q$ownerunamefilter\E:\Q$ownerdomfilter\E$/i')) {	/\Q$ownerunamefilter\E:\Q$ownerdomfilter\E$/i}) {
$match = 0;	$match = 0;
}	}
} else {	} else {
if (eval('$unescapeOwner!~/\Q$ownerunamefilter\E/i')) {	if (eval{$unesc_val{'owner'} !~ /\Q$ownerunamefilter\E/i}) {
$match = 0;	$match = 0;
}	}
}	}
} elsif ($ownerunamefilter ne '') {	} elsif ($ownerunamefilter ne '') {
if ($unescapeOwner =~ /:/) {	if ($unesc_val{'owner'} =~ /:/) {
if (eval('$unescapeOwner!~/\Q$ownerunamefilter\E:[^:]+$/i')) {	if (eval{$unesc_val{'owner'} !~ /\Q$ownerunamefilter\E:[^:]+$/i}) {
$match = 0;	$match = 0;
}	}
} else {	} else {
if (eval('$unescapeOwner!~/\Q$ownerunamefilter\E/i')) {	if (eval{$unesc_val{'owner'} !~ /\Q$ownerunamefilter\E/i}) {
$match = 0;	$match = 0;
}	}
}	}
} elsif ($ownerdomfilter ne '') {	} elsif ($ownerdomfilter ne '') {
if ($unescapeOwner =~ /:/) {	if ($unesc_val{'owner'} =~ /:/) {
if (eval('$unescapeOwner!~/^[^:]+:\Q$ownerdomfilter\E/')) {	if (eval{$unesc_val{'owner'} !~ /^[^:]+:\Q$ownerdomfilter\E/}) {
$match = 0;	$match = 0;
}	}
} else {	} else {
Line 3451 sub dump_course_id_handler {	Line 3593 sub dump_course_id_handler {
}	}
}	}
}	}
unless ($coursefilter eq '.' \|\| !defined($coursefilter)) {	if ($coursefilter ne '.') {
my $unescapeCourse = &unescape($key);	if (eval{$unesc_key !~ /^$udom(_)\Q$coursefilter\E$/}) {
unless (eval('$unescapeCourse=~/^$udom(_)\Q$coursefilter\E$/')) {
$match = 0;	$match = 0;
}	}
}	}
unless ($typefilter eq '.' \|\| !defined($typefilter)) {	if ($typefilter ne '.') {
my $unescapeType = &unescape($type);	if (!$is_hash) {
if ($type eq '') {	$unesc_val{'type'} = &unescape($val{'type'});
	}
	if ($unesc_val{'type'} eq '') {
if ($typefilter ne 'Course') {	if ($typefilter ne 'Course') {
$match = 0;	$match = 0;
}	}
} else {	} else {
unless (eval('$unescapeType=~/^\Q$typefilter\E$/')) {	if (eval{$unesc_val{'type'} !~ /^\Q$typefilter\E$/}) {
$match = 0;	$match = 0;
}	}
}	}
}	}
if ($match == 1) {	if ($match == 1) {
$qresult.=$key.'='.$descr.':'.$inst_code.':'.$owner.'&';	if ($rtn_as_hash) {
	if ($is_hash) {
	$qresult.=$key.'='.$value.'&';
	} else {
	my %rtnhash = ( 'description' => &unescape($val{'descr'}),
	'inst_code' => &unescape($val{'inst_code'}),
	'owner' => &unescape($val{'owner'}),
	'type' => &unescape($val{'type'}),
	);
	my $items = &Apache::lonnet::freeze_escape(\%rtnhash);
	$qresult.=$key.'='.$items.'&';
	}
	} else {
	if ($is_hash) {
	$qresult .= $key.'='.&escape($unesc_val{'descr'}).':'.
	&escape($unesc_val{'inst_code'}).':'.
	&escape($unesc_val{'owner'}).'&';
	} else {
	$qresult .= $key.'='.$val{'descr'}.':'.$val{'inst_code'}.
	':'.$val{'owner'}.'&';
	}
	}
}	}
}	}
if (&untie_domain_hash($hashref)) {	if (&untie_domain_hash($hashref)) {
chop($qresult);	chop($qresult);
&Reply($client, "$qresult\n", $userinput);	&Reply($client, \$qresult, $userinput);
} else {	} else {
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".	&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
"while attempting courseiddump\n", $userinput);	"while attempting courseiddump\n", $userinput);
Line 3484 sub dump_course_id_handler {	Line 3648 sub dump_course_id_handler {
&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".	&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
"while attempting courseiddump\n", $userinput);	"while attempting courseiddump\n", $userinput);
}	}


return 1;	return 1;
}	}
&register_handler("courseiddump", \&dump_course_id_handler, 0, 1, 0);	&register_handler("courseiddump", \&dump_course_id_handler, 0, 1, 0);
Line 3568 sub get_domain_handler {	Line 3730 sub get_domain_handler {
}	}
if (&untie_domain_hash($hashref)) {	if (&untie_domain_hash($hashref)) {
$qresult=~s/\&$//;	$qresult=~s/\&$//;
&Reply($client, "$qresult\n", $userinput);	&Reply($client, \$qresult, $userinput);
} else {	} else {
&Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".	&Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
"while attempting getdom\n",$userinput);	"while attempting getdom\n",$userinput);
Line 3666 sub get_id_handler {	Line 3828 sub get_id_handler {
}	}
if (&untie_domain_hash($hashref)) {	if (&untie_domain_hash($hashref)) {
$qresult=~s/\&$//;	$qresult=~s/\&$//;
&Reply($client, "$qresult\n", $userinput);	&Reply($client, \$qresult, $userinput);
} else {	} else {
&Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".	&Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
"while attempting idget\n",$userinput);	"while attempting idget\n",$userinput);
Line 3790 sub dump_dcmail_handler {	Line 3952 sub dump_dcmail_handler {
}	}
if (&untie_domain_hash($hashref)) {	if (&untie_domain_hash($hashref)) {
chop($qresult);	chop($qresult);
&Reply($client, "$qresult\n", $userinput);	&Reply($client, \$qresult, $userinput);
} else {	} else {
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".	&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
"while attempting dcmaildump\n", $userinput);	"while attempting dcmaildump\n", $userinput);
Line 3908 sub dump_domainroles_handler {	Line 4070 sub dump_domainroles_handler {
}	}
}	}
unless (@roles < 1) {	unless (@roles < 1) {
unless (grep/^$trole$/,@roles) {	unless (grep/^\Q$trole\E$/,@roles) {
$match = 0;	$match = 0;
}	}
}	}
Line 3918 sub dump_domainroles_handler {	Line 4080 sub dump_domainroles_handler {
}	}
if (&untie_domain_hash($hashref)) {	if (&untie_domain_hash($hashref)) {
chop($qresult);	chop($qresult);
&Reply($client, "$qresult\n", $userinput);	&Reply($client, \$qresult, $userinput);
} else {	} else {
&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".	&Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
"while attempting domrolesdump\n", $userinput);	"while attempting domrolesdump\n", $userinput);
Line 3972 sub tmp_put_handler {	Line 4134 sub tmp_put_handler {
if ($store=IO::File->new(">$execdir/tmp/$id.tmp")) {	if ($store=IO::File->new(">$execdir/tmp/$id.tmp")) {
print $store $record;	print $store $record;
close $store;	close $store;
&Reply($client, "$id\n", $userinput);	&Reply($client, \$id, $userinput);
} else {	} else {
&Failure( $client, "error: ".($!+0)."IO::File->new Failed ".	&Failure( $client, "error: ".($!+0)."IO::File->new Failed ".
"while attempting tmpput\n", $userinput);	"while attempting tmpput\n", $userinput);
Line 4006 sub tmp_get_handler {	Line 4168 sub tmp_get_handler {
my $execdir=$perlvar{'lonDaemons'};	my $execdir=$perlvar{'lonDaemons'};
if ($store=IO::File->new("$execdir/tmp/$id.tmp")) {	if ($store=IO::File->new("$execdir/tmp/$id.tmp")) {
my $reply=<$store>;	my $reply=<$store>;
&Reply( $client, "$reply\n", $userinput);	&Reply( $client, \$reply, $userinput);
close $store;	close $store;
} else {	} else {
&Failure( $client, "error: ".($!+0)."IO::File->new Failed ".	&Failure( $client, "error: ".($!+0)."IO::File->new Failed ".
Line 4190 sub enrollment_enabled_handler {	Line 4352 sub enrollment_enabled_handler {
my ($cdom) = split(/:/, $tail, 2); # Domain we're asking about.	my ($cdom) = split(/:/, $tail, 2); # Domain we're asking about.

my $outcome = &localenroll::run($cdom);	my $outcome = &localenroll::run($cdom);
&Reply($client, "$outcome\n", $userinput);	&Reply($client, \$outcome, $userinput);

return 1;	return 1;
}	}
Line 4217 sub get_sections_handler {	Line 4379 sub get_sections_handler {
my @secs = &localenroll::get_sections($coursecode,$cdom);	my @secs = &localenroll::get_sections($coursecode,$cdom);
my $seclist = &escape(join(':',@secs));	my $seclist = &escape(join(':',@secs));

&Reply($client, "$seclist\n", $userinput);	&Reply($client, \$seclist, $userinput);


return 1;	return 1;
Line 4246 sub validate_course_owner_handler {	Line 4408 sub validate_course_owner_handler {

$owner = &unescape($owner);	$owner = &unescape($owner);
my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom);	my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom);
&Reply($client, "$outcome\n", $userinput);	&Reply($client, \$outcome, $userinput);



Line 4277 sub validate_course_section_handler {	Line 4439 sub validate_course_section_handler {
my ($inst_course_id, $cdom) = split(/:/, $tail);	my ($inst_course_id, $cdom) = split(/:/, $tail);

my $outcome=&localenroll::validate_courseID($inst_course_id,$cdom);	my $outcome=&localenroll::validate_courseID($inst_course_id,$cdom);
&Reply($client, "$outcome\n", $userinput);	&Reply($client, \$outcome, $userinput);


return 1;	return 1;
Line 4304 sub validate_course_section_handler {	Line 4466 sub validate_course_section_handler {
sub validate_class_access_handler {	sub validate_class_access_handler {
my ($cmd, $tail, $client) = @_;	my ($cmd, $tail, $client) = @_;
my $userinput = "$cmd:$tail";	my $userinput = "$cmd:$tail";
my ($inst_class,$courseowner,$cdom) = split(/:/, $tail);	my ($inst_class,$ownerlist,$cdom) = split(/:/, $tail);
$courseowner = &unescape($courseowner);	my $owners = &unescape($ownerlist);
my $outcome;	my $outcome;
eval {	eval {
local($SIG{__DIE__})='DEFAULT';	local($SIG{__DIE__})='DEFAULT';
$outcome=&localenroll::check_section($inst_class,$courseowner,$cdom);	$outcome=&localenroll::check_section($inst_class,$owners,$cdom);
};	};
&Reply($client,"$outcome\n", $userinput);	&Reply($client,\$outcome, $userinput);

return 1;	return 1;
}	}
Line 4472 sub get_institutional_defaults_handler {	Line 4634 sub get_institutional_defaults_handler {
$result.=&escape($key).'='.&escape($value).'&';	$result.=&escape($key).'='.&escape($value).'&';
}	}
$result .= 'code_order='.&escape(join('&',@code_order));	$result .= 'code_order='.&escape(join('&',@code_order));
&Reply($client,$result."\n",$userinput);	&Reply($client,\$result,$userinput);
} else {	} else {
&Reply($client,"error\n", $userinput);	&Reply($client,"error\n", $userinput);
}	}
Line 4483 sub get_institutional_defaults_handler {	Line 4645 sub get_institutional_defaults_handler {
&register_handler("autoinstcodedefaults",	&register_handler("autoinstcodedefaults",
\&get_institutional_defaults_handler,0,1,0);	\&get_institutional_defaults_handler,0,1,0);

	sub get_institutional_user_rules {
	my ($cmd, $tail, $client) = @_;
	my $userinput = "$cmd:$tail";
	my $dom = &unescape($tail);
	my (%rules_hash,@rules_order);
	my $outcome;
	eval {
	local($SIG{__DIE__})='DEFAULT';
	$outcome = &localenroll::username_rules($dom,\%rules_hash,\@rules_order);
	};
	if (!$@) {
	if ($outcome eq 'ok') {
	my $result;
	foreach my $key (keys(%rules_hash)) {
	$result .= &escape($key).'='.&Apache::lonnet::freeze_escape($rules_hash{$key}).'&';
	}
	$result =~ s/\&$//;
	$result .= ':';
	if (@rules_order > 0) {
	foreach my $item (@rules_order) {
	$result .= &escape($item).'&';
	}
	}
	$result =~ s/\&$//;
	&Reply($client,\$result,$userinput);
	} else {
	&Reply($client,"error\n", $userinput);
	}
	} else {
	&Failure($client,"unknown_cmd\n",$userinput);
	}
	}
	&register_handler("instuserrules",\&get_institutional_user_rules,0,1,0);

	sub get_institutional_id_rules {
	my ($cmd, $tail, $client) = @_;
	my $userinput = "$cmd:$tail";
	my $dom = &unescape($tail);
	my (%rules_hash,@rules_order);
	my $outcome;
	eval {
	local($SIG{__DIE__})='DEFAULT';
	$outcome = &localenroll::id_rules($dom,\%rules_hash,\@rules_order);
	};
	if (!$@) {
	if ($outcome eq 'ok') {
	my $result;
	foreach my $key (keys(%rules_hash)) {
	$result .= &escape($key).'='.&Apache::lonnet::freeze_escape($rules_hash{$key}).'&';
	}
	$result =~ s/\&$//;
	$result .= ':';
	if (@rules_order > 0) {
	foreach my $item (@rules_order) {
	$result .= &escape($item).'&';
	}
	}
	$result =~ s/\&$//;
	&Reply($client,\$result,$userinput);
	} else {
	&Reply($client,"error\n", $userinput);
	}
	} else {
	&Failure($client,"unknown_cmd\n",$userinput);
	}
	}
	&register_handler("instidrules",\&get_institutional_id_rules,0,1,0);

	sub get_institutional_selfcreate_rules {
	my ($cmd, $tail, $client) = @_;
	my $userinput = "$cmd:$tail";
	my $dom = &unescape($tail);
	my (%rules_hash,@rules_order);
	my $outcome;
	eval {
	local($SIG{__DIE__})='DEFAULT';
	$outcome = &localenroll::selfcreate_rules($dom,\%rules_hash,\@rules_order);
	};
	if (!$@) {
	if ($outcome eq 'ok') {
	my $result;
	foreach my $key (keys(%rules_hash)) {
	$result .= &escape($key).'='.&Apache::lonnet::freeze_escape($rules_hash{$key}).'&';
	}
	$result =~ s/\&$//;
	$result .= ':';
	if (@rules_order > 0) {
	foreach my $item (@rules_order) {
	$result .= &escape($item).'&';
	}
	}
	$result =~ s/\&$//;
	&Reply($client,\$result,$userinput);
	} else {
	&Reply($client,"error\n", $userinput);
	}
	} else {
	&Failure($client,"unknown_cmd\n",$userinput);
	}
	}
	&register_handler("instemailrules",\&get_institutional_selfcreate_rules,0,1,0);


	sub institutional_username_check {
	my ($cmd, $tail, $client) = @_;
	my $userinput = "$cmd:$tail";
	my %rulecheck;
	my $outcome;
	my ($udom,$uname,@rules) = split(/:/,$tail);
	$udom = &unescape($udom);
	$uname = &unescape($uname);
	@rules = map {&unescape($_);} (@rules);
	eval {
	local($SIG{__DIE__})='DEFAULT';
	$outcome = &localenroll::username_check($udom,$uname,\@rules,\%rulecheck);
	};
	if (!$@) {
	if ($outcome eq 'ok') {
	my $result='';
	foreach my $key (keys(%rulecheck)) {
	$result.=&escape($key).'='.&Apache::lonnet::freeze_escape($rulecheck{$key}).'&';
	}
	&Reply($client,\$result,$userinput);
	} else {
	&Reply($client,"error\n", $userinput);
	}
	} else {
	&Failure($client,"unknown_cmd\n",$userinput);
	}
	}
	&register_handler("instrulecheck",\&institutional_username_check,0,1,0);

	sub institutional_id_check {
	my ($cmd, $tail, $client) = @_;
	my $userinput = "$cmd:$tail";
	my %rulecheck;
	my $outcome;
	my ($udom,$id,@rules) = split(/:/,$tail);
	$udom = &unescape($udom);
	$id = &unescape($id);
	@rules = map {&unescape($_);} (@rules);
	eval {
	local($SIG{__DIE__})='DEFAULT';
	$outcome = &localenroll::id_check($udom,$id,\@rules,\%rulecheck);
	};
	if (!$@) {
	if ($outcome eq 'ok') {
	my $result='';
	foreach my $key (keys(%rulecheck)) {
	$result.=&escape($key).'='.&Apache::lonnet::freeze_escape($rulecheck{$key}).'&';
	}
	&Reply($client,\$result,$userinput);
	} else {
	&Reply($client,"error\n", $userinput);
	}
	} else {
	&Failure($client,"unknown_cmd\n",$userinput);
	}
	}
	&register_handler("instidrulecheck",\&institutional_id_check,0,1,0);

	sub institutional_selfcreate_check {
	my ($cmd, $tail, $client) = @_;
	my $userinput = "$cmd:$tail";
	my %rulecheck;
	my $outcome;
	my ($udom,$email,@rules) = split(/:/,$tail);
	$udom = &unescape($udom);
	$email = &unescape($email);
	@rules = map {&unescape($_);} (@rules);
	eval {
	local($SIG{__DIE__})='DEFAULT';
	$outcome = &localenroll::selfcreate_check($udom,$email,\@rules,\%rulecheck);
	};
	if (!$@) {
	if ($outcome eq 'ok') {
	my $result='';
	foreach my $key (keys(%rulecheck)) {
	$result.=&escape($key).'='.&Apache::lonnet::freeze_escape($rulecheck{$key}).'&';
	}
	&Reply($client,\$result,$userinput);
	} else {
	&Reply($client,"error\n", $userinput);
	}
	} else {
	&Failure($client,"unknown_cmd\n",$userinput);
	}
	}
	&register_handler("instselfcreatecheck",\&institutional_selfcreate_check,0,1,0);

# Get domain specific conditions for import of student photographs to a course	# Get domain specific conditions for import of student photographs to a course
#	#
Line 4635 sub inst_usertypes_handler {	Line 4986 sub inst_usertypes_handler {
}	}
$res=~s/\&$//;	$res=~s/\&$//;
}	}
&Reply($client, "$res\n", $userinput);	&Reply($client, \$res, $userinput);
return 1;	return 1;
}	}
&register_handler("inst_usertypes", \&inst_usertypes_handler, 0, 1, 0);	&register_handler("inst_usertypes", \&inst_usertypes_handler, 0, 1, 0);
Line 5134 sub Debug {	Line 5485 sub Debug {
#	#
sub Reply {	sub Reply {
my ($fd, $reply, $request) = @_;	my ($fd, $reply, $request) = @_;
print $fd $reply;	if (ref($reply)) {
Debug("Request was $request Reply was $reply");	print $fd $$reply;
	print $fd "\n";
	if ($DEBUG) { Debug("Request was $request Reply was $$reply"); }
	} else {
	print $fd $reply;
	if ($DEBUG) { Debug("Request was $request Reply was $reply"); }
	}
$Transactions++;	$Transactions++;
}	}

Line 5486 sub make_new_child {	Line 5842 sub make_new_child {
# ---------------- New known client connecting, could mean machine online again	# ---------------- New known client connecting, could mean machine online again
if (&Apache::lonnet::get_host_ip($currenthostid) ne $clientip	if (&Apache::lonnet::get_host_ip($currenthostid) ne $clientip
&& $clientip ne '127.0.0.1') {	&& $clientip ne '127.0.0.1') {
&Apache::lonnet::reconlonc();	&Apache::lonnet::reconlonc($clientname);
}	}
&logthis("<font color='green'>Established connection: $clientname</font>");	&logthis("<font color='green'>Established connection: $clientname</font>");
&status('Will listen to '.$clientname);	&status('Will listen to '.$clientname);
Line 5689 sub get_auth_type	Line 6045 sub get_auth_type
# 0 - The domain,user,password triplet is not a valid user.	# 0 - The domain,user,password triplet is not a valid user.
#	#
sub validate_user {	sub validate_user {
my ($domain, $user, $password) = @_;	my ($domain, $user, $password, $checkdefauth) = @_;


# Why negative ~pi you may well ask? Well this function is about	# Why negative ~pi you may well ask? Well this function is about
# authentication, and therefore very important to get right.	# authentication, and therefore very important to get right.
Line 5713 sub validate_user {	Line 6068 sub validate_user {

my $null = pack("C",0); # Used by kerberos auth types.	my $null = pack("C",0); # Used by kerberos auth types.

	if ($howpwd eq 'nouser') {
	if ($checkdefauth) {
	my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
	if ($domdefaults{'auth_def'} eq 'localauth') {
	$howpwd = $domdefaults{'auth_def'};
	$contentpwd = $domdefaults{'auth_arg_def'};
	} elsif ((($domdefaults{'auth_def'} eq 'krb4') \|\|
	($domdefaults{'auth_def'} eq 'krb5')) &&
	($domdefaults{'auth_arg_def'} ne '')) {
	$howpwd = $domdefaults{'auth_def'};
	$contentpwd = $domdefaults{'auth_arg_def'};
	}
	}
	}
if ($howpwd ne 'nouser') {	if ($howpwd ne 'nouser') {

if($howpwd eq "internal") { # Encrypted is in local password file.	if($howpwd eq "internal") { # Encrypted is in local password file.
$validated = (crypt($password, $contentpwd) eq $contentpwd);	$validated = (crypt($password, $contentpwd) eq $contentpwd);
}	}
Line 5765 sub validate_user {	Line 6133 sub validate_user {
my $credentials= &Authen::Krb5::cc_default();	my $credentials= &Authen::Krb5::cc_default();
$credentials->initialize(&Authen::Krb5::parse_name($user.'@'	$credentials->initialize(&Authen::Krb5::parse_name($user.'@'
.$contentpwd));	.$contentpwd));
my $krbreturn = &Authen::Krb5::get_in_tkt_with_password($krbclient,	my $krbreturn;
$krbserver,	if (exists(&Authen::Krb5::get_init_creds_password)) {
$password,	$krbreturn =
$credentials);	&Authen::Krb5::get_init_creds_password($krbclient,$password,
$validated = ($krbreturn == 1);	$krbservice);
	$validated = (ref($krbreturn) eq 'Authen::Krb5::Creds');
	} else {
	$krbreturn =
	&Authen::Krb5::get_in_tkt_with_password($krbclient,$krbserver,
	$password,$credentials);
	$validated = ($krbreturn == 1);
	}
	if (!$validated) {
	&logthis('krb5: '.$user.', '.$contentpwd.', '.
	&Authen::Krb5::error());
	}
} else {	} else {
$validated = 0;	$validated = 0;
}	}
Line 6058 sub change_unix_password {	Line 6437 sub change_unix_password {

sub make_passwd_file {	sub make_passwd_file {
my ($uname, $umode,$npass,$passfilename)=@_;	my ($uname, $umode,$npass,$passfilename)=@_;
my $result="ok\n";	my $result="ok";
if ($umode eq 'krb4' or $umode eq 'krb5') {	if ($umode eq 'krb4' or $umode eq 'krb5') {
{	{
my $pf = IO::File->new(">$passfilename");	my $pf = IO::File->new(">$passfilename");
Line 6126 sub make_passwd_file {	Line 6505 sub make_passwd_file {
if($useraddok > 0) {	if($useraddok > 0) {
my $error_text = &lcuseraddstrerror($useraddok);	my $error_text = &lcuseraddstrerror($useraddok);
&logthis("Failed lcuseradd: $error_text");	&logthis("Failed lcuseradd: $error_text");
$result = "lcuseradd_failed:$error_text\n";	$result = "lcuseradd_failed:$error_text";
} else {	} else {
my $pf = IO::File->new(">$passfilename");	my $pf = IO::File->new(">$passfilename");
if($pf) {	if($pf) {
Line 6150 sub make_passwd_file {	Line 6529 sub make_passwd_file {
}	}
}	}
} else {	} else {
$result="auth_mode_error\n";	$result="auth_mode_error";
}	}
return $result;	return $result;
}	}

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.374
changed lines
	Added in v.1.398