loncom/lonnet/perl/lonnet.pm - diff

Return to lonnet.pm CVS log

Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1056.2.8 and 1.1056.4.4

version 1.1056.2.8, 2010/10/05 12:53:30	version 1.1056.4.4, 2010/08/17 01:33:18
Line 76 use HTTP::Date;	Line 76 use HTTP::Date;
use Image::Magick;	use Image::Magick;

use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir	use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir
$_64bit %env %protocol);	$_64bit %env %protocol %loncaparevs %serverhomeIDs);

my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash,	my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash,
%userrolehash, $processmarker, $dumpcount, %coursedombuf,	%userrolehash, $processmarker, $dumpcount, %coursedombuf,
Line 196 sub get_server_timezone {	Line 196 sub get_server_timezone {
}	}

sub get_server_loncaparev {	sub get_server_loncaparev {
my ($dom,$lonhost) = @_;	my ($dom,$lonhost,$ignore_cache,$caller) = @_;
if (defined($lonhost)) {	if (defined($lonhost)) {
if (!defined(&hostname($lonhost))) {	if (!defined(&hostname($lonhost))) {
undef($lonhost);	undef($lonhost);
Line 211 sub get_server_loncaparev {	Line 211 sub get_server_loncaparev {
}	}
}	}
if (defined($lonhost)) {	if (defined($lonhost)) {
my $cachetime = 24*3600;	my $cachetime = 12*3600;
my ($loncaparev,$cached)=&is_cached_new('serverloncaparev',$lonhost);	if (!$ignore_cache) {
	my ($loncaparev,$cached)=&is_cached_new('serverloncaparev',$lonhost);
	if (defined($cached)) {
	return $loncaparev;
	}
	}
	my ($answer,$loncaparev);
	my @ids=&current_machine_ids();
	if (grep(/^\Q$lonhost\E$/,@ids)) {
	$answer = $perlvar{'lonVersion'};
	if ($answer =~ /^[\'\"]?([\d.\-]+)[\'\"]?$/) {
	$loncaparev = $1;
	}
	} else {
	$answer = &reply('serverloncaparev',$lonhost);
	if (($answer eq 'unknown_cmd') \|\| ($answer eq 'con_lost')) {
	if ($caller eq 'loncron') {
	my $ua=new LWP::UserAgent;
	$ua->timeout(20);
	my $protocol = $protocol{$lonhost};
	$protocol = 'http' if ($protocol ne 'https');
	my $url = $protocol.'://'.&hostname($lonhost).'/adm/about.html';
	my $request=new HTTP::Request('GET',$url);
	my $response=$ua->request($request);
	unless ($response->is_error()) {
	my $content = $response->content;
	if ($content =~ /<p>VERSION\:\s*([\d.\-]+)<\/p>/) {
	$loncaparev = $1;
	}
	}
	} else {
	$loncaparev = $loncaparevs{$lonhost};
	}
	} elsif ($answer =~ /^[\'\"]?([\d.\-]+)[\'\"]?$/) {
	$loncaparev = $1;
	}
	}
	return &do_cache_new('serverloncaparev',$lonhost,$loncaparev,$cachetime);
	}
	}

	sub get_server_homeID {
	my ($hostname,$ignore_cache,$caller) = @_;
	unless ($ignore_cache) {
	my ($serverhomeID,$cached)=&is_cached_new('serverhomeID',$hostname);
if (defined($cached)) {	if (defined($cached)) {
return $loncaparev;	return $serverhomeID;
} else {	}
my $loncaparev = &reply('serverloncaparev',$lonhost);	}
return &do_cache_new('serverloncaparev',$lonhost,$loncaparev,$cachetime);	my $cachetime = 12*3600;
	my $serverhomeID;
	if ($caller eq 'loncron') {
	my @machine_ids = &machine_ids($hostname);
	foreach my $id (@machine_ids) {
	my $response = &reply('serverhomeID',$id);
	unless (($response eq 'unknown_cmd') \|\| ($response eq 'con_lost')) {
	$serverhomeID = $response;
	last;
	}
}	}
	if ($serverhomeID eq '') {
	$serverhomeID = $machine_ids[-1];
	}
	} else {
	$serverhomeID = $serverhomeIDs{$hostname};
}	}
	return &do_cache_new('serverhomeID',$hostname,$serverhomeID,$cachetime);
}	}

# -------------------------------------------------- Non-critical communication	# -------------------------------------------------- Non-critical communication
Line 734 sub compare_server_load {	Line 793 sub compare_server_load {
my $userloadans = &reply('userload',$try_server);	my $userloadans = &reply('userload',$try_server);

if ($loadans !~ /\d/ && $userloadans !~ /\d/) {	if ($loadans !~ /\d/ && $userloadans !~ /\d/) {
next; #didn't get a number from the server	return; #didn't get a number from the server
}	}

my $load;	my $load;
Line 777 sub has_user_session {	Line 836 sub has_user_session {
return 0;	return 0;
}	}

	# --------- determine least loaded server in a user's domain which allows login

	sub choose_server {
	my ($udom) = @_;
	my %domconfhash = &Apache::loncommon::get_domainconf($udom);
	my %servers = &get_servers($udom);
	my $lowest_load = 30000;
	my ($login_host,$hostname);
	foreach my $lonhost (keys(%servers)) {
	my $loginvia = $domconfhash{$udom.'.login.loginvia_'.$lonhost};
	if ($loginvia eq '') {
	($login_host, $lowest_load) =
	&compare_server_load($lonhost, $login_host, $lowest_load);
	}
	}
	if ($login_host ne '') {
	$hostname = $servers{$login_host};
	}
	return ($login_host,$hostname);
	}

# --------------------------------------------- Try to change a user's password	# --------------------------------------------- Try to change a user's password

sub changepass {	sub changepass {
Line 835 sub queryauthenticate {	Line 915 sub queryauthenticate {
# --------- Try to authenticate user from domain's lib servers (first this one)	# --------- Try to authenticate user from domain's lib servers (first this one)

sub authenticate {	sub authenticate {
my ($uname,$upass,$udom,$checkdefauth)=@_;	my ($uname,$upass,$udom,$checkdefauth,$clientcancheckhost)=@_;
$upass=&escape($upass);	$upass=&escape($upass);
$uname= &LONCAPA::clean_username($uname);	$uname= &LONCAPA::clean_username($uname);
my $uhome=&homeserver($uname,$udom,1);	my $uhome=&homeserver($uname,$udom,1);
Line 858 sub authenticate {	Line 938 sub authenticate {
return 'no_host';	return 'no_host';
}	}
}	}
my $answer=reply("encrypt:auth:$udom:$uname:$upass:$checkdefauth",$uhome);	my $answer=reply("encrypt:auth:$udom:$uname:$upass:$checkdefauth:$clientcancheckhost",$uhome);
if ($answer eq 'authorized') {	if ($answer eq 'authorized') {
if ($newhome) {	if ($newhome) {
&logthis("User $uname at $udom authorized by $uhome, but needs account");	&logthis("User $uname at $udom authorized by $uhome, but needs account");
Line 876 sub authenticate {	Line 956 sub authenticate {
return 'no_host';	return 'no_host';
}	}

	sub can_host_session {
	my ($udom,$lonhost,$remoterev,$remotesessions,$hostedsessions) = @_;
	my $canhost = 1;
	my $host_idn = &Apache::lonnet::internet_dom($lonhost);
	if (ref($remotesessions) eq 'HASH') {
	if (ref($remotesessions->{'excludedomain'}) eq 'ARRAY') {
	if (grep(/^\Q$host_idn\E$/,@{$remotesessions->{'excludedomain'}})) {
	$canhost = 0;
	} else {
	$canhost = 1;
	}
	}
	if (ref($remotesessions->{'includedomain'}) eq 'ARRAY') {
	if (grep(/^\Q$host_idn\E$/,@{$remotesessions->{'includedomain'}})) {
	$canhost = 1;
	} else {
	$canhost = 0;
	}
	}
	if ($canhost) {
	if ($remotesessions->{'version'} ne '') {
	my ($reqmajor,$reqminor) = ($remotesessions->{'version'} =~ /^(\d+)\.(\d+)$/);
	if ($reqmajor ne '' && $reqminor ne '') {
	if ($remoterev =~ /^\'?(\d+)\.(\d+)/) {
	my $major = $1;
	my $minor = $2;
	if (($major < $reqmajor ) \|\|
	(($major == $reqmajor) && ($minor < $reqminor))) {
	$canhost = 0;
	}
	} else {
	$canhost = 0;
	}
	}
	}
	}
	}
	if ($canhost) {
	if (ref($hostedsessions) eq 'HASH') {
	if (ref($hostedsessions->{'excludedomain'}) eq 'ARRAY') {
	if (grep(/^\Q$udom\E$/,@{$hostedsessions->{'excludedomain'}})) {
	$canhost = 0;
	} else {
	$canhost = 1;
	}
	}
	if (ref($hostedsessions->{'includedomain'}) eq 'ARRAY') {
	if (grep(/^\Q$udom\E$/,@{$hostedsessions->{'includedomain'}})) {
	$canhost = 1;
	} else {
	$canhost = 0;
	}
	}
	}
	}
	return $canhost;
	}

# ---------------------- Find the homebase for a user from domain's lib servers	# ---------------------- Find the homebase for a user from domain's lib servers

my %homecache;	my %homecache;
Line 1352 sub get_domain_defaults {	Line 1490 sub get_domain_defaults {
my %domconfig =	my %domconfig =
&Apache::lonnet::get_dom('configuration',['defaults','quotas',	&Apache::lonnet::get_dom('configuration',['defaults','quotas',
'requestcourses','inststatus',	'requestcourses','inststatus',
'coursedefaults'],$domain);	'coursedefaults','usersessions'],$domain);
if (ref($domconfig{'defaults'}) eq 'HASH') {	if (ref($domconfig{'defaults'}) eq 'HASH') {
$domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'};	$domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'};
$domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'};	$domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'};
Line 1392 sub get_domain_defaults {	Line 1530 sub get_domain_defaults {
$domdefaults{$item} = $domconfig{'coursedefaults'}{$item};	$domdefaults{$item} = $domconfig{'coursedefaults'}{$item};
}	}
}	}
	if (ref($domconfig{'usersessions'}) eq 'HASH') {
	if (ref($domconfig{'usersessions'}{'remote'}) eq 'HASH') {
	$domdefaults{'remotesessions'} = $domconfig{'usersessions'}{'remote'};
	}
	if (ref($domconfig{'usersessions'}{'hosted'}) eq 'HASH') {
	$domdefaults{'hostedsessions'} = $domconfig{'usersessions'}{'hosted'};
	}
	}
&Apache::lonnet::do_cache_new('domdefaults',$domain,\%domdefaults,	&Apache::lonnet::do_cache_new('domdefaults',$domain,\%domdefaults,
$cachetime);	$cachetime);
return %domdefaults;	return %domdefaults;
Line 3906 sub rolesinit {	Line 4052 sub rolesinit {
my ($domain,$username,$authhost)=@_;	my ($domain,$username,$authhost)=@_;
my $now=time;	my $now=time;
my %userroles = ('user.login.time' => $now);	my %userroles = ('user.login.time' => $now);
my $rolesdump=reply("dump:$domain:$username:roles",$authhost);	my $extra = &freeze_escape({'clientcheckrole' => 1});
	my $rolesdump=reply("dump:$domain:$username:roles:.::$extra",$authhost);
if (($rolesdump eq 'con_lost') \|\| ($rolesdump eq '') \|\|	if (($rolesdump eq 'con_lost') \|\| ($rolesdump eq '') \|\|
($rolesdump =~ /^error:/)) {	($rolesdump =~ /^error:/)) {
return \%userroles;	return \%userroles;
}	}
my %allroles=();	my %allroles=();
Line 4057 sub set_userprivs {	Line 4204 sub set_userprivs {
foreach my $group (keys(%{$$allgroups{$area}})) {	foreach my $group (keys(%{$$allgroups{$area}})) {
my $spec = $trole.'.'.$extendedarea;	my $spec = $trole.'.'.$extendedarea;
$grouproles{$spec.'.'.$area.'/'.$group} =	$grouproles{$spec.'.'.$area.'/'.$group} =
$$allgroups{$area}{$group};	$$allgroups{$area}{$group};
}	}
}	}
}	}
Line 4121 sub role_status {	Line 4268 sub role_status {
my %rolehash = &get('roles',[$$where.'_'.$$role],$env{'user.domain'},	my %rolehash = &get('roles',[$$where.'_'.$$role],$env{'user.domain'},
$env{'user.name'});	$env{'user.name'});
my ($trole) = split('_',$rolehash{$$where.'_'.$$role},2);	my ($trole) = split('_',$rolehash{$$where.'_'.$$role},2);

(undef,my $group_privs) = split(/\//,$trole);	(undef,my $group_privs) = split(/\//,$trole);
$group_privs = &unescape($group_privs);	$group_privs = &unescape($group_privs);
&group_roleprivs(\%allgroups,$$where,$group_privs,$$tend,$$tstart);	&group_roleprivs(\%allgroups,$$where,$group_privs,$$tend,$$tstart);
Line 4175 sub role_status {	Line 4323 sub role_status {
}	}

sub check_adhoc_privs {	sub check_adhoc_privs {
my ($cdom,$cnum,$then,$refresh,$now,$checkrole,$caller) = @_;	my ($cdom,$cnum,$then,$refresh,$now,$checkrole) = @_;
my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum;	my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum;
if ($env{$cckey}) {	if ($env{$cckey}) {
my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend);	my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend);
&role_status($cckey,$then,$refresh,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);	&role_status($cckey,$then,$refresh,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
unless (($tstatus eq 'is') \|\| ($tstatus eq 'will_not')) {	unless (($tstatus eq 'is') \|\| ($tstatus eq 'will_not')) {
&set_adhoc_privileges($cdom,$cnum,$checkrole,$caller);	&set_adhoc_privileges($cdom,$cnum,$checkrole);
}	}
} else {	} else {
&set_adhoc_privileges($cdom,$cnum,$checkrole,$caller);	&set_adhoc_privileges($cdom,$cnum,$checkrole);
}	}
}	}

sub set_adhoc_privileges {	sub set_adhoc_privileges {
# role can be cc or ca	# role can be cc or ca
my ($dcdom,$pickedcourse,$role,$caller) = @_;	my ($dcdom,$pickedcourse,$role) = @_;
my $area = '/'.$dcdom.'/'.$pickedcourse;	my $area = '/'.$dcdom.'/'.$pickedcourse;
my $spec = $role.'.'.$area;	my $spec = $role.'.'.$area;
my %userroles = &set_arearole($role,$area,'','',$env{'user.domain'},	my %userroles = &set_arearole($role,$area,'','',$env{'user.domain'},
Line 4200 sub set_adhoc_privileges {	Line 4348 sub set_adhoc_privileges {
my ($author,$adv)= &set_userprivs(\%userroles,\%ccrole);	my ($author,$adv)= &set_userprivs(\%userroles,\%ccrole);
&appenv(\%userroles,[$role,'cm']);	&appenv(\%userroles,[$role,'cm']);
&log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$role);	&log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$role);
unless ($caller eq 'constructaccess' && $env{'request.course.id'}) {	&appenv( {'request.role' => $spec,
&appenv( {'request.role' => $spec,	'request.role.domain' => $dcdom,
'request.role.domain' => $dcdom,	'request.course.sec' => ''
'request.course.sec' => ''	}
}	);
);	my $tadv=0;
my $tadv=0;	if (&allowed('adv') eq 'F') { $tadv=1; }
if (&allowed('adv') eq 'F') { $tadv=1; }	&appenv({'request.role.adv' => $tadv});
&appenv({'request.role.adv' => $tadv});
}
}	}

# --------------------------------------------------------------- get interface	# --------------------------------------------------------------- get interface
Line 6582 sub modifyuser {	Line 6728 sub modifyuser {
}	}
&logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '.	&logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '.
$umode.', '.$first.', '.$middle.', '.	$umode.', '.$first.', '.$middle.', '.
$last.', '.$gene.'(forceid: '.$forceid.'; candelete: '.$showcandelete.')'.	$last.', '.$gene.'(forceid: '.$forceid.'; candelete: '.$showcandelete.')'.
(defined($desiredhome) ? ' desiredhome = '.$desiredhome :	(defined($desiredhome) ? ' desiredhome = '.$desiredhome :
' desiredhome not specified').	' desiredhome not specified').
' by '.$env{'user.name'}.' at '.$env{'user.domain'}.	' by '.$env{'user.name'}.' at '.$env{'user.domain'}.
Line 6592 sub modifyuser {	Line 6738 sub modifyuser {
if ($uhome eq 'no_host') {	if ($uhome eq 'no_host') {
$newuser = 1;	$newuser = 1;
}	}

# ----------------------------------------------------------------- Create User	# ----------------------------------------------------------------- Create User
if (($uhome eq 'no_host') &&	if (($uhome eq 'no_host') &&
(($umode && $upass) \|\| ($umode eq 'localauth'))) {	(($umode && $upass) \|\| ($umode eq 'localauth'))) {
Line 6651 sub modifyuser {	Line 6798 sub modifyuser {
%names = @tmp;	%names = @tmp;
%oldnames = %names;	%oldnames = %names;
}	}
#
# If name, email and/or uid are blank (e.g., because an uploaded file	# If name, email and/or uid are blank (e.g., because an uploaded file
# of users did not contain them), do not overwrite existing values	# of users did not contain them), do not overwrite existing values
# unless field is in $candelete array ref.	# unless field is in $candelete array ref.
#	#

my @fields = ('firstname','middlename','lastname','generation',	my @fields = ('firstname','middlename','lastname','generation',
'permanentemail','id');	'permanentemail','id');
my %newvalues;	my %newvalues;
Line 6668 sub modifyuser {	Line 6815 sub modifyuser {
$names{$field} = $middle;	$names{$field} = $middle;
} elsif ($field eq 'lastname') {	} elsif ($field eq 'lastname') {
$names{$field} = $last;	$names{$field} = $last;
} elsif ($field eq 'generation') {	} elsif ($field eq 'generation') {
$names{$field} = $gene;	$names{$field} = $gene;
} elsif ($field eq 'permanentemail') {	} elsif ($field eq 'permanentemail') {
$names{$field} = $email;	$names{$field} = $email;
Line 6678 sub modifyuser {	Line 6825 sub modifyuser {
}	}
}	}
}	}

if ($first) { $names{'firstname'} = $first; }	if ($first) { $names{'firstname'} = $first; }
if (defined($middle)) { $names{'middlename'} = $middle; }	if (defined($middle)) { $names{'middlename'} = $middle; }
if ($last) { $names{'lastname'} = $last; }	if ($last) { $names{'lastname'} = $last; }
Line 6703 sub modifyuser {	Line 6849 sub modifyuser {
}	}
}	}
}	}
	my $reply = &put('environment', \%names, $udom,$uname);
	if ($reply ne 'ok') { return 'error: '.$reply; }
	my $sqlresult = &update_allusers_table($uname,$udom,\%names);
	&devalidate_cache_new('namescache',$uname.':'.$udom);
my $logmsg = $udom.', '.$uname.', '.$uid.', '.	my $logmsg = $udom.', '.$uname.', '.$uid.', '.
$umode.', '.$first.', '.$middle.', '.	$umode.', '.$first.', '.$middle.', '.
$last.', '.$gene.', '.$email.', '.$inststatus;	$last.', '.$gene.', '.$email.', '.$inststatus;
if ($env{'user.name'} ne '' && $env{'user.domain'}) {	if ($env{'user.name'} ne '' && $env{'user.domain'}) {
$logmsg .= ' by '.$env{'user.name'}.' at '.$env{'user.domain'};	$logmsg .= ' by '.$env{'user.name'}.' at '.$env{'user.domain'};
} else {	} else {
Line 6731 sub modifyuser {	Line 6881 sub modifyuser {
if ($reply ne 'ok') {	if ($reply ne 'ok') {
return 'error: '.$reply;	return 'error: '.$reply;
}	}
if ($names{'permanentemail'} ne $oldnames{'permanentemail'}) {
&Apache::lonnet::devalidate_cache_new('emailscache',$uname.':'.$udom);
}
my $sqlresult = &update_allusers_table($uname,$udom,\%names);	my $sqlresult = &update_allusers_table($uname,$udom,\%names);
&devalidate_cache_new('namescache',$uname.':'.$udom);	&devalidate_cache_new('namescache',$uname.':'.$udom);
$logmsg = 'Success modifying user '.$logmsg;	$logmsg = 'Success modifying user '.$logmsg;
Line 9842 sub get_dns {	Line 9989 sub get_dns {
return %libserv;	return %libserv;
}	}

	sub unique_library {
	#2x reverse removes all hostnames that appear more than once
	my %unique = reverse &all_library();
	return reverse %unique;
	}

sub get_servers {	sub get_servers {
&load_hosts_tab() if (!$loaded);	&load_hosts_tab() if (!$loaded);

Line 9865 sub get_dns {	Line 10018 sub get_dns {
return %result;	return %result;
}	}

	sub get_unique_servers {
	my %unique = reverse &get_servers(@_);
	return reverse %unique;
	}

sub host_domain {	sub host_domain {
&load_hosts_tab() if (!$loaded);	&load_hosts_tab() if (!$loaded);

Line 9879 sub get_dns {	Line 10037 sub get_dns {
my @uniq = grep(!$seen{$_}++, values(%hostdom));	my @uniq = grep(!$seen{$_}++, values(%hostdom));
return @uniq;	return @uniq;
}	}

	sub internet_dom {
	&load_hosts_tab() if (!$loaded);

	my ($lonid) = @_;
	return $internetdom{$lonid};
	}

}	}

{	{
Line 9996 sub get_dns {	Line 10162 sub get_dns {
return undef;	return undef;
}	}

	sub get_internet_names {
	my ($lonid) = @_;
	return if ($lonid eq '');
	my ($idnref,$cached)=
	&Apache::lonnet::is_cached_new('internetnames',$lonid);
	if ($cached) {
	return $idnref;
	}
	my $ip = &get_host_ip($lonid);
	my @hosts = &get_hosts_from_ip($ip);
	my %iphost = &get_iphost();
	my (@idns,%seen);
	foreach my $id (@hosts) {
	my $dom = &host_domain($id);
	my $prim_id = &domain($dom,'primary');
	my $prim_ip = &get_host_ip($prim_id);
	next if ($seen{$prim_ip});
	if (ref($iphost{$prim_ip}) eq 'ARRAY') {
	foreach my $id (@{$iphost{$prim_ip}}) {
	my $intdom = &internet_dom($id);
	unless (grep(/^\Q$intdom\E$/,@idns)) {
	push(@idns,$intdom);
	}
	}
	}
	$seen{$prim_ip} = 1;
	}
	return &Apache::lonnet::do_cache_new('internetnames',$lonid,\@idns,126060);
	}

	}

	sub all_loncaparevs {
	return qw(1.1 1.2 1.3 2.0 2.1 2.2 2.3 2.4 2.5 2.6 2.7 2.8 2.9 2.10);
}	}

BEGIN {	BEGIN {
Line 10073 BEGIN {	Line 10273 BEGIN {
close($config);	close($config);
}	}

	# ---------------------------------------------------------- Read loncaparev table
	{
	if (-e "$perlvar{'lonTabDir'}/loncaparevs.tab") {
	if (open(my $config,"<$perlvar{'lonTabDir'}/loncaparevs.tab")) {
	while (my $configline=<$config>) {
	chomp($configline);
	my ($hostid,$loncaparev)=split(/:/,$configline);
	$loncaparevs{$hostid}=$loncaparev;
	}
	close($config);
	}
	}
	}

	# ---------------------------------------------------------- Read serverhostID table
	{
	if (-e "$perlvar{'lonTabDir'}/serverhomeIDs.tab") {
	if (open(my $config,"<$perlvar{'lonTabDir'}/serverhomeIDs.tab")) {
	while (my $configline=<$config>) {
	chomp($configline);
	my ($name,$id)=split(/:/,$configline);
	$serverhomeIDs{$name}=$id;
	}
	close($config);
	}
	}
	}

# ------------- set up temporary directory	# ------------- set up temporary directory
{	{
$tmpdir = $perlvar{'lonDaemons'}.'/tmp/';	$tmpdir = $perlvar{'lonDaemons'}.'/tmp/';
Line 10303 authentication scheme	Line 10531 authentication scheme

=item *	=item *
X<authenticate()>	X<authenticate()>
B<authenticate($uname,$upass,$udom)>: try to	B<authenticate($uname,$upass,$udom,$checkdefauth,$clientcancheckhost)>: try to
authenticate user from domain's lib servers (first use the current	authenticate user from domain's lib servers (first use the current
one). C<$upass> should be the users password.	one). C<$upass> should be the users password.
	$checkdefauth is optional (value is 1 if a check should be made to
	authenticate user using default authentication method, and allow
	account creation if username does not have account in the domain).
	$clientcancheckhost is optional (value is 1 if checking whether the
	server can host will occur on the client side in lonauth.pm).

=item *	=item *
X<homeserver()>	X<homeserver()>
Line 10433 modifyuser($udom,$uname,$uid,$umode,$upa	Line 10666 modifyuser($udom,$uname,$uid,$umode,$upa
will update user information (firstname,middlename,lastname,generation,	will update user information (firstname,middlename,lastname,generation,
permanentemail), and if forceid is true, student/employee ID also.	permanentemail), and if forceid is true, student/employee ID also.
A user's institutional affiliation(s) can also be updated.	A user's institutional affiliation(s) can also be updated.
User information fields will not be overwritten with empty entries	User information fields will not be overwritten with empty entries
unless the field is included in the $candelete array reference.	unless the field is included in the $candelete array reference.
This array is included when a single user is modified via "Manage Users",	This array is included when a single user is modified via "Manage Users",
or when Autoupdate.pl is run by cron in a domain.	or when Autoupdate.pl is run by cron in a domain.

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

Removed from v.1.1056.2.8
changed lines
	Added in v.1.1056.4.4