loncom/lond - diff

Return to lond CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.411 and 1.428

version 1.411, 2009/02/10 11:31:26	version 1.428, 2009/10/08 19:54:26
Line 142 my @adderrors = ("ok",	Line 142 my @adderrors = ("ok",
"lcuseradd Password mismatch");	"lcuseradd Password mismatch");


	# This array are the errors from lcinstallfile:

	my @installerrors = ("ok",
	"Initial user id of client not that of www",
	"Usage error, not enough command line arguments",
	"Source file name does not exist",
	"Destination file name does not exist",
	"Some file operation failed",
	"Invalid table filename."
	);

#	#
# Statistics that are maintained and dislayed in the status line.	# Statistics that are maintained and dislayed in the status line.
Line 398 sub isClient {	Line 408 sub isClient {
#	#
sub ReadManagerTable {	sub ReadManagerTable {

	&Debug("Reading manager table");
# Clean out the old table first..	# Clean out the old table first..

foreach my $key (keys %managers) {	foreach my $key (keys %managers) {
Line 520 sub AdjustHostContents {	Line 531 sub AdjustHostContents {
}	}
#	#
# InstallFile: Called to install an administrative file:	# InstallFile: Called to install an administrative file:
# - The file is created with <name>.tmp	# - The file is created int a temp directory called <name>.tmp
# - The <name>.tmp file is then mv'd to <name>	# - lcinstall file is called to install the file.
# This lugubrious procedure is done to ensure that we are never without	# since the web app has no direct write access to the table directory
# a valid, even if dated, version of the file regardless of who crashes
# and when the crash occurs.
#	#
# Parameters:	# Parameters:
# Name of the file	# Name of the file
Line 532 sub AdjustHostContents {	Line 541 sub AdjustHostContents {
# Return:	# Return:
# nonzero - success.	# nonzero - success.
# 0 - failure and $! has an errno.	# 0 - failure and $! has an errno.
	# Assumptions:
	# File installtion is a relatively infrequent
#	#
sub InstallFile {	sub InstallFile {

my ($Filename, $Contents) = @_;	my ($Filename, $Contents) = @_;
my $TempFile = $Filename.".tmp";	# my $TempFile = $Filename.".tmp";
	my $exedir = $perlvar{'lonDaemons'};
	my $tmpdir = $exedir.'/tmp/';
	my $TempFile = $tmpdir."TempTableFile.tmp";

# Open the file for write:	# Open the file for write:

Line 550 sub InstallFile {	Line 564 sub InstallFile {
print $fh ($Contents);	print $fh ($Contents);
$fh->close; # In case we ever have a filesystem w. locking	$fh->close; # In case we ever have a filesystem w. locking

chmod(0660, $TempFile);	chmod(0664, $TempFile); # Everyone can write it.

# Now we can move install the file in position.	# Use lcinstall file to put the file in the table directory...

move($TempFile, $Filename);	&Debug("Opening pipe to $exedir/lcinstallfile $TempFile $Filename");
	my $pf = IO::File->new("\| $exedir/lcinstallfile $TempFile $Filename > $exedir/logs/lcinstallfile.log");
	close $pf;
	my $err = $?;
	&Debug("Status is $err");
	if ($err != 0) {
	my $msg = $err;
	if ($err < @installerrors) {
	$msg = $installerrors[$err];
	}
	&logthis("Install failed for table file $Filename : $msg");
	return 0;
	}

	# Remove the temp file:

	unlink($TempFile);

return 1;	return 1;
}	}
Line 608 sub ConfigFileFromSelector {	Line 638 sub ConfigFileFromSelector {
sub PushFile {	sub PushFile {
my $request = shift;	my $request = shift;
my ($command, $filename, $contents) = split(":", $request, 3);	my ($command, $filename, $contents) = split(":", $request, 3);
	&Debug("PushFile");

# At this point in time, pushes for only the following tables are	# At this point in time, pushes for only the following tables are
# supported:	# supported:
Line 624 sub PushFile {	Line 655 sub PushFile {
if(! (defined $tablefile)) {	if(! (defined $tablefile)) {
return "refused";	return "refused";
}	}
#
# >copy< the old table to the backup table
# don't rename in case system crashes/reboots etc. in the time
# window between a rename and write.
#
my $backupfile = $tablefile;
$backupfile =~ s/\.tab$/.old/;
if(!CopyFile($tablefile, $backupfile)) {
&logthis('<font color="green"> CopyFile from '.$tablefile." to ".$backupfile." failed </font>");
return "error:$!";
}
&logthis('<font color="green"> Pushfile: backed up '
.$tablefile." to $backupfile</font>");

# If the file being pushed is the host file, we adjust the entry for ourself so that the	# If the file being pushed is the host file, we adjust the entry for ourself so that the
# IP will be our current IP as looked up in dns. Note this is only 99% good as it's possible	# IP will be our current IP as looked up in dns. Note this is only 99% good as it's possible
# to conceive of conditions where we don't have a DNS entry locally. This is possible in a	# to conceive of conditions where we don't have a DNS entry locally. This is possible in a
Line 650 sub PushFile {	Line 668 sub PushFile {

# Install the new file:	# Install the new file:

	&logthis("Installing new $tablefile contents:\n$contents");
if(!InstallFile($tablefile, $contents)) {	if(!InstallFile($tablefile, $contents)) {
&logthis('<font color="red"> Pushfile: unable to install '	&logthis('<font color="red"> Pushfile: unable to install '
.$tablefile." $! </font>");	.$tablefile." $! </font>");
Line 1203 sub user_authorization_type {	Line 1222 sub user_authorization_type {
# a reply is written to the client.	# a reply is written to the client.
sub push_file_handler {	sub push_file_handler {
my ($cmd, $tail, $client) = @_;	my ($cmd, $tail, $client) = @_;
	&Debug("In push file handler");
my $userinput = "$cmd:$tail";	my $userinput = "$cmd:$tail";

# At this time we only know that the IP of our partner is a valid manager	# At this time we only know that the IP of our partner is a valid manager
Line 1211 sub push_file_handler {	Line 1230 sub push_file_handler {
# spoofing).	# spoofing).

my $cert = &GetCertificate($userinput);	my $cert = &GetCertificate($userinput);
if(&ValidManager($cert)) {	if(&ValidManager($cert)) {
	&Debug("Valid manager: $client");

# Now presumably we have the bona fides of both the peer host and the	# Now presumably we have the bona fides of both the peer host and the
# process making the request.	# process making the request.
Line 1220 sub push_file_handler {	Line 1240 sub push_file_handler {
&Reply($client, \$reply, $userinput);	&Reply($client, \$reply, $userinput);

} else {	} else {
	&logthis("push_file_handler $client is not valid");
&Failure( $client, "refused\n", $userinput);	&Failure( $client, "refused\n", $userinput);
}	}
return 1;	return 1;
Line 1624 sub server_timezone_handler {	Line 1645 sub server_timezone_handler {
}	}
&register_handler("servertimezone", \&server_timezone_handler, 0, 1, 0);	&register_handler("servertimezone", \&server_timezone_handler, 0, 1, 0);

	sub server_loncaparev_handler {
	my ($cmd,$tail,$client) = @_;
	my $userinput = "$cmd:$tail";
	&Reply($client,\$perlvar{'lonVersion'},$userinput);
	return 1;
	}
	&register_handler("serverloncaparev", \&server_loncaparev_handler, 0, 1, 0);

# Process a reinit request. Reinit requests that either	# Process a reinit request. Reinit requests that either
# lonc or lond be reinitialized so that an updated	# lonc or lond be reinitialized so that an updated
# host.tab or domain.tab can be processed.	# host.tab or domain.tab can be processed.
Line 1786 sub change_password_handler {	Line 1815 sub change_password_handler {
# npass - New password.	# npass - New password.
# context - Context in which this was called	# context - Context in which this was called
# (preferences or reset_by_email).	# (preferences or reset_by_email).
	# lonhost - HostID of server where request originated

my ($udom,$uname,$upass,$npass,$context)=split(/:/,$tail);	my ($udom,$uname,$upass,$npass,$context,$lonhost)=split(/:/,$tail);

$upass=&unescape($upass);	$upass=&unescape($upass);
$npass=&unescape($npass);	$npass=&unescape($npass);
Line 1796 sub change_password_handler {	Line 1826 sub change_password_handler {
# First require that the user can be authenticated with their	# First require that the user can be authenticated with their
# old password unless context was 'reset_by_email':	# old password unless context was 'reset_by_email':

my $validated;	my ($validated,$failure);
if ($context eq 'reset_by_email') {	if ($context eq 'reset_by_email') {
$validated = 1;	if ($lonhost eq '') {
	$failure = 'invalid_client';
	} else {
	$validated = 1;
	}
} else {	} else {
$validated = &validate_user($udom, $uname, $upass);	$validated = &validate_user($udom, $uname, $upass);
}	}
Line 1812 sub change_password_handler {	Line 1846 sub change_password_handler {
$salt=substr($salt,6,2);	$salt=substr($salt,6,2);
my $ncpass=crypt($npass,$salt);	my $ncpass=crypt($npass,$salt);
if(&rewrite_password_file($udom, $uname, "internal:$ncpass")) {	if(&rewrite_password_file($udom, $uname, "internal:$ncpass")) {
&logthis("Result of password change for "	my $msg="Result of password change for $uname: pwchange_success";
."$uname: pwchange_success");	if ($lonhost) {
	$msg .= " - request originated from: $lonhost";
	}
	&logthis($msg);
&Reply($client, "ok\n", $userinput);	&Reply($client, "ok\n", $userinput);
} else {	} else {
&logthis("Unable to open $uname passwd "	&logthis("Unable to open $uname passwd "
Line 1834 sub change_password_handler {	Line 1871 sub change_password_handler {
}	}

} else {	} else {
&Failure( $client, "non_authorized\n", $userinput);	if ($failure eq '') {
	$failure = 'non_authorized';
	}
	&Failure( $client, "$failure\n", $userinput);
}	}

return 1;	return 1;
Line 3645 sub put_course_id_hash_handler {	Line 3685 sub put_course_id_hash_handler {
# 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	# type - optional parameter for selection
# regexp_ok - if true, allow the supplied institutional code	# regexp_ok - if 1 or -1 allow the supplied institutional code
# filter to behave as a regular expression.	# filter to behave as a regular expression:
	# 1 will not exclude the course if the instcode matches the RE
	# -1 will exclude the course if the instcode matches the RE
# rtn_as_hash - whether to return the information available for	# rtn_as_hash - whether to return the information available for
# each matched item as a frozen hash of all	# each matched item as a frozen hash of all
# key, value pairs in the item's hash, or as a	# key, value pairs in the item's hash, or as a
Line 3662 sub put_course_id_hash_handler {	Line 3704 sub put_course_id_hash_handler {
# caller - if set to 'coursecatalog', courses set to be hidden	# caller - if set to 'coursecatalog', courses set to be hidden
# from course catalog will be excluded from results (unless	# from course catalog will be excluded from results (unless
# overridden by "showhidden".	# overridden by "showhidden".
	# cloner - escaped username:domain of course cloner (if picking course to
	# clone).
	# cc_clone_list - escaped comma separated list of courses for which
	# course cloner has active CC role (and so can clone
	# automatically).
	# cloneonly - filter by courses for which cloner has rights to clone.
	# createdbefore - include courses for which creation date preceeded this date.
	# createdafter - include courses for which creation date followed this date.
	# creationcontext - include courses created in specified context
#	#
# $client - The socket open on the client.	# $client - The socket open on the client.
# Returns:	# Returns:
Line 3674 sub dump_course_id_handler {	Line 3725 sub dump_course_id_handler {

my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,	my ($udom,$since,$description,$instcodefilter,$ownerfilter,$coursefilter,
$typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden,	$typefilter,$regexp_ok,$rtn_as_hash,$selfenrollonly,$catfilter,$showhidden,
$caller) =split(/:/,$tail);	$caller,$cloner,$cc_clone_list,$cloneonly,$createdbefore,$createdafter,
	$creationcontext) =split(/:/,$tail);
my $now = time;	my $now = time;
	my ($cloneruname,$clonerudom,%cc_clone);
if (defined($description)) {	if (defined($description)) {
$description=&unescape($description);	$description=&unescape($description);
} else {	} else {
Line 3718 sub dump_course_id_handler {	Line 3771 sub dump_course_id_handler {
if (defined($catfilter)) {	if (defined($catfilter)) {
$catfilter=&unescape($catfilter);	$catfilter=&unescape($catfilter);
}	}
	if (defined($cloner)) {
	$cloner = &unescape($cloner);
	($cloneruname,$clonerudom) = ($cloner =~ /^($LONCAPA::match_username):($LONCAPA::match_domain)$/);
	}
	if (defined($cc_clone_list)) {
	$cc_clone_list = &unescape($cc_clone_list);
	my @cc_cloners = split('&',$cc_clone_list);
	foreach my $cid (@cc_cloners) {
	my ($clonedom,$clonenum) = split(':',$cid);
	next if ($clonedom ne $udom);
	$cc_clone{$clonedom.'_'.$clonenum} = 1;
	}
	}
	if (defined($createdbefore)) {
	$createdbefore = &unescape($createdbefore);
	} else {
	$createdbefore = 0;
	}
	if (defined($createdafter)) {
	$createdafter = &unescape($createdafter);
	} else {
	$createdafter = 0;
	}
	if (defined($creationcontext)) {
	$creationcontext = &unescape($creationcontext);
	} else {
	$creationcontext = '.';
	}

my $unpack = 1;	my $unpack = 1;
if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' &&	if ($description eq '.' && $instcodefilter eq '.' && $coursefilter eq '.' &&
$typefilter eq '.') {	$typefilter eq '.') {
Line 3729 sub dump_course_id_handler {	Line 3811 sub dump_course_id_handler {
if ($hashref) {	if ($hashref) {
while (my ($key,$value) = each(%$hashref)) {	while (my ($key,$value) = each(%$hashref)) {
my ($unesc_key,$lasttime_key,$lasttime,$is_hash,%val,	my ($unesc_key,$lasttime_key,$lasttime,$is_hash,%val,
%unesc_val,$selfenroll_end,$selfenroll_types);	%unesc_val,$selfenroll_end,$selfenroll_types,$created,
	$context);
$unesc_key = &unescape($key);	$unesc_key = &unescape($key);
if ($unesc_key =~ /^lasttime:/) {	if ($unesc_key =~ /^lasttime:/) {
next;	next;
Line 3740 sub dump_course_id_handler {	Line 3823 sub dump_course_id_handler {
$lasttime = $hashref->{$lasttime_key};	$lasttime = $hashref->{$lasttime_key};
next if ($lasttime<$since);	next if ($lasttime<$since);
}	}
	my ($canclone,$valchange);
my $items = &Apache::lonnet::thaw_unescape($value);	my $items = &Apache::lonnet::thaw_unescape($value);
if (ref($items) eq 'HASH') {	if (ref($items) eq 'HASH') {
$is_hash = 1;	$is_hash = 1;
	if (defined($clonerudom)) {
	if ($items->{'cloners'}) {
	my @cloneable = split(',',$items->{'cloners'});
	if (@cloneable) {
	if (grep(/^\*$/,@cloneable)) {
	$canclone = 1;
	} elsif (grep(/^\*:\Q$clonerudom\E$/,@cloneable)) {
	$canclone = 1;
	} elsif (grep(/^\Q$cloneruname\E:\Q$clonerudom\E$/,@cloneable)) {
	$canclone = 1;
	}
	}
	unless ($canclone) {
	if ($cloneruname ne '' && $clonerudom ne '') {
	if ($cc_clone{$unesc_key}) {
	$canclone = 1;
	$items->{'cloners'} .= ','.$cloneruname.':'.
	$clonerudom;
	$valchange = 1;
	}
	}
	}
	} elsif (defined($cloneruname)) {
	if ($cc_clone{$unesc_key}) {
	$canclone = 1;
	$items->{'cloners'} = $cloneruname.':'.$clonerudom;
	$valchange = 1;
	}
	}
	}
if ($unpack \|\| !$rtn_as_hash) {	if ($unpack \|\| !$rtn_as_hash) {
$unesc_val{'descr'} = $items->{'description'};	$unesc_val{'descr'} = $items->{'description'};
$unesc_val{'inst_code'} = $items->{'inst_code'};	$unesc_val{'inst_code'} = $items->{'inst_code'};
$unesc_val{'owner'} = $items->{'owner'};	$unesc_val{'owner'} = $items->{'owner'};
$unesc_val{'type'} = $items->{'type'};	$unesc_val{'type'} = $items->{'type'};
	$unesc_val{'cloners'} = $items->{'cloners'};
	$unesc_val{'created'} = $items->{'created'};
	$unesc_val{'context'} = $items->{'context'};
}	}
$selfenroll_types = $items->{'selfenroll_types'};	$selfenroll_types = $items->{'selfenroll_types'};
$selfenroll_end = $items->{'selfenroll_end_date'};	$selfenroll_end = $items->{'selfenroll_end_date'};
	$created = $items->{'created'};
	$context = $items->{'context'};
if ($selfenrollonly) {	if ($selfenrollonly) {
next if (!$selfenroll_types);	next if (!$selfenroll_types);
if (($selfenroll_end > 0) && ($selfenroll_end <= $now)) {	if (($selfenroll_end > 0) && ($selfenroll_end <= $now)) {
next;	next;
}	}
}	}
	if ($creationcontext ne '.') {
	next if (($context ne '') && ($context ne $creationcontext));
	}
	if ($createdbefore > 0) {
	next if (($created eq '') \|\| ($created > $createdbefore));
	}
	if ($createdafter > 0) {
	next if (($created eq '') \|\| ($created <= $createdafter));
	}
if ($catfilter ne '') {	if ($catfilter ne '') {
next if ($items->{'categories'} eq '');	next if ($items->{'categories'} eq '');
my @categories = split('&',$items->{'categories'});	my @categories = split('&',$items->{'categories'});
Line 3778 sub dump_course_id_handler {	Line 3906 sub dump_course_id_handler {
}	}
} else {	} else {
next if ($catfilter ne '');	next if ($catfilter ne '');
next if ($selfenrollonly);	next if ($selfenrollonly);
	next if ($createdbefore \|\| $createdafter);
	next if ($creationcontext ne '.');
	if ((defined($clonerudom)) && (defined($cloneruname))) {
	if ($cc_clone{$unesc_key}) {
	$canclone = 1;
	$val{'cloners'} = &escape($cloneruname.':'.$clonerudom);
	}
	}
$is_hash = 0;	$is_hash = 0;
my @courseitems = split(/:/,$value);	my @courseitems = split(/:/,$value);
$lasttime = pop(@courseitems);	$lasttime = pop(@courseitems);
Line 3787 sub dump_course_id_handler {	Line 3923 sub dump_course_id_handler {
}	}
($val{'descr'},$val{'inst_code'},$val{'owner'},$val{'type'}) = @courseitems;	($val{'descr'},$val{'inst_code'},$val{'owner'},$val{'type'}) = @courseitems;
}	}
	if ($cloneonly) {
	next unless ($canclone);
	}
my $match = 1;	my $match = 1;
if ($description ne '.') {	if ($description ne '.') {
if (!$is_hash) {	if (!$is_hash) {
Line 3800 sub dump_course_id_handler {	Line 3939 sub dump_course_id_handler {
if (!$is_hash) {	if (!$is_hash) {
$unesc_val{'inst_code'} = &unescape($val{'inst_code'});	$unesc_val{'inst_code'} = &unescape($val{'inst_code'});
}	}
if ($regexp_ok) {	if ($regexp_ok == 1) {
if (eval{$unesc_val{'inst_code'} !~ /$instcodefilter/}) {	if (eval{$unesc_val{'inst_code'} !~ /$instcodefilter/}) {
$match = 0;	$match = 0;
}	}
	} elsif ($regexp_ok == -1) {
	if (eval{$unesc_val{'inst_code'} =~ /$instcodefilter/}) {
	$match = 0;
	}
} else {	} else {
if (eval{$unesc_val{'inst_code'} !~ /\Q$instcodefilter\E/i}) {	if (eval{$unesc_val{'inst_code'} !~ /\Q$instcodefilter\E/i}) {
$match = 0;	$match = 0;
Line 3869 sub dump_course_id_handler {	Line 4012 sub dump_course_id_handler {
if ($match == 1) {	if ($match == 1) {
if ($rtn_as_hash) {	if ($rtn_as_hash) {
if ($is_hash) {	if ($is_hash) {
$qresult.=$key.'='.$value.'&';	if ($valchange) {
	my $newvalue = &Apache::lonnet::freeze_escape($items);
	$qresult.=$key.'='.$newvalue.'&';
	} else {
	$qresult.=$key.'='.$value.'&';
	}
} else {	} else {
my %rtnhash = ( 'description' => &unescape($val{'descr'}),	my %rtnhash = ( 'description' => &unescape($val{'descr'}),
'inst_code' => &unescape($val{'inst_code'}),	'inst_code' => &unescape($val{'inst_code'}),
'owner' => &unescape($val{'owner'}),	'owner' => &unescape($val{'owner'}),
'type' => &unescape($val{'type'}),	'type' => &unescape($val{'type'}),
	'cloners' => &unescape($val{'cloners'}),
);	);
my $items = &Apache::lonnet::freeze_escape(\%rtnhash);	my $items = &Apache::lonnet::freeze_escape(\%rtnhash);
$qresult.=$key.'='.$items.'&';	$qresult.=$key.'='.$items.'&';
Line 3998 sub get_domain_handler {	Line 4147 sub get_domain_handler {
}	}
&register_handler("getdom", \&get_domain_handler, 0, 1, 0);	&register_handler("getdom", \&get_domain_handler, 0, 1, 0);


#	#
# Puts an id to a domains id database.	# Puts an id to a domains id database.
#	#
Line 4305 sub dump_domainroles_handler {	Line 4453 sub dump_domainroles_handler {
$rolesfilter=&unescape($rolesfilter);	$rolesfilter=&unescape($rolesfilter);
@roles = split(/\&/,$rolesfilter);	@roles = split(/\&/,$rolesfilter);
}	}

my $hashref = &tie_domain_hash($udom, "nohist_domainroles", &GDBM_WRCREAT());	my $hashref = &tie_domain_hash($udom, "nohist_domainroles", &GDBM_WRCREAT());
if ($hashref) {	if ($hashref) {
my $qresult = '';	my $qresult = '';
while (my ($key,$value) = each(%$hashref)) {	while (my ($key,$value) = each(%$hashref)) {
my $match = 1;	my $match = 1;
my ($start,$end) = split(/:/,&unescape($value));	my ($end,$start) = split(/:/,&unescape($value));
my ($trole,$uname,$udom,$runame,$rudom,$rsec) = split(/:/,&unescape($key));	my ($trole,$uname,$udom,$runame,$rudom,$rsec) = split(/:/,&unescape($key));
unless ($startfilter eq '.' \|\| !defined($startfilter)) {	unless (@roles < 1) {
if ($start >= $startfilter) {	unless (grep/^\Q$trole\E$/,@roles) {
$match = 0;	$match = 0;
	next;
}	}
}	}
unless ($endfilter eq '.' \|\| !defined($endfilter)) {	unless ($startfilter eq '.' \|\| !defined($startfilter)) {
if ($end <= $endfilter) {	if ((defined($start)) && ($start >= $startfilter)) {
$match = 0;	$match = 0;
	next;
}	}
}	}
unless (@roles < 1) {	unless ($endfilter eq '.' \|\| !defined($endfilter)) {
unless (grep/^\Q$trole\E$/,@roles) {	if ((defined($end)) && (($end > 0) && ($end <= $endfilter))) {
$match = 0;	$match = 0;
	next;
}	}
}	}
if ($match == 1) {	if ($match == 1) {
Line 4612 sub enrollment_enabled_handler {	Line 4763 sub enrollment_enabled_handler {
}	}
&register_handler("autorun", \&enrollment_enabled_handler, 0, 1, 0);	&register_handler("autorun", \&enrollment_enabled_handler, 0, 1, 0);

	#
	# Validate an institutional code used for a LON-CAPA course.
	#
	# Formal Parameters:
	# $cmd - The command request that got us dispatched.
	# $tail - The tail of the command. In this case,
	# this is a colon separated set of words that will be split
	# into:
	# $dom - The domain for which the check of
	# institutional course code will occur.
	#
	# $instcode - The institutional code for the course
	# being requested, or validated for rights
	# to request.
	#
	# $owner - The course requestor (who will be the
	# course owner, in the form username:domain
	#
	# $client - Socket open on the client.
	# Returns:
	# 1 - Indicating processing should continue.
	#
	sub validate_instcode_handler {
	my ($cmd, $tail, $client) = @_;
	my $userinput = "$cmd:$tail";
	my ($dom,$instcode,$owner) = split(/:/, $tail);
	$instcode = &unescape($instcode);
	$owner = &unescape($owner);
	my ($outcome,$description) =
	&localenroll::validate_instcode($dom,$instcode,$owner);
	my $result = &escape($outcome).'&'.&escape($description);
	&Reply($client, \$result, $userinput);

	return 1;
	}
	&register_handler("autovalidateinstcode", \&validate_instcode_handler, 0, 1, 0);

# Get the official sections for which auto-enrollment is possible.	# Get the official sections for which auto-enrollment is possible.
# Since the admin people won't know about 'unofficial sections'	# Since the admin people won't know about 'unofficial sections'
# we cannot auto-enroll on them.	# we cannot auto-enroll on them.
Line 4815 sub retrieve_auto_file_handler {	Line 5003 sub retrieve_auto_file_handler {
}	}
&register_handler("autoretrieve", \&retrieve_auto_file_handler, 0,1,0);	&register_handler("autoretrieve", \&retrieve_auto_file_handler, 0,1,0);

	sub crsreq_checks_handler {
	my ($cmd, $tail, $client) = @_;
	my $userinput = "$cmd:$tail";
	my $dom = $tail;
	my $result;
	my @reqtypes = ('official','unofficial','community');
	eval {
	local($SIG{__DIE__})='DEFAULT';
	my %validations;
	my $response = &localenroll::crsreq_checks($dom,\@reqtypes,
	\%validations);
	if ($response eq 'ok') {
	foreach my $key (keys(%validations)) {
	$result .= &escape($key).'='.&Apache::lonnet::freeze_escape($validations{$key}).'&';
	}
	$result =~ s/\&$//;
	} else {
	$result = 'error';
	}
	};
	if (!$@) {
	&Reply($client, \$result, $userinput);
	} else {
	&Failure($client,"unknown_cmd\n",$userinput);
	}
	return 1;
	}
	&register_handler("autocrsreqchecks", \&crsreq_checks_handler, 0, 1, 0);

	sub validate_crsreq_handler {
	my ($cmd, $tail, $client) = @_;
	my $userinput = "$cmd:$tail";
	my ($dom,$owner,$crstype,$inststatuslist,$instcode,$instseclist) = split(/:/, $tail);
	$instcode = &unescape($instcode);
	$owner = &unescape($owner);
	$crstype = &unescape($crstype);
	$inststatuslist = &unescape($inststatuslist);
	$instcode = &unescape($instcode);
	$instseclist = &unescape($instseclist);
	my $outcome;
	eval {
	local($SIG{__DIE__})='DEFAULT';
	$outcome = &localenroll::validate_crsreq($dom,$owner,$crstype,
	$inststatuslist,$instcode,
	$instseclist);
	};
	if (!$@) {
	&Reply($client, \$outcome, $userinput);
	} else {
	&Failure($client,"unknown_cmd\n",$userinput);
	}
	return 1;
	}
	&register_handler("autocrsreqvalidation", \&validate_crsreq_handler, 0, 1, 0);

#	#
# Read and retrieve institutional code format (for support form).	# Read and retrieve institutional code format (for support form).
# Formal Parameters:	# Formal Parameters:
Line 4899 sub get_institutional_defaults_handler {	Line 5142 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_possible_instcodes_handler {
	my ($cmd, $tail, $client) = @_;
	my $userinput = "$cmd:$tail";

	my $reply;
	my $cdom = $tail;
	my (@codetitles,%cat_titles,%cat_order,@code_order);
	my $formatreply = &localenroll::possible_instcodes($cdom,
	\@codetitles,
	\%cat_titles,
	\%cat_order,
	\@code_order);
	if ($formatreply eq 'ok') {
	my $result = join('&',map {&escape($_);} (@codetitles)).':';
	$result .= join('&',map {&escape($_);} (@code_order)).':';
	foreach my $key (keys(%cat_titles)) {
	$result .= &escape($key).'='.&Apache::lonnet::freeze_escape($cat_titles{$key}).'&';
	}
	$result =~ s/\&$//;
	$result .= ':';
	foreach my $key (keys(%cat_order)) {
	$result .= &escape($key).'='.&Apache::lonnet::freeze_escape($cat_order{$key}).'&';
	}
	$result =~ s/\&$//;
	&Reply($client,\$result,$userinput);
	} else {
	&Reply($client, "format_error\n", $userinput);
	}
	return 1;
	}
	&register_handler("autopossibleinstcodes",
	\&get_possible_instcodes_handler,0,1,0);

sub get_institutional_user_rules {	sub get_institutional_user_rules {
my ($cmd, $tail, $client) = @_;	my ($cmd, $tail, $client) = @_;
my $userinput = "$cmd:$tail";	my $userinput = "$cmd:$tail";
Line 5981 sub make_new_child {	Line 6257 sub make_new_child {
if ($clientip eq '127.0.0.1') {	if ($clientip eq '127.0.0.1') {
$outsideip=&Apache::lonnet::get_host_ip($perlvar{'lonHostID'});	$outsideip=&Apache::lonnet::get_host_ip($perlvar{'lonHostID'});
}	}
	&ReadManagerTable();
my $clientrec=defined(&Apache::lonnet::get_hosts_from_ip($outsideip));	my $clientrec=defined(&Apache::lonnet::get_hosts_from_ip($outsideip));
my $ismanager=($managers{$outsideip} ne undef);	my $ismanager=($managers{$outsideip} ne undef);
$clientname = "[unknonwn]";	$clientname = "[unknonwn]";

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

Removed from v.1.411
changed lines
	Added in v.1.428