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.1487 and 1.1514

version 1.1487, 2022/06/08 20:49:09	version 1.1514, 2023/07/29 20:33:26
Line 415 sub remote_devalidate_cache {	Line 415 sub remote_devalidate_cache {
return $response;	return $response;
}	}

	sub sign_lti {
	my ($cdom,$cnum,$crsdef,$type,$context,$url,$ltinum,$keynum,$paramsref,$inforef) = @_;
	my $chome;
	if (&domain($cdom) ne '') {
	if ($crsdef) {
	$chome = &homeserver($cnum,$cdom);
	} else {
	$chome = &domain($cdom,'primary');
	}
	}
	if ($cdom && $chome && ($chome ne 'no_host')) {
	if ((ref($paramsref) eq 'HASH') &&
	(ref($inforef) eq 'HASH')) {
	my $rep;
	if (grep { $_ eq $chome } &current_machine_ids()) {
	# domain information is hosted on this machine
	$rep =
	&LONCAPA::Lond::sign_lti_payload($cdom,$cnum,$crsdef,$type,
	$context,$url,$ltinum,$keynum,
	$perlvar{'lonVersion'},
	$paramsref,$inforef);
	if (ref($rep) eq 'HASH') {
	return ('ok',$rep);
	}
	} else {
	my ($escurl,$params,$info);
	$escurl = &escape($url);
	if (ref($paramsref) eq 'HASH') {
	$params = &freeze_escape($paramsref);
	}
	if (ref($inforef) eq 'HASH') {
	$info = &freeze_escape($inforef);
	}
	$rep=&reply("encrypt:signlti:$cdom:$cnum:$crsdef:$type:$context:$escurl:$ltinum:$keynum:$params:$info",$chome);
	}
	if (($rep eq '') \|\| ($rep =~ /^con_lost\|error\|no_such_host\|unknown_cmd/i)) {
	return ();
	} elsif (($inforef->{'respfmt'} eq 'to_post_body') \|\|
	($inforef->{'respfmt'} eq 'to_authorization_header')) {
	return ('ok',$rep);
	} else {
	my %returnhash;
	foreach my $item (split(/\&/,$rep)) {
	my ($name,$value)=split(/\=/,$item);
	$returnhash{&unescape($name)}=&thaw_unescape($value);
	}
	return('ok',\%returnhash);
	}
	} else {
	return ();
	}
	} else {
	return ();
	&logthis("sign_lti failed - no homeserver and/or domain ($cdom) ($chome)");
	}
	}

# -------------------------------------------------- Non-critical communication	# -------------------------------------------------- Non-critical communication
sub subreply {	sub subreply {
my ($cmd,$server)=@_;	my ($cmd,$server)=@_;
Line 985 sub spareserver {	Line 1042 sub spareserver {
: $userloadpercent;	: $userloadpercent;
my ($uint_dom,$remotesessions);	my ($uint_dom,$remotesessions);
if (($udom ne '') && (&domain($udom) ne '')) {	if (($udom ne '') && (&domain($udom) ne '')) {
my $uprimary_id = &Apache::lonnet::domain($udom,'primary');	my $uprimary_id = &domain($udom,'primary');
$uint_dom = &Apache::lonnet::internet_dom($uprimary_id);	$uint_dom = &internet_dom($uprimary_id);
my %udomdefaults = &Apache::lonnet::get_domain_defaults($udom);	my %udomdefaults = &get_domain_defaults($udom);
$remotesessions = $udomdefaults{'remotesessions'};	$remotesessions = $udomdefaults{'remotesessions'};
}	}
my $spareshash = &this_host_spares($udom);	my $spareshash = &this_host_spares($udom);
Line 1023 sub spareserver {	Line 1080 sub spareserver {
if ($protocol{$spare_server} eq 'https') {	if ($protocol{$spare_server} eq 'https') {
$protocol = $protocol{$spare_server};	$protocol = $protocol{$spare_server};
}	}
my $alias = &Apache::lonnet::use_proxy_alias($r,$spare_server);	my $alias = &use_proxy_alias($r,$spare_server);
$hostname = $alias if ($alias ne '');	$hostname = $alias if ($alias ne '');
$spare_server = $protocol.'://'.$hostname;	$spare_server = $protocol.'://'.$hostname;
}	}
Line 1211 sub choose_server {	Line 1268 sub choose_server {
unless (defined($cached)) {	unless (defined($cached)) {
my $cachetime = 606024;	my $cachetime = 606024;
my %domconfig =	my %domconfig =
&Apache::lonnet::get_dom('configuration',['loadbalancing'],$udom);	&get_dom('configuration',['loadbalancing'],$udom);
if (ref($domconfig{'loadbalancing'}) eq 'HASH') {	if (ref($domconfig{'loadbalancing'}) eq 'HASH') {
$balancers = &do_cache_new('loadbalancing',$udom,$domconfig{'loadbalancing'},	$balancers = &do_cache_new('loadbalancing',$udom,$domconfig{'loadbalancing'},
$cachetime);	$cachetime);
Line 1378 sub authenticate {	Line 1435 sub authenticate {
return 'no_host';	return 'no_host';
}	}

	sub can_switchserver {
	my ($udom,$home) = @_;
	my ($canswitch,@intdoms);
	my $internet_names = &get_internet_names($home);
	if (ref($internet_names) eq 'ARRAY') {
	@intdoms = @{$internet_names};
	}
	my $uint_dom = &internet_dom(&domain($udom,'primary'));
	if ($uint_dom ne '' && grep(/^\Q$uint_dom\E$/,@intdoms)) {
	$canswitch = 1;
	} else {
	my $serverhomeID = &get_server_homeID(&hostname($home));
	my $serverhomedom = &host_domain($serverhomeID);
	my %defdomdefaults = &get_domain_defaults($serverhomedom);
	my %udomdefaults = &get_domain_defaults($udom);
	my $remoterev = &get_server_loncaparev('',$home);
	$canswitch = &can_host_session($udom,$home,$remoterev,
	$udomdefaults{'remotesessions'},
	$defdomdefaults{'hostedsessions'});
	}
	return $canswitch;
	}

sub can_host_session {	sub can_host_session {
my ($udom,$lonhost,$remoterev,$remotesessions,$hostedsessions) = @_;	my ($udom,$lonhost,$remoterev,$remotesessions,$hostedsessions) = @_;
my $canhost = 1;	my $canhost = 1;
my $host_idn = &Apache::lonnet::internet_dom($lonhost);	my $host_idn = &internet_dom($lonhost);
if (ref($remotesessions) eq 'HASH') {	if (ref($remotesessions) eq 'HASH') {
if (ref($remotesessions->{'excludedomain'}) eq 'ARRAY') {	if (ref($remotesessions->{'excludedomain'}) eq 'ARRAY') {
if (grep(/^\Q$host_idn\E$/,@{$remotesessions->{'excludedomain'}})) {	if (grep(/^\Q$host_idn\E$/,@{$remotesessions->{'excludedomain'}})) {
Line 1417 sub can_host_session {	Line 1497 sub can_host_session {
}	}
if ($canhost) {	if ($canhost) {
if (ref($hostedsessions) eq 'HASH') {	if (ref($hostedsessions) eq 'HASH') {
my $uprimary_id = &Apache::lonnet::domain($udom,'primary');	my $uprimary_id = &domain($udom,'primary');
my $uint_dom = &Apache::lonnet::internet_dom($uprimary_id);	my $uint_dom = &internet_dom($uprimary_id);
if (ref($hostedsessions->{'excludedomain'}) eq 'ARRAY') {	if (ref($hostedsessions->{'excludedomain'}) eq 'ARRAY') {
if (($uint_dom ne '') &&	if (($uint_dom ne '') &&
(grep(/^\Q$uint_dom\E$/,@{$hostedsessions->{'excludedomain'}}))) {	(grep(/^\Q$uint_dom\E$/,@{$hostedsessions->{'excludedomain'}}))) {
Line 1510 sub spares_for_offload {	Line 1590 sub spares_for_offload {
} else {	} else {
my $cachetime = 606024;	my $cachetime = 606024;
my %domconfig =	my %domconfig =
&Apache::lonnet::get_dom('configuration',['usersessions'],$dom_in_use);	&get_dom('configuration',['usersessions'],$dom_in_use);
if (ref($domconfig{'usersessions'}) eq 'HASH') {	if (ref($domconfig{'usersessions'}) eq 'HASH') {
if (ref($domconfig{'usersessions'}{'spares'}) eq 'HASH') {	if (ref($domconfig{'usersessions'}{'spares'}) eq 'HASH') {
if (ref($domconfig{'usersessions'}{'spares'}{$lonhost_in_use}) eq 'HASH') {	if (ref($domconfig{'usersessions'}{'spares'}{$lonhost_in_use}) eq 'HASH') {
Line 1562 sub check_loadbalancing {	Line 1642 sub check_loadbalancing {
$rule_in_effect,$offloadto,$otherserver,$setcookie,$dom_balancers);	$rule_in_effect,$offloadto,$otherserver,$setcookie,$dom_balancers);
my $lonhost = $perlvar{'lonHostID'};	my $lonhost = $perlvar{'lonHostID'};
my @hosts = &current_machine_ids();	my @hosts = &current_machine_ids();
my $uprimary_id = &Apache::lonnet::domain($udom,'primary');	my $uprimary_id = &domain($udom,'primary');
my $uintdom = &Apache::lonnet::internet_dom($uprimary_id);	my $uintdom = &internet_dom($uprimary_id);
my $intdom = &Apache::lonnet::internet_dom($lonhost);	my $intdom = &internet_dom($lonhost);
my $serverhomedom = &host_domain($lonhost);	my $serverhomedom = &host_domain($lonhost);
my $domneedscache;	my $domneedscache;
my $cachetime = 606024;	my $cachetime = 606024;
Line 1578 sub check_loadbalancing {	Line 1658 sub check_loadbalancing {
my ($result,$cached)=&is_cached_new('loadbalancing',$dom_in_use);	my ($result,$cached)=&is_cached_new('loadbalancing',$dom_in_use);
unless (defined($cached)) {	unless (defined($cached)) {
my %domconfig =	my %domconfig =
&Apache::lonnet::get_dom('configuration',['loadbalancing'],$dom_in_use);	&get_dom('configuration',['loadbalancing'],$dom_in_use);
if (ref($domconfig{'loadbalancing'}) eq 'HASH') {	if (ref($domconfig{'loadbalancing'}) eq 'HASH') {
$result = &do_cache_new('loadbalancing',$dom_in_use,$domconfig{'loadbalancing'},$cachetime);	$result = &do_cache_new('loadbalancing',$dom_in_use,$domconfig{'loadbalancing'},$cachetime);
} else {	} else {
Line 1639 sub check_loadbalancing {	Line 1719 sub check_loadbalancing {
($result,$cached)=&is_cached_new('loadbalancing',$serverhomedom);	($result,$cached)=&is_cached_new('loadbalancing',$serverhomedom);
unless (defined($cached)) {	unless (defined($cached)) {
my %domconfig =	my %domconfig =
&Apache::lonnet::get_dom('configuration',['loadbalancing'],$serverhomedom);	&get_dom('configuration',['loadbalancing'],$serverhomedom);
if (ref($domconfig{'loadbalancing'}) eq 'HASH') {	if (ref($domconfig{'loadbalancing'}) eq 'HASH') {
$result = &do_cache_new('loadbalancing',$serverhomedom,$domconfig{'loadbalancing'},$cachetime);	$result = &do_cache_new('loadbalancing',$serverhomedom,$domconfig{'loadbalancing'},$cachetime);
} else {	} else {
Line 1772 sub get_loadbalancer_targets {	Line 1852 sub get_loadbalancer_targets {
}	}
} elsif ($rule_in_effect eq 'externalbalancer') {	} elsif ($rule_in_effect eq 'externalbalancer') {
my %domconfig =	my %domconfig =
&Apache::lonnet::get_dom('configuration',['loadbalancing'],$udom);	&get_dom('configuration',['loadbalancing'],$udom);
if (ref($domconfig{'loadbalancing'}) eq 'HASH') {	if (ref($domconfig{'loadbalancing'}) eq 'HASH') {
if ($domconfig{'loadbalancing'}{'lonhost'} ne '') {	if ($domconfig{'loadbalancing'}{'lonhost'} ne '') {
if (&hostname($domconfig{'loadbalancing'}{'lonhost'}) ne '') {	if (&hostname($domconfig{'loadbalancing'}{'lonhost'}) ne '') {
Line 1836 sub trusted_domains {	Line 1916 sub trusted_domains {
return ($trusted,$untrusted);	return ($trusted,$untrusted);
}	}
my $callprimary = &domain($calldom,'primary');	my $callprimary = &domain($calldom,'primary');
my $intcalldom = &Apache::lonnet::internet_dom($callprimary);	my $intcalldom = &internet_dom($callprimary);
if ($intcalldom eq '') {	if ($intcalldom eq '') {
return ($trusted,$untrusted);	return ($trusted,$untrusted);
}	}

my ($trustconfig,$cached)=&Apache::lonnet::is_cached_new('trust',$calldom);	my ($trustconfig,$cached)=&is_cached_new('trust',$calldom);
unless (defined($cached)) {	unless (defined($cached)) {
my %domconfig = &Apache::lonnet::get_dom('configuration',['trust'],$calldom);	my %domconfig = &get_dom('configuration',['trust'],$calldom);
&Apache::lonnet::do_cache_new('trust',$calldom,$domconfig{'trust'},3600);	&do_cache_new('trust',$calldom,$domconfig{'trust'},3600);
$trustconfig = $domconfig{'trust'};	$trustconfig = $domconfig{'trust'};
}	}
if (ref($trustconfig)) {	if (ref($trustconfig)) {
Line 2322 sub get_domainconfiguser {	Line 2402 sub get_domainconfiguser {
sub retrieve_inst_usertypes {	sub retrieve_inst_usertypes {
my ($udom) = @_;	my ($udom) = @_;
my (%returnhash,@order);	my (%returnhash,@order);
my %domdefs = &Apache::lonnet::get_domain_defaults($udom);	my %domdefs = &get_domain_defaults($udom);
if ((ref($domdefs{'inststatustypes'}) eq 'HASH') &&	if ((ref($domdefs{'inststatustypes'}) eq 'HASH') &&
(ref($domdefs{'inststatusorder'}) eq 'ARRAY')) {	(ref($domdefs{'inststatusorder'}) eq 'ARRAY')) {
return ($domdefs{'inststatustypes'},$domdefs{'inststatusorder'});	return ($domdefs{'inststatustypes'},$domdefs{'inststatusorder'});
Line 2670 sub get_domain_defaults {	Line 2750 sub get_domain_defaults {
}	}
my %domdefaults;	my %domdefaults;
my %domconfig =	my %domconfig =
&Apache::lonnet::get_dom('configuration',['defaults','quotas',	&get_dom('configuration',['defaults','quotas',
'requestcourses','inststatus',	'requestcourses','inststatus',
'coursedefaults','usersessions',	'coursedefaults','usersessions',
'requestauthor','selfenrollment',	'requestauthor','selfenrollment',
'coursecategories','ssl','autoenroll',	'coursecategories','ssl','autoenroll',
'trust','helpsettings','wafproxy','ltisec'],$domain);	'trust','helpsettings','wafproxy',
	'ltisec','toolsec','domexttool',
	'exttool','privacy'],$domain);
my @coursetypes = ('official','unofficial','community','textbook','placement');	my @coursetypes = ('official','unofficial','community','textbook','placement');
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'};
Line 2684 sub get_domain_defaults {	Line 2766 sub get_domain_defaults {
$domdefaults{'timezone_def'} = $domconfig{'defaults'}{'timezone_def'};	$domdefaults{'timezone_def'} = $domconfig{'defaults'}{'timezone_def'};
$domdefaults{'datelocale_def'} = $domconfig{'defaults'}{'datelocale_def'};	$domdefaults{'datelocale_def'} = $domconfig{'defaults'}{'datelocale_def'};
$domdefaults{'portal_def'} = $domconfig{'defaults'}{'portal_def'};	$domdefaults{'portal_def'} = $domconfig{'defaults'}{'portal_def'};
	$domdefaults{'portal_def_email'} = $domconfig{'defaults'}{'portal_def_email'};
	$domdefaults{'portal_def_web'} = $domconfig{'defaults'}{'portal_def_web'};
$domdefaults{'intauth_cost'} = $domconfig{'defaults'}{'intauth_cost'};	$domdefaults{'intauth_cost'} = $domconfig{'defaults'}{'intauth_cost'};
$domdefaults{'intauth_switch'} = $domconfig{'defaults'}{'intauth_switch'};	$domdefaults{'intauth_switch'} = $domconfig{'defaults'}{'intauth_switch'};
$domdefaults{'intauth_check'} = $domconfig{'defaults'}{'intauth_check'};	$domdefaults{'intauth_check'} = $domconfig{'defaults'}{'intauth_check'};
Line 2739 sub get_domain_defaults {	Line 2823 sub get_domain_defaults {
if (ref($domconfig{'coursedefaults'}{'uploadquota'}) eq 'HASH') {	if (ref($domconfig{'coursedefaults'}{'uploadquota'}) eq 'HASH') {
$domdefaults{$type.'quota'} = $domconfig{'coursedefaults'}{'uploadquota'}{$type};	$domdefaults{$type.'quota'} = $domconfig{'coursedefaults'}{'uploadquota'}{$type};
}	}
	if (ref($domconfig{'coursedefaults'}{'coursequota'}) eq 'HASH') {
	$domdefaults{$type.'coursequota'} = $domconfig{'coursedefaults'}{'coursequota'}{$type};
	}
if ($domdefaults{'postsubmit'} eq 'on') {	if ($domdefaults{'postsubmit'} eq 'on') {
if (ref($domconfig{'coursedefaults'}{'postsubmit'}{'timeout'}) eq 'HASH') {	if (ref($domconfig{'coursedefaults'}{'postsubmit'}{'timeout'}) eq 'HASH') {
$domdefaults{$type.'postsubtimeout'} =	$domdefaults{$type.'postsubtimeout'} =
$domconfig{'coursedefaults'}{'postsubmit'}{'timeout'}{$type};	$domconfig{'coursedefaults'}{'postsubmit'}{'timeout'}{$type};
}	}
}	}
	if (ref($domconfig{'coursedefaults'}{'domexttool'}) eq 'HASH') {
	$domdefaults{$type.'domexttool'} = $domconfig{'coursedefaults'}{'domexttool'}{$type};
	} else {
	$domdefaults{$type.'domexttool'} = 1;
	}
	if (ref($domconfig{'coursedefaults'}{'exttool'}) eq 'HASH') {
	$domdefaults{$type.'exttool'} = $domconfig{'coursedefaults'}{'exttool'}{$type};
	} else {
	$domdefaults{$type.'exttool'} = 0;
	}
}	}
if (ref($domconfig{'coursedefaults'}{'canclone'}) eq 'HASH') {	if (ref($domconfig{'coursedefaults'}{'canclone'}) eq 'HASH') {
if (ref($domconfig{'coursedefaults'}{'canclone'}{'instcode'}) eq 'ARRAY') {	if (ref($domconfig{'coursedefaults'}{'canclone'}{'instcode'}) eq 'ARRAY') {
Line 2859 sub get_domain_defaults {	Line 2956 sub get_domain_defaults {
}	}
if (ref($domconfig{'ltisec'}{'private'}) eq 'HASH') {	if (ref($domconfig{'ltisec'}{'private'}) eq 'HASH') {
if (ref($domconfig{'ltisec'}{'private'}{'keys'}) eq 'ARRAY') {	if (ref($domconfig{'ltisec'}{'private'}{'keys'}) eq 'ARRAY') {
$domdefaults{'privhosts'} = $domconfig{'ltisec'}{'private'}{'keys'};	$domdefaults{'ltiprivhosts'} = $domconfig{'ltisec'}{'private'}{'keys'};
	}
	}
	}
	if (ref($domconfig{'toolsec'}) eq 'HASH') {
	if (ref($domconfig{'toolsec'}{'encrypt'}) eq 'HASH') {
	$domdefaults{'toolenc_crs'} = $domconfig{'toolsec'}{'encrypt'}{'crs'};
	$domdefaults{'toolenc_dom'} = $domconfig{'toolsec'}{'encrypt'}{'dom'};
	}
	if (ref($domconfig{'toolsec'}{'private'}) eq 'HASH') {
	if (ref($domconfig{'toolsec'}{'private'}{'keys'}) eq 'ARRAY') {
	$domdefaults{'toolprivhosts'} = $domconfig{'toolsec'}{'private'}{'keys'};
	}
	}
	}
	if (ref($domconfig{'privacy'}) eq 'HASH') {
	if (ref($domconfig{'privacy'}{'approval'}) eq 'HASH') {
	foreach my $domtype ('instdom','extdom') {
	if (ref($domconfig{'privacy'}{'approval'}{$domtype}) eq 'HASH') {
	foreach my $roletype ('domain','author','course','community') {
	if ($domconfig{'privacy'}{'approval'}{$domtype}{$roletype} eq 'user') {
	$domdefaults{'userapprovals'} = 1;
	last;
	}
	}
	}
	last if ($domdefaults{'userapprovals'});
}	}
}	}
}	}
Line 2882 sub get_dom_cats {	Line 3005 sub get_dom_cats {
} else {	} else {
$cats = {};	$cats = {};
}	}
&Apache::lonnet::do_cache_new('cats',$dom,$cats,3600);	&do_cache_new('cats',$dom,$cats,3600);
}	}
return $cats;	return $cats;
}	}
Line 2899 sub get_dom_instcats {	Line 3022 sub get_dom_instcats {
if (&auto_instcode_format($caller,$dom,\%coursecodes,\%codes,	if (&auto_instcode_format($caller,$dom,\%coursecodes,\%codes,
\@codetitles,\%cat_titles,\%cat_order) eq 'ok') {	\@codetitles,\%cat_titles,\%cat_order) eq 'ok') {
$instcats = {	$instcats = {
	totcodes => $totcodes,
codes => \%codes,	codes => \%codes,
codetitles => \@codetitles,	codetitles => \@codetitles,
cat_titles => \%cat_titles,	cat_titles => \%cat_titles,
Line 2937 sub course_portal_url {	Line 3061 sub course_portal_url {
if ($domdefaults{'portal_def'}) {	if ($domdefaults{'portal_def'}) {
$firsturl = $domdefaults{'portal_def'};	$firsturl = $domdefaults{'portal_def'};
} else {	} else {
my $alias = &Apache::lonnet::use_proxy_alias($r,$chome);	my $alias = &use_proxy_alias($r,$chome);
$hostname = $alias if ($alias ne '');	$hostname = $alias if ($alias ne '');
$firsturl = $protocol.'://'.$hostname;	$firsturl = $protocol.'://'.$hostname;
}	}
return $firsturl;	return $firsturl;
}	}

	sub url_prefix {
	my ($r,$dom,$home,$context) = @_;
	my $prefix;
	my %domdefs = &get_domain_defaults($dom);
	if ($domdefs{'portal_def'} && $domdefs{'portal_def_'.$context}) {
	if ($domdefs{'portal_def'} =~ m{^(https?://[^/]+)}) {
	$prefix = $1;
	}
	}
	if ($prefix eq '') {
	my $hostname = &hostname($home);
	my $protocol = $protocol{$home};
	$protocol = 'http' if ($protocol{$home} ne 'https');
	my $alias = &use_proxy_alias($r,$home);
	$hostname = $alias if ($alias ne '');
	$prefix = $protocol.'://'.$hostname;
	}
	return $prefix;
	}

# --------------------------------------------- Get domain config for passwords	# --------------------------------------------- Get domain config for passwords

sub get_passwdconf {	sub get_passwdconf {
Line 3115 sub courseid_to_courseurl {	Line 3259 sub courseid_to_courseurl {
return "/$cdom/$cnum";	return "/$cdom/$cnum";
}	}

my %courseinfo=&Apache::lonnet::coursedescription($courseid);	my %courseinfo=&coursedescription($courseid);
if (exists($courseinfo{'num'})) {	if (exists($courseinfo{'num'})) {
return "/$courseinfo{'domain'}/$courseinfo{'num'}";	return "/$courseinfo{'domain'}/$courseinfo{'num'}";
}	}
Line 3313 sub userenvironment {	Line 3457 sub userenvironment {
# ---------------------------------------------------------- Get a studentphoto	# ---------------------------------------------------------- Get a studentphoto
sub studentphoto {	sub studentphoto {
my ($udom,$unam,$ext) = @_;	my ($udom,$unam,$ext) = @_;
my $home=&Apache::lonnet::homeserver($unam,$udom);	my $home=&homeserver($unam,$udom);
if (defined($env{'request.course.id'})) {	if (defined($env{'request.course.id'})) {
if ($env{'course.'.$env{'request.course.id'}.'.internal.showphoto'}) {	if ($env{'course.'.$env{'request.course.id'}.'.internal.showphoto'}) {
if ($udom eq $env{'course.'.$env{'request.course.id'}.'.domain'}) {	if ($udom eq $env{'course.'.$env{'request.course.id'}.'.domain'}) {
return(&retrievestudentphoto($udom,$unam,$ext));	return(&retrievestudentphoto($udom,$unam,$ext));
} else {	} else {
my ($result,$perm_reqd)=	my ($result,$perm_reqd)=
&Apache::lonnet::auto_photo_permission($unam,$udom);	&auto_photo_permission($unam,$udom);
if ($result eq 'ok') {	if ($result eq 'ok') {
if (!($perm_reqd eq 'yes')) {	if (!($perm_reqd eq 'yes')) {
return(&retrievestudentphoto($udom,$unam,$ext));	return(&retrievestudentphoto($udom,$unam,$ext));
Line 3330 sub studentphoto {	Line 3474 sub studentphoto {
}	}
} else {	} else {
my ($result,$perm_reqd) =	my ($result,$perm_reqd) =
&Apache::lonnet::auto_photo_permission($unam,$udom);	&auto_photo_permission($unam,$udom);
if ($result eq 'ok') {	if ($result eq 'ok') {
if (!($perm_reqd eq 'yes')) {	if (!($perm_reqd eq 'yes')) {
return(&retrievestudentphoto($udom,$unam,$ext));	return(&retrievestudentphoto($udom,$unam,$ext));
Line 3342 sub studentphoto {	Line 3486 sub studentphoto {

sub retrievestudentphoto {	sub retrievestudentphoto {
my ($udom,$unam,$ext,$type) = @_;	my ($udom,$unam,$ext,$type) = @_;
my $home=&Apache::lonnet::homeserver($unam,$udom);	my $home=&homeserver($unam,$udom);
my $ret=&Apache::lonnet::reply("studentphoto:$udom:$unam:$ext:$type",$home);	my $ret=&reply("studentphoto:$udom:$unam:$ext:$type",$home);
if ($ret eq 'ok') {	if ($ret eq 'ok') {
my $url="/uploaded/$udom/$unam/internal/studentphoto.$ext";	my $url="/uploaded/$udom/$unam/internal/studentphoto.$ext";
if ($type eq 'thumbnail') {	if ($type eq 'thumbnail') {
$url="/uploaded/$udom/$unam/internal/studentphoto_tn.$ext";	$url="/uploaded/$udom/$unam/internal/studentphoto_tn.$ext";
}	}
my $tokenurl=&Apache::lonnet::tokenwrapper($url);	my $tokenurl=&tokenwrapper($url);
return $tokenurl;	return $tokenurl;
} else {	} else {
if ($type eq 'thumbnail') {	if ($type eq 'thumbnail') {
Line 3626 sub ssi {	Line 3770 sub ssi {
($form{'grade_courseid'} eq $env{'request.course.id'}) &&	($form{'grade_courseid'} eq $env{'request.course.id'}) &&
($form{'grade_username'} ne '') && ($form{'grade_domain'} ne '') &&	($form{'grade_username'} ne '') && ($form{'grade_domain'} ne '') &&
($form{'grade_symb'} ne '') &&	($form{'grade_symb'} ne '') &&
(&Apache::lonnet::allowed('mgr',$env{'request.course.id'}.	(&allowed('mgr',$env{'request.course.id'}.
($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')))) {	($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')))) {
$islocal = 1;	$islocal = 1;
}	}
$response= &LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar,	$response= &LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar,
Line 3778 sub can_edit_resource {	Line 3922 sub can_edit_resource {
}	}

if ($env{'request.course.id'}) {	if ($env{'request.course.id'}) {
my $crsedit = &Apache::lonnet::allowed('mdc',$env{'request.course.id'});	my $crsedit = &allowed('mdc',$env{'request.course.id'});
if ($group ne '') {	if ($group ne '') {
# if this is a group homepage or group bulletin board, check group privs	# if this is a group homepage or group bulletin board, check group privs
my $allowed = 0;	my $allowed = 0;
Line 3807 sub can_edit_resource {	Line 3951 sub can_edit_resource {
}	}
} else {	} else {
if ($resurl =~ m{^/?adm/viewclasslist$}) {	if ($resurl =~ m{^/?adm/viewclasslist$}) {
unless (&Apache::lonnet::allowed('opa',$env{'request.course.id'})) {	unless (&allowed('opa',$env{'request.course.id'})) {
return;	return;
}	}
} elsif (!$crsedit) {	} elsif (!$crsedit) {
	if ($env{'request.role'} =~ m{^st\./$cdom/$cnum}) {
#	#
# No edit allowed where CC has switched to student role.	# No edit allowed where CC has switched to student role.
#	#
return;	return;
	} elsif (($resurl !~ m{^/res/$match_domain/$match_username/}) \|\|
	($resurl =~ m{^/res/lib/templates/})) {
	return;
	}
}	}
}	}
}	}
Line 3840 sub can_edit_resource {	Line 3989 sub can_edit_resource {
$forceedit = 1;	$forceedit = 1;
}	}
$cfile = $resurl;	$cfile = $resurl;
} elsif (($resurl ne '') && (&is_on_map($resurl))) {	} elsif (($resurl ne '') && (&is_on_map($resurl))) {
if ($resurl =~ m{^/adm/$match_domain/$match_username/\d+/smppg\|bulletinboard$}) {	if ($resurl =~ m{^/adm/$match_domain/$match_username/\d+/smppg\|bulletinboard$}) {
$incourse = 1;	$incourse = 1;
if ($env{'form.forceedit'}) {	if ($env{'form.forceedit'}) {
Line 4223 sub resizeImage {	Line 4372 sub resizeImage {
# input: $formname - the contents of the file are in $env{"form.$formname"}	# input: $formname - the contents of the file are in $env{"form.$formname"}
# the desired filename is in $env{"form.$formname.filename"}	# the desired filename is in $env{"form.$formname.filename"}
# $context - possible values: coursedoc, existingfile, overwrite,	# $context - possible values: coursedoc, existingfile, overwrite,
# canceloverwrite, scantron or ''.	# canceloverwrite, scantron, toollogo or ''.
# if 'coursedoc': upload to the current course	# if 'coursedoc': upload to the current course
# if 'existingfile': write file to tmp/overwrites directory	# if 'existingfile': write file to tmp/overwrites directory
# if 'canceloverwrite': delete file written to tmp/overwrites directory	# if 'canceloverwrite': delete file written to tmp/overwrites directory
Line 4235 sub resizeImage {	Line 4384 sub resizeImage {
# Section => 4, CODE => 5, FirstQuestion => 9 }).	# Section => 4, CODE => 5, FirstQuestion => 9 }).
# $allfiles - reference to hash for embedded objects	# $allfiles - reference to hash for embedded objects
# $codebase - reference to hash for codebase of java objects	# $codebase - reference to hash for codebase of java objects
# $desuname - username for permanent storage of uploaded file	# $destuname - username for permanent storage of uploaded file
# $dsetudom - domain for permanaent storage of uploaded file	# $destudom - domain for permanaent storage of uploaded file
# $thumbwidth - width (pixels) of thumbnail to make for uploaded image	# $thumbwidth - width (pixels) of thumbnail to make for uploaded image
# $thumbheight - height (pixels) of thumbnail to make for uploaded image	# $thumbheight - height (pixels) of thumbnail to make for uploaded image
# $resizewidth - width (pixels) to which to resize uploaded image	# $resizewidth - width (pixels) to which to resize uploaded image
Line 4446 sub finishuserfileupload {	Line 4595 sub finishuserfileupload {
if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) {	if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) {
my $input = $filepath.'/'.$file;	my $input = $filepath.'/'.$file;
my $output = $filepath.'/'.'tn-'.$file;	my $output = $filepath.'/'.'tn-'.$file;
	my $makethumb;
my $thumbsize = $thumbwidth.'x'.$thumbheight;	my $thumbsize = $thumbwidth.'x'.$thumbheight;
my @args = ('convert','-sample',$thumbsize,$input,$output);	if ($context eq 'toollogo') {
system({$args[0]} @args);	my ($fullwidth,$fullheight) = &check_dimensions($input);
if (-e $filepath.'/'.'tn-'.$file) {	if ($fullwidth ne '' && $fullheight ne '') {
$fetchthumb = 1;	if ($fullwidth > $thumbwidth && $fullheight > $thumbheight) {
	$makethumb = 1;
	}
	}
	} else {
	$makethumb = 1;
	}
	if ($makethumb) {
	my @args = ('convert','-sample',$thumbsize,$input,$output);
	system({$args[0]} @args);
	if (-e $filepath.'/'.'tn-'.$file) {
	$fetchthumb = 1;
	}
}	}
}	}

Line 4682 sub embedded_dependency {	Line 4844 sub embedded_dependency {
return;	return;
}	}

	sub check_dimensions {
	my ($inputfile) = @_;
	my ($fullwidth,$fullheight);
	if (($inputfile =~ m\|^[/\w.\-]+$\|) && (-e $inputfile)) {
	my $mm = new File::MMagic;
	my $mime_type = $mm->checktype_filename($inputfile);
	if ($mime_type =~ m{^image/}) {
	if (open(PIPE,"identify $inputfile 2>&1 \|")) {
	my $imageinfo = <PIPE>;
	if (!close(PIPE)) {
	&Apache::lonnet::logthis("Failed to close PIPE opened to retrieve image information for $inputfile");
	}
	chomp($imageinfo);
	my ($fullsize) =
	($imageinfo =~ /^\Q$inputfile\E\s+\w+\s+(\d+x\d+)/);
	if ($fullsize) {
	($fullwidth,$fullheight) = split(/x/,$fullsize);
	}
	}
	}
	}
	return ($fullwidth,$fullheight);
	}

sub bubblesheet_converter {	sub bubblesheet_converter {
my ($cdom,$fullpath,$config,$format) = @_;	my ($cdom,$fullpath,$config,$format) = @_;
if ((&domain($cdom) ne '') &&	if ((&domain($cdom) ne '') &&
Line 4918 sub get_scantronformat_file {	Line 5104 sub get_scantronformat_file {
close($fh);	close($fh);
}	}
}	}
	chomp(@lines);
}	}
return @lines;	return @lines;
}	}
Line 5044 sub flushcourselogs {	Line 5231 sub flushcourselogs {
# Typo in rev. 1.458 (2003/12/09)??	# Typo in rev. 1.458 (2003/12/09)??
# These should likely by $env{'course.'.$cid.'.domain'} and $env{'course.'.$cid.'.num'}	# These should likely by $env{'course.'.$cid.'.domain'} and $env{'course.'.$cid.'.num'}
#	#
# While these ramain as $env{'request.'.$cid.'.domain'} and $env{'request.'.$cid.'.num'}	# While these remain as $env{'request.'.$cid.'.domain'} and $env{'request.'.$cid.'.num'}
# $dom and $name will always be null, so the &inc() call will default to storing this data	# $dom and $name will always be null, so the &inc() call will default to storing this data
# in a nohist_accesscount.db file for the user rather than the course.	# in a nohist_accesscount.db file for the user rather than the course.
#	#
Line 5088 sub flushcourselogs {	Line 5275 sub flushcourselogs {
foreach my $entry (keys(%userrolehash)) {	foreach my $entry (keys(%userrolehash)) {
my ($role,$uname,$udom,$runame,$rudom,$rsec)=	my ($role,$uname,$udom,$runame,$rudom,$rsec)=
split(/\:/,$entry);	split(/\:/,$entry);
if (&Apache::lonnet::put('nohist_userroles',	if (&put('nohist_userroles',
{ $role.':'.$uname.':'.$udom.':'.$rsec => $userrolehash{$entry} },	{ $role.':'.$uname.':'.$udom.':'.$rsec => $userrolehash{$entry} },
$rudom,$runame) eq 'ok') {	$rudom,$runame) eq 'ok') {
delete $userrolehash{$entry};	delete $userrolehash{$entry};
Line 5255 sub userrolelog {	Line 5442 sub userrolelog {
}	}

sub courserolelog {	sub courserolelog {
my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$selfenroll,$context)=@_;	my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$selfenroll,
	$context,$othdomby,$requester)=@_;
if ($area =~ m-^/($match_domain)/($match_courseid)/?([^/]*)-) {	if ($area =~ m-^/($match_domain)/($match_courseid)/?([^/]*)-) {
my $cdom = $1;	my $cdom = $1;
my $cnum = $2;	my $cnum = $2;
Line 5268 sub courserolelog {	Line 5456 sub courserolelog {
selfenroll => $selfenroll,	selfenroll => $selfenroll,
context => $context,	context => $context,
);	);
	if ($othdomby) {
	if ($othdomby eq 'othdombydc') {
	$storehash{'approval'} = 'domain';
	} elsif ($othdomby eq 'othdombyuser') {
	$storehash{'approval'} = 'user';
	}
	if ($requester ne '') {
	$storehash{'requester'} = $requester;
	}
	}
if ($trole eq 'gr') {	if ($trole eq 'gr') {
$namespace = 'groupslog';	$namespace = 'groupslog';
$storehash{'group'} = $sec;	$storehash{'group'} = $sec;
Line 5284 sub courserolelog {	Line 5482 sub courserolelog {
}	}

sub domainrolelog {	sub domainrolelog {
my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$context)=@_;	my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,
	$context,$othdomby,$requester)=@_;
if ($area =~ m{^/($match_domain)/$}) {	if ($area =~ m{^/($match_domain)/$}) {
my $cdom = $1;	my $cdom = $1;
my $domconfiguser = &Apache::lonnet::get_domainconfiguser($cdom);	my $domconfiguser = &get_domainconfiguser($cdom);
my $namespace = 'rolelog';	my $namespace = 'rolelog';
my %storehash = (	my %storehash = (
role => $trole,	role => $trole,
Line 5295 sub domainrolelog {	Line 5494 sub domainrolelog {
end => $tend,	end => $tend,
context => $context,	context => $context,
);	);
	if ($othdomby) {
	if ($othdomby eq 'othdombydc') {
	$storehash{'approval'} = 'domain';
	} elsif ($othdomby eq 'othdombyuser') {
	$storehash{'approval'} = 'user';
	}
	if ($requester ne '') {
	$storehash{'requester'} = $requester;
	}
	}
&write_log('domain',$namespace,\%storehash,$delflag,$username,	&write_log('domain',$namespace,\%storehash,$delflag,$username,
$domain,$domconfiguser,$cdom);	$domain,$domconfiguser,$cdom);
}	}
Line 5303 sub domainrolelog {	Line 5512 sub domainrolelog {
}	}

sub coauthorrolelog {	sub coauthorrolelog {
my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$context)=@_;	my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,
	$context,$othdomby,$requester)=@_;
if ($area =~ m{^/($match_domain)/($match_username)$}) {	if ($area =~ m{^/($match_domain)/($match_username)$}) {
my $audom = $1;	my $audom = $1;
my $auname = $2;	my $auname = $2;
Line 5314 sub coauthorrolelog {	Line 5524 sub coauthorrolelog {
end => $tend,	end => $tend,
context => $context,	context => $context,
);	);
	if ($othdomby) {
	if ($othdomby eq 'othdombydc') {
	$storehash{'approval'} = 'domain';
	} elsif ($othdomby eq 'othdombyuser') {
	$storehash{'approval'} = 'user';
	}
	if ($requester ne '') {
	$storehash{'requester'} = $requester;
	}
	}
&write_log('author',$namespace,\%storehash,$delflag,$username,	&write_log('author',$namespace,\%storehash,$delflag,$username,
$domain,$auname,$audom);	$domain,$auname,$audom);
}	}
Line 5518 sub get_my_adhocroles {	Line 5738 sub get_my_adhocroles {
} elsif ($cid =~ /^($match_domain)_($match_courseid)$/) {	} elsif ($cid =~ /^($match_domain)_($match_courseid)$/) {
$cdom = $1;	$cdom = $1;
$cnum = $2;	$cnum = $2;
%info = &Apache::lonnet::get('environment',['internal.coursecode'],	%info = &get('environment',['internal.coursecode'],
$cdom,$cnum);	$cdom,$cnum);
}	}
if (($info{'internal.coursecode'} ne '') && ($checkreg)) {	if (($info{'internal.coursecode'} ne '') && ($checkreg)) {
my $user = $env{'user.name'}.':'.$env{'user.domain'};	my $user = $env{'user.name'}.':'.$env{'user.domain'};
Line 5846 sub extract_lastaccess {	Line 6066 sub extract_lastaccess {

sub dcmailput {	sub dcmailput {
my ($domain,$msgid,$message,$server)=@_;	my ($domain,$msgid,$message,$server)=@_;
my $status = &Apache::lonnet::critical(	my $status = &critical(
'dcmailput:'.$domain.':'.&escape($msgid).'='.	'dcmailput:'.$domain.':'.&escape($msgid).'='.
&escape($message),$server);	&escape($message),$server);
return $status;	return $status;
Line 6848 sub course_adhocrole_privs {	Line 7068 sub course_adhocrole_privs {
$full{$priv} = $restrict;	$full{$priv} = $restrict;
}	}
foreach my $item (split(/,/,$overrides{"internal.adhocpriv.$rolename"})) {	foreach my $item (split(/,/,$overrides{"internal.adhocpriv.$rolename"})) {
next if ($item eq '');	next if ($item eq '');
my ($rule,$rest) = split(/=/,$item);	my ($rule,$rest) = split(/=/,$item);
next unless (($rule eq 'off') \|\| ($rule eq 'on'));	next unless (($rule eq 'off') \|\| ($rule eq 'on'));
foreach my $priv (split(/:/,$rest)) {	foreach my $priv (split(/:/,$rest)) {
if ($priv ne '') {	if ($priv ne '') {
if ($rule eq 'off') {	if ($rule eq 'off') {
$possremove{$priv} = 1;	$possremove{$priv} = 1;
} else {	} else {
$possadd{$priv} = 1;	$possadd{$priv} = 1;
}	}
}	}
}	}
}	}
foreach my $priv (sort(keys(%full))) {	foreach my $priv (sort(keys(%full))) {
if (exists($currprivs{$priv})) {	if (exists($currprivs{$priv})) {
unless (exists($possremove{$priv})) {	unless (exists($possremove{$priv})) {
$storeprivs{$priv} = $currprivs{$priv};	$storeprivs{$priv} = $currprivs{$priv};
}	}
} elsif (exists($possadd{$priv})) {	} elsif (exists($possadd{$priv})) {
$storeprivs{$priv} = $full{$priv};	$storeprivs{$priv} = $full{$priv};
}	}
}	}
$coursepriv = ':'.join(':',map { $_.'&'.$storeprivs{$_}; } sort(keys(%storeprivs)));	$coursepriv = ':'.join(':',map { $_.'&'.$storeprivs{$_}; } sort(keys(%storeprivs)));
}	}
return $coursepriv;	return $coursepriv;
}	}

sub group_roleprivs {	sub group_roleprivs {
Line 7439 sub putstore {	Line 7659 sub putstore {
'&host='.&escape($perlvar{'lonHostID'}).	'&host='.&escape($perlvar{'lonHostID'}).
'&version='.$esc_v.	'&version='.$esc_v.
'&by='.&escape($env{'user.name'}.':'.$env{'user.domain'});	'&by='.&escape($env{'user.name'}.':'.$env{'user.domain'});
&Apache::lonnet::courselog($symb.':'.$uname.':'.$udomain.':PUTSTORE:'.$namevalue);	&courselog($symb.':'.$uname.':'.$udomain.':PUTSTORE:'.$namevalue);
}	}
if ($reply eq 'unknown_cmd') {	if ($reply eq 'unknown_cmd') {
# gfall back to way things use to be done	# gfall back to way things use to be done
Line 7589 sub get_timebased_id {	Line 7809 sub get_timebased_id {
my $tries = 0;	my $tries = 0;

# attempt to get lock on nohist_$namespace file	# attempt to get lock on nohist_$namespace file
my $gotlock = &Apache::lonnet::newput('nohist_'.$namespace,$lockhash,$cdom,$cnum);	my $gotlock = &newput('nohist_'.$namespace,$lockhash,$cdom,$cnum);
while (($gotlock ne 'ok') && $tries <$locktries) {	while (($gotlock ne 'ok') && $tries <$locktries) {
$tries ++;	$tries ++;
sleep 1;	sleep 1;
$gotlock = &Apache::lonnet::newput('nohist_'.$namespace,$lockhash,$cdom,$cnum);	$gotlock = &newput('nohist_'.$namespace,$lockhash,$cdom,$cnum);
}	}

# attempt to get unique identifier, based on current timestamp	# attempt to get unique identifier, based on current timestamp
if ($gotlock eq 'ok') {	if ($gotlock eq 'ok') {
my %inuse = &Apache::lonnet::dump('nohist_'.$namespace,$cdom,$cnum,$prefix);	my %inuse = &dump('nohist_'.$namespace,$cdom,$cnum,$prefix);
my $id = time;	my $id = time;
$newid = $id;	$newid = $id;
if ($idtype eq 'addcode') {	if ($idtype eq 'addcode') {
Line 7619 sub get_timebased_id {	Line 7839 sub get_timebased_id {
my %new_item = (	my %new_item = (
$prefix."\0".$newid => $who,	$prefix."\0".$newid => $who,
);	);
my $putresult = &Apache::lonnet::put('nohist_'.$namespace,\%new_item,	my $putresult = &put('nohist_'.$namespace,\%new_item,
$cdom,$cnum);	$cdom,$cnum);
if ($putresult ne 'ok') {	if ($putresult ne 'ok') {
undef($newid);	undef($newid);
Line 7908 sub is_portfolio_file {	Line 8128 sub is_portfolio_file {
return;	return;
}	}

	sub is_coursetool_logo {
	my ($uri) = @_;
	if ($env{'request.course.id'}) {
	my $courseurl = &courseid_to_courseurl($env{'request.course.id'});
	if ($uri =~ m{^/*uploaded\Q$courseurl\E/toollogo/\d+/[^/]+$}) {
	return 1;
	}
	}
	return;
	}

sub usertools_access {	sub usertools_access {
my ($uname,$udom,$tool,$action,$context,$userenvref,$domdefref,$is_advref)=@_;	my ($uname,$udom,$tool,$action,$context,$userenvref,$domdefref,$is_advref)=@_;
my ($access,%tools);	my ($access,%tools);
Line 7933 sub usertools_access {	Line 8164 sub usertools_access {
blog => 1,	blog => 1,
webdav => 1,	webdav => 1,
portfolio => 1,	portfolio => 1,
	timezone => 1,
);	);
}	}
return if (!defined($tools{$tool}));	return if (!defined($tools{$tool}));
Line 8057 sub is_course_owner {	Line 8289 sub is_course_owner {
if ($env{'course.'.$cdom.'_'.$cnum.'.internal.courseowner'} eq $uname.':'.$udom) {	if ($env{'course.'.$cdom.'_'.$cnum.'.internal.courseowner'} eq $uname.':'.$udom) {
return 1;	return 1;
} else {	} else {
my %courseinfo = &Apache::lonnet::coursedescription($cdom.'/'.$cnum);	my %courseinfo = &coursedescription($cdom.'/'.$cnum);
if ($courseinfo{'internal.courseowner'} eq $uname.':'.$udom) {	if ($courseinfo{'internal.courseowner'} eq $uname.':'.$udom) {
return 1;	return 1;
}	}
Line 8068 sub is_course_owner {	Line 8300 sub is_course_owner {
}	}

sub is_advanced_user {	sub is_advanced_user {
my ($udom,$uname) = @_;	my ($udom,$uname,$nocache) = @_;
	my ($is_adv,$is_author,$use_cache,$hashid);
if ($udom ne '' && $uname ne '') {	if ($udom ne '' && $uname ne '') {
if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {	if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
if (wantarray) {	if (wantarray) {
Line 8076 sub is_advanced_user {	Line 8309 sub is_advanced_user {
} else {	} else {
return $env{'user.adv'};	return $env{'user.adv'};
}	}
	} elsif (!$nocache) {
	$use_cache = 1;
	$hashid = "$udom:$uname";
	my ($info,$cached)=&is_cached_new('isadvau',$hashid);
	if ($cached) {
	($is_adv,$is_author) = split(/:/,$info);
	if (wantarray) {
	return ($is_adv,$is_author);
	}
	return $is_adv;
	}
}	}
}	}
my %roleshash = &get_my_roles($uname,$udom,'userroles',undef,undef,undef,1);	my %roleshash = &get_my_roles($uname,$udom,'userroles',undef,undef,undef,1);
my %allroles;	my %allroles;
my ($is_adv,$is_author);
foreach my $role (keys(%roleshash)) {	foreach my $role (keys(%roleshash)) {
my ($trest,$tdomain,$trole,$sec) = split(/:/,$role);	my ($trest,$tdomain,$trole,$sec) = split(/:/,$role);
my $area = '/'.$tdomain.'/'.$trest;	my $area = '/'.$tdomain.'/'.$trest;
Line 8111 sub is_advanced_user {	Line 8354 sub is_advanced_user {
}	}
}	}
}	}
	if ($use_cache) {
	my $cachetime = 600;
	&do_cache_new('isadvau',$hashid,$is_adv.':'.$is_author,$cachetime);
	}
if (wantarray) {	if (wantarray) {
return ($is_adv,$is_author);	return ($is_adv,$is_author);
}	}
Line 8535 sub allowed {	Line 8782 sub allowed {

if ($env{'request.course.id'}) {	if ($env{'request.course.id'}) {

	if ($priv eq 'bre') {
	if (&is_coursetool_logo($uri)) {
	return 'F';
	}
	}

# If this is modifying password (internal auth) domains must match for user and user's role.	# If this is modifying password (internal auth) domains must match for user and user's role.

if ($priv eq 'mip') {	if ($priv eq 'mip') {
Line 8855 sub constructaccess {	Line 9108 sub constructaccess {
if (exists($env{'user.priv.au./'.$ownerdomain.'/./'})) {	if (exists($env{'user.priv.au./'.$ownerdomain.'/./'})) {
return ($ownername,$ownerdomain,$ownerhome);	return ($ownername,$ownerdomain,$ownerhome);
}	}
} else {	} elsif (&is_course($ownerdomain,$ownername)) {
# Co-author for this?	# Course Authoring Space?
if (exists($env{'user.priv.ca./'.$ownerdomain.'/'.$ownername.'./'}) \|\|
exists($env{'user.priv.aa./'.$ownerdomain.'/'.$ownername.'./'}) ) {
$ownerhome = &homeserver($ownername,$ownerdomain);
return ($ownername,$ownerdomain,$ownerhome);
}
if ($env{'request.course.id'}) {	if ($env{'request.course.id'}) {
if (($ownername eq $env{'course.'.$env{'request.course.id'}.'.num'}) &&	if (($ownername eq $env{'course.'.$env{'request.course.id'}.'.num'}) &&
($ownerdomain eq $env{'course.'.$env{'request.course.id'}.'.domain'})) {	($ownerdomain eq $env{'course.'.$env{'request.course.id'}.'.domain'})) {
Line 8871 sub constructaccess {	Line 9119 sub constructaccess {
}	}
}	}
}	}
	return '';
	} else {
	# Co-author for this?
	if (exists($env{'user.priv.ca./'.$ownerdomain.'/'.$ownername.'./'}) \|\|
	exists($env{'user.priv.aa./'.$ownerdomain.'/'.$ownername.'./'}) ) {
	$ownerhome = &homeserver($ownername,$ownerdomain);
	return ($ownername,$ownerdomain,$ownerhome);
	}
}	}

# We don't have any access right now. If we are not possibly going to do anything about this,	# We don't have any access right now. If we are not possibly going to do anything about this,
Line 8949 sub get_comm_blocks {	Line 9205 sub get_comm_blocks {
if ((defined($cached)) && (ref($blocksref) eq 'HASH')) {	if ((defined($cached)) && (ref($blocksref) eq 'HASH')) {
%commblocks = %{$blocksref};	%commblocks = %{$blocksref};
} else {	} else {
%commblocks = &Apache::lonnet::dump('comm_block',$cdom,$cnum);	%commblocks = &dump('comm_block',$cdom,$cnum);
my $cachetime = 600;	my $cachetime = 600;
&do_cache_new('comm_block',$hashid,\%commblocks,$cachetime);	&do_cache_new('comm_block',$hashid,\%commblocks,$cachetime);
}	}
Line 10149 sub toggle_coursegroup_status {	Line 10405 sub toggle_coursegroup_status {
}	}

sub modify_group_roles {	sub modify_group_roles {
my ($cdom,$cnum,$group_id,$user,$end,$start,$userprivs,$selfenroll,$context) = @_;	my ($cdom,$cnum,$group_id,$user,$end,$start,$userprivs,$selfenroll,$context,
	$othdomby,$requester) = @_;
my $url = '/'.$cdom.'/'.$cnum.'/'.$group_id;	my $url = '/'.$cdom.'/'.$cnum.'/'.$group_id;
my $role = 'gr/'.&escape($userprivs);	my $role = 'gr/'.&escape($userprivs);
my ($uname,$udom) = split(/:/,$user);	my ($uname,$udom) = split(/:/,$user);
my $result = &assignrole($udom,$uname,$url,$role,$end,$start,'',$selfenroll,$context);	my $result = &assignrole($udom,$uname,$url,$role,$end,$start,'',$selfenroll,$context,
	$othdomby,$requester);
if ($result eq 'ok') {	if ($result eq 'ok') {
&devalidate_getgroups_cache($udom,$uname,$cdom,$cnum);	&devalidate_getgroups_cache($udom,$uname,$cdom,$cnum);
}	}
Line 10281 sub plaintext {	Line 10539 sub plaintext {

sub assignrole {	sub assignrole {
my ($udom,$uname,$url,$role,$end,$start,$deleteflag,$selfenroll,	my ($udom,$uname,$url,$role,$end,$start,$deleteflag,$selfenroll,
$context)=@_;	$context,$othdomby,$requester,$reqsec,$reqrole)=@_;
my $mrole;	my $mrole;
if ($role =~ /^cr\//) {	if ($role =~ /^cr\//) {
my $cwosec=$url;	my $cwosec=$url;
$cwosec=~s/^\/($match_domain)\/($match_courseid)\/.*/$1\/$2/;	$cwosec=~s/^\/($match_domain)\/($match_courseid)\/.*/$1\/$2/;
unless (&allowed('ccr',$cwosec)) {	if ((!&allowed('ccr',$cwosec)) && (!&allowed('ccr',$udom))) {
my $refused = 1;	my $refused = 1;
if ($context eq 'requestcourses') {	if ($context eq 'requestcourses') {
if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '')) {	if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '')) {
if ($role =~ m{^cr/($match_domain)/($match_username)/([^/]+)$}) {	if ($role =~ m{^cr/($match_domain)/($match_username)/([^/]+)$}) {
if (($1 eq $env{'user.domain'}) && ($2 eq $env{'user.name'})) {	if (($1 eq $env{'user.domain'}) && ($2 eq $env{'user.name'})) {
my ($cdom,$cnum) = ($cwosec =~ m{^/?($match_domain)/($match_courseid)$});	my ($cdom,$cnum) = ($cwosec =~ m{^/?($match_domain)/($match_courseid)$});
my %crsenv = &userenvironment($cdom,$cnum,('internal.courseowner'));	my %crsenv = &userenvironment($cdom,$cnum,('internal.courseowner'));
if ($crsenv{'internal.courseowner'} eq	if ($crsenv{'internal.courseowner'} eq
$env{'user.name'}.':'.$env{'user.domain'}) {	$env{'user.name'}.':'.$env{'user.domain'}) {
$refused = '';	$refused = '';
}	}
}	}
}	}
}	}
}	} elsif (($context eq 'course') && ($othdomby eq 'othdombyuser')) {
if ($refused) {	my ($cdom,$cnum) = ($cwosec =~ m{^/?($match_domain)/($match_courseid)$});
&logthis('Refused custom assignrole: '.	my ($sec) = ($url =~ m{^/\Q$cwosec\E/(.*)$});
$udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.	my $key = "$uname:$udom:$role:$sec";
' by '.$env{'user.name'}.' at '.$env{'user.domain'});	my %queuedrolereq = &Apache::lonnet::get('nohist_othdomqueued',[$key],$cdom,$cnum);
return 'refused';	if ((exists($queuedrolereq{$key})) && (ref($queuedrolereq{$key}) eq 'HASH')) {
}	if (($queuedrolereq{$key}{'adj'} eq 'user') && ($queuedrolereq{$key}{'requester'} eq $requester)) {
	$refused = '';
	}
	}
	}
	if ($refused) {
	&logthis('Refused custom assignrole: '.
	$udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.
	' by '.$env{'user.name'}.' at '.$env{'user.domain'});
	return 'refused';
	}
}	}
$mrole='cr';	$mrole='cr';
} elsif ($role =~ /^gr\//) {	} elsif ($role =~ /^gr\//) {
my $cwogrp=$url;	my $cwogrp=$url;
$cwogrp=~s{^/($match_domain)/($match_courseid)/.*}{$1/$2};	$cwogrp=~s{^/($match_domain)/($match_courseid)/.*}{$1/$2};
unless (&allowed('mdg',$cwogrp)) {	if (!&allowed('mdg',$cwogrp)) {
&logthis('Refused group assignrole: '.	my $refused = 1;
$udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '.	if (($refused) && ($othdomby eq 'othdombyuser') && ($requester ne '') && ($reqrole ne '')) {
$env{'user.name'}.' at '.$env{'user.domain'});	my ($cdom,$cnum) = ($cwogrp =~ m{^/?($match_domain)/($match_courseid)$});
return 'refused';	my $key = "$uname:$udom:$reqrole:$reqsec";
	my %queuedrolereq = &Apache::lonnet::get('nohist_othdomqueued',[$key],$cdom,$cnum);
	if ((exists($queuedrolereq{$key})) && (ref($queuedrolereq{$key}) eq 'HASH')) {
	if (($queuedrolereq{$key}{'adj'} eq 'user') && ($queuedrolereq{$key}{'requester'} eq $requester)) {
	$refused = '';
	}
	}
	}
	if ($refused) {
	&logthis('Refused group assignrole: '.
	$udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '.
	$env{'user.name'}.' at '.$env{'user.domain'});
	return 'refused';
	}
}	}
$mrole='gr';	$mrole='gr';
} else {	} else {
Line 10334 sub assignrole {	Line 10615 sub assignrole {
}	}
if ($refused) {	if ($refused) {
my ($cdom,$cnum) = ($cwosec =~ m{^/?($match_domain)/($match_courseid)$});	my ($cdom,$cnum) = ($cwosec =~ m{^/?($match_domain)/($match_courseid)$});
if (!$selfenroll && (($context eq 'course') \|\| ($context eq 'ltienroll' && $env{'request.lti.login'}))) {	if (!$selfenroll && ($othdomby ne 'othdombyuser') &&
	(($context eq 'course') \|\| ($context eq 'ltienroll' && $env{'request.lti.login'}))) {
my %crsenv;	my %crsenv;
if ($role eq 'cc' \|\| $role eq 'co') {	if ($role eq 'cc' \|\| $role eq 'co') {
%crsenv = &userenvironment($cdom,$cnum,('internal.courseowner'));	%crsenv = &userenvironment($cdom,$cnum,('internal.courseowner'));
Line 10360 sub assignrole {	Line 10642 sub assignrole {
} elsif (($context eq 'ltienroll') && ($env{'request.lti.login'})) {	} elsif (($context eq 'ltienroll') && ($env{'request.lti.login'})) {
$refused = '';	$refused = '';
}	}
	} elsif ($othdomby eq 'othdombyuser') {
	my ($key,%queuedrolereq);
	if ($context eq 'course') {
	my ($sec) = ($url =~ m{^/\Q$cwosec\E/(.*)$});
	$key = "$uname:$udom:$role:$sec";
	%queuedrolereq = &Apache::lonnet::get('nohist_othdomqueued',[$key],$cdom,$cnum);
	if ((exists($queuedrolereq{$key})) && (ref($queuedrolereq{$key}) eq 'HASH')) {
	if (($queuedrolereq{$key}{'adj'} eq 'user') && ($queuedrolereq{$key}{'requester'} eq $requester)) {
	if ((($role eq 'cc') && ($cnum !~ /^$match_community$/)) \|\|
	(($role eq 'co') && ($cnum =~ /^$match_community$/))) {
	my %crsenv = &userenvironment($cdom,$cnum,('internal.courseowner'));
	if ($crsenv{'internal.courseowner'} eq $requester) {
	$refused = '';
	}
	} elsif ($role =~ /^(?:in\|ta\|ep\|st)$/) {
	$refused = '';
	}
	}
	}
	} elsif (($context eq 'author') && ($role =~ /^ca\|aa$/)) {
	my $key = "$uname:$udom:$role";
	my ($audom,$auname) = ($url =~ m{^/($match_domain)/($match_username)$});
	if (($audom ne '') && ($auname ne '')) {
	my %queuedrolereq = &Apache::lonnet::get('nohist_othdomqueued',[$key],$audom,$auname);
	if ((exists($queuedrolereq{$key})) && (ref($queuedrolereq{$key}) eq 'HASH')) {
	if (($queuedrolereq{$key}{'adj'} eq 'user') && ($queuedrolereq{$key}{'requester'} eq $requester)) {
	$refused = '';
	}
	}
	}
	} elsif (($context eq 'domain') && ($role ne 'dc') && ($role ne 'su')) {
	my $key = "$uname:$udom:$role";
	my ($roledom) = ($url =~ m{^/($match_domain)/\Q$role\E$});
	if ($roledom ne '') {
	my $confname = $roledom.'-domainconfig';
	my %queuedrolereq = &Apache::lonnet::get('nohist_othdomqueued',[$key],$roledom,$confname);
	if ((exists($queuedrolereq{$key})) && (ref($queuedrolereq{$key}) eq 'HASH')) {
	if (($queuedrolereq{$key}{'adj'} eq 'user') && ($queuedrolereq{$key}{'requester'} eq $requester)) {
	$refused = '';
	}
	}
	}
	}
} elsif ($context eq 'requestcourses') {	} elsif ($context eq 'requestcourses') {
my @possroles = ('st','ta','ep','in','cc','co');	my @possroles = ('st','ta','ep','in','cc','co');
if ((grep(/^\Q$role\E$/,@possroles)) && ($env{'user.name'} ne '' && $env{'user.domain'} ne '')) {	if ((grep(/^\Q$role\E$/,@possroles)) && ($env{'user.name'} ne '' && $env{'user.domain'} ne '')) {
Line 10472 sub assignrole {	Line 10797 sub assignrole {
$origstart,$selfenroll,$context);	$origstart,$selfenroll,$context);
}	}
&courserolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,	&courserolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
$selfenroll,$context);	$selfenroll,$context,$othdomby,$requester);
} elsif (($role eq 'li') \|\| ($role eq 'dg') \|\| ($role eq 'sc') \|\|	} elsif (($role eq 'li') \|\| ($role eq 'dg') \|\| ($role eq 'sc') \|\|
($role eq 'au') \|\| ($role eq 'dc') \|\| ($role eq 'dh') \|\|	($role eq 'au') \|\| ($role eq 'dc') \|\| ($role eq 'dh') \|\|
($role eq 'da')) {	($role eq 'da')) {
&domainrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,	&domainrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
$context);	$context,$othdomby,$requester);
} elsif (($role eq 'ca') \|\| ($role eq 'aa')) {	} elsif (($role eq 'ca') \|\| ($role eq 'aa')) {
&coauthorrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,	&coauthorrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
$context);	$context,$othdomby,$requester);
}	}
if ($role eq 'cc') {	if ($role eq 'cc') {
&autoupdate_coowners($url,$end,$start,$uname,$udom);	&autoupdate_coowners($url,$end,$start,$uname,$udom);
Line 10575 sub store_coowners {	Line 10900 sub store_coowners {
}	}
if (($putresult eq 'ok') \|\| ($delresult eq 'ok')) {	if (($putresult eq 'ok') \|\| ($delresult eq 'ok')) {
my %crsinfo =	my %crsinfo =
&Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,undef,undef,'.');	&courseiddump($cdom,'.',1,'.','.',$cnum,undef,undef,'.');
if (ref($crsinfo{$cid}) eq 'HASH') {	if (ref($crsinfo{$cid}) eq 'HASH') {
$crsinfo{$cid}{'co-owners'} = \@newcoowners;	$crsinfo{$cid}{'co-owners'} = \@newcoowners;
my $cidput = &Apache::lonnet::courseidput($cdom,\%crsinfo,$chome,'notime');	my $cidput = &courseidput($cdom,\%crsinfo,$chome,'notime');
}	}
}	}
}	}
Line 10796 sub modifyuser {	Line 11121 sub modifyuser {
return 'error: '.$reply;	return 'error: '.$reply;
}	}
if ($names{'permanentemail'} ne $oldnames{'permanentemail'}) {	if ($names{'permanentemail'} ne $oldnames{'permanentemail'}) {
&Apache::lonnet::devalidate_cache_new('emailscache',$uname.':'.$udom);	&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);
Line 10832 sub modifystudent {	Line 11157 sub modifystudent {

sub modify_student_enrollment {	sub modify_student_enrollment {
my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start,$type,	my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start,$type,
$locktype,$cid,$selfenroll,$context,$credits,$instsec) = @_;	$locktype,$cid,$selfenroll,$context,$credits,$instsec,$othdomby,$requester) = @_;
my ($cdom,$cnum,$chome);	my ($cdom,$cnum,$chome);
if (!$cid) {	if (!$cid) {
unless ($cid=$env{'request.course.id'}) {	unless ($cid=$env{'request.course.id'}) {
Line 10876 sub modify_student_enrollment {	Line 11201 sub modify_student_enrollment {
}	}
my $fullname = &format_name($first,$middle,$last,$gene,'lastname');	my $fullname = &format_name($first,$middle,$last,$gene,'lastname');
my $user = "$uname:$udom";	my $user = "$uname:$udom";
my %old_entry = &Apache::lonnet::get('classlist',[$user],$cdom,$cnum);	my %old_entry = &get('classlist',[$user],$cdom,$cnum);
my $reply=cput('classlist',	my $reply=cput('classlist',
{$user =>	{$user =>
join(':',$end,$start,$uid,$usec,$fullname,$type,$locktype,$credits,$instsec) },	join(':',$end,$start,$uid,$usec,$fullname,$type,$locktype,$credits,$instsec) },
Line 10893 sub modify_student_enrollment {	Line 11218 sub modify_student_enrollment {
$uurl.='/'.$usec;	$uurl.='/'.$usec;
}	}
my $result = &assignrole($udom,$uname,$uurl,'st',$end,$start,undef,	my $result = &assignrole($udom,$uname,$uurl,'st',$end,$start,undef,
$selfenroll,$context);	$selfenroll,$context,$othdomby,$requester);
if ($result ne 'ok') {	if ($result ne 'ok') {
if ($old_entry{$user} ne '') {	if ($old_entry{$user} ne '') {
$reply = &cput('classlist',\%old_entry,$cdom,$cnum);	$reply = &cput('classlist',\%old_entry,$cdom,$cnum);
Line 11010 sub createcourse {	Line 11335 sub createcourse {
}	}
}	}
my %host_servers =	my %host_servers =
&Apache::lonnet::get_servers($udom,'library');	&get_servers($udom,'library');
unless ($host_servers{$course_server}) {	unless ($host_servers{$course_server}) {
return 'error: invalid home server for course: '.$course_server;	return 'error: invalid home server for course: '.$course_server;
}	}
Line 11169 sub store_userdata {	Line 11494 sub store_userdata {
# ---------------------------------------------------------- Assign Custom Role	# ---------------------------------------------------------- Assign Custom Role

sub assigncustomrole {	sub assigncustomrole {
my ($udom,$uname,$url,$rdom,$rnam,$rolename,$end,$start,$deleteflag,$selfenroll,$context)=@_;	my ($udom,$uname,$url,$rdom,$rnam,$rolename,$end,$start,$deleteflag,
	$selfenroll,$context,$othdomby,$requester)=@_;
return &assignrole($udom,$uname,$url,'cr/'.$rdom.'/'.$rnam.'/'.$rolename,	return &assignrole($udom,$uname,$url,'cr/'.$rdom.'/'.$rnam.'/'.$rolename,
$end,$start,$deleteflag,$selfenroll,$context);	$end,$start,$deleteflag,$selfenroll,$context,$othdomby,
	$requester);
}	}

# ----------------------------------------------------------------- Revoke Role	# ----------------------------------------------------------------- Revoke Role
Line 11978 sub stat_file {	Line 12305 sub stat_file {
# or corresponding Published Resource Space, and populate the hash ref:	# or corresponding Published Resource Space, and populate the hash ref:
# $dirhashref with URLs of all directories, and if $filehashref hash	# $dirhashref with URLs of all directories, and if $filehashref hash
# ref arg is provided, the URLs of any files, excluding versioned, .meta,	# ref arg is provided, the URLs of any files, excluding versioned, .meta,
# or .rights files in resource space, and .meta, .save, .log, and .bak	# or .rights files in resource space, and .meta, .save, .log, .bak and
# files in Authoring Space.	# .rights files in Authoring Space.
#	#
# Inputs:	# Inputs:
#	#
# $is_home - true if current server is home server for user's space	# $is_home - true if current server is home server for user's space
# $context - either: priv, or res respectively for Authoring or Resource Space.	# $recurse - if true will also traverse subdirectories recursively
# $docroot - Document root (i.e., /home/httpd/html	# $include - reference to hash containing allowed file extensions. If provided,
	# files which do not have a matching extension will be ignored.
	# $exclude - reference to hash containing excluded file extensions. If provided,
	# files which have a matching extension will be ignored.
	# $nonemptydir - if true, will only populate $fileshashref hash entry for a particular
	# directory with first file found (with acceptable extension).
	# $addtopdir - if true, set $dirhashref->{'/'} = 1
# $toppath - Top level directory (i.e., /res/$dom/$uname or /priv/$dom/$uname	# $toppath - Top level directory (i.e., /res/$dom/$uname or /priv/$dom/$uname
# $relpath - Current path (relative to top level).	# $relpath - Current path (relative to top level).
# $dirhashref - reference to hash to populate with URLs of directories (Required)	# $dirhashref - reference to hash to populate with URLs of directories (Required)
Line 12002 sub stat_file {	Line 12335 sub stat_file {
#	#

sub recursedirs {	sub recursedirs {
my ($is_home,$context,$docroot,$toppath,$relpath,$dirhashref,$filehashref) = @_;	my ($is_home,$recurse,$include,$exclude,$nonemptydir,$addtopdir,$toppath,$relpath,$dirhashref,$filehashref) = @_;
return unless (ref($dirhashref) eq 'HASH');	return unless (ref($dirhashref) eq 'HASH');
	my $docroot = $perlvar{'lonDocRoot'};
my $currpath = $docroot.$toppath;	my $currpath = $docroot.$toppath;
if ($relpath) {	if ($relpath ne '') {
$currpath .= "/$relpath";	$currpath .= "/$relpath";
}	}
my $savefile;	my ($savefile,$checkinc,$checkexc);
if (ref($filehashref)) {	if (ref($filehashref)) {
$savefile = 1;	$savefile = 1;
}	}
	if (ref($include) eq 'HASH') {
	$checkinc = 1;
	}
	if (ref($exclude) eq 'HASH') {
	$checkexc = 1;
	}
if ($is_home) {	if ($is_home) {
if (opendir(my $dirh,$currpath)) {	if ((-e $currpath) && (opendir(my $dirh,$currpath))) {
	my $filecount = 0;
foreach my $item (sort { lc($a) cmp lc($b) } grep(!/^\.+$/,readdir($dirh))) {	foreach my $item (sort { lc($a) cmp lc($b) } grep(!/^\.+$/,readdir($dirh))) {
next if ($item eq '');	next if ($item eq '');
if (-d "$currpath/$item") {	if (-d "$currpath/$item") {
my $newpath;	my $newpath;
if ($relpath) {	if ($relpath ne '') {
$newpath = "$relpath/$item";	$newpath = "$relpath/$item";
} else {	} else {
$newpath = $item;	$newpath = $item;
}	}
$dirhashref->{&Apache::lonlocal::js_escape($newpath)} = 1;	$dirhashref->{&Apache::lonlocal::js_escape($newpath)} = 1;
&recursedirs($is_home,$context,$docroot,$toppath,$newpath,$dirhashref,$filehashref);	if ($recurse) {
} elsif ($savefile) {	&recursedirs($is_home,$recurse,$include,$exclude,$nonemptydir,$addtopdir,$toppath,$newpath,$dirhashref,$filehashref);
if ($context eq 'priv') {	}
unless ($item =~ /\.(meta\|save\|log\|bak\|DS_Store)$/) {	} elsif (($savefile) \|\| ($relpath eq '')) {
$filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = 1;	next if ($nonemptydir && $filecount);
	if ($checkinc \|\| $checkexc) {
	my ($extension) = ($item =~ /\.(\w+)$/);
	if ($checkinc) {
	next unless ($extension && $include->{$extension});
}	}
} else {	if ($checkexc) {
unless (($item =~ /\.meta$/) \|\| ($item =~ /\.\d+\.\w+$/) \|\| ($item =~ /\.rights$/)) {	next if ($extension && $exclude->{$extension});
	}
	}
	if (($relpath eq '') && (!exists($dirhashref->{'/'}))) {
	$dirhashref->{'/'} = 1;
	}
	if ($savefile) {
	if ($relpath eq '') {
	$filehashref->{'/'}{$item} = 1;
	} else {
$filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = 1;	$filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = 1;
}	}
}	}
	$filecount ++;
}	}
}	}
closedir($dirh);	closedir($dirh);
Line 12045 sub recursedirs {	Line 12400 sub recursedirs {
my @dir_lines;	my @dir_lines;
my $dirptr=16384;	my $dirptr=16384;
if (ref($dirlistref) eq 'ARRAY') {	if (ref($dirlistref) eq 'ARRAY') {
	my $filecount = 0;
foreach my $dir_line (sort	foreach my $dir_line (sort
{	{
my ($afile)=split('&',$a,2);	my ($afile)=split('&',$a,2);
Line 12060 sub recursedirs {	Line 12416 sub recursedirs {
if ($relpath) {	if ($relpath) {
$newpath = "$relpath/$item";	$newpath = "$relpath/$item";
} else {	} else {
$relpath = '/';
$newpath = $item;	$newpath = $item;
}	}
$dirhashref->{&Apache::lonlocal::js_escape($newpath)} = 1;	$dirhashref->{&Apache::lonlocal::js_escape($newpath)} = 1;
&recursedirs($is_home,$context,$docroot,$toppath,$newpath,$dirhashref,$filehashref);	if ($recurse) {
} elsif ($savefile) {	&recursedirs($is_home,$recurse,$include,$exclude,$nonemptydir,$addtopdir,$toppath,$newpath,$dirhashref,$filehashref);
if ($context eq 'priv') {	}
unless ($item =~ /\.(meta\|save\|log\|bak\|DS_Store)$/) {	} elsif (($savefile) \|\| ($relpath eq '')) {
$filehashref->{$relpath}{$item} = 1;	next if ($nonemptydir && $filecount);
	if ($checkinc \|\| $checkexc) {
	my $extension;
	if ($checkinc) {
	next unless ($extension && $include->{$extension});
}	}
} else {	if ($checkexc) {
unless (($item =~ /\.meta$/) \|\| ($item =~ /\.\d+\.\w+$/)) {	next if ($extension && $exclude->{$extension});
$filehashref->{$relpath}{$item} = 1;	}
	}
	if (($relpath eq '') && (!exists($dirhashref->{'/'}))) {
	$dirhashref->{'/'} = 1;
	}
	if ($savefile) {
	if ($relpath eq '') {
	$filehashref->{'/'}{$item} = 1;
	} else {
	$filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = 1;
}	}
}	}
	$filecount ++;
}	}
}	}
}	}
}	}
	if ($addtopdir) {
	if (($relpath eq '') && (!exists($dirhashref->{'/'}))) {
	$dirhashref->{'/'} = 1;
	}
	}
return;	return;
}	}

	sub priv_exclude {
	return {
	meta => 1,
	save => 1,
	log => 1,
	bak => 1,
	rights => 1,
	DS_Store => 1,
	};
	}

# -------------------------------------------------------- Value of a Condition	# -------------------------------------------------------- Value of a Condition

# gets the value of a specific preevaluated condition	# gets the value of a specific preevaluated condition
Line 12305 sub get_domain_lti {	Line 12690 sub get_domain_lti {
} else {	} else {
return %lti;	return %lti;
}	}

if ($context eq 'linkprot') {	if ($context eq 'linkprot') {
$cachename = $context;	$cachename = $context;
} else {	} else {
$cachename = $name;	$cachename = $name;
}	}

my ($result,$cached)=&is_cached_new($cachename,$cdom);	my ($result,$cached)=&is_cached_new($cachename,$cdom);
if (defined($cached)) {	if (defined($cached)) {
if (ref($result) eq 'HASH') {	if (ref($result) eq 'HASH') {
Line 12327 sub get_domain_lti {	Line 12710 sub get_domain_lti {
} else {	} else {
%lti = %{$domconfig{$name}};	%lti = %{$domconfig{$name}};
}	}
if (($context eq 'consumer') && (keys(%lti))) {
my %encdomconfig = &get_dom('encconfig',[$name],$cdom,undef,1);
if (ref($encdomconfig{$name}) eq 'HASH') {
foreach my $id (keys(%lti)) {
if (ref($encdomconfig{$name}{$id}) eq 'HASH') {
foreach my $item ('key','secret') {
$lti{$id}{$item} = $encdomconfig{$name}{$id}{$item};
}
}
}
}
}
}	}
my $cachetime = 246060;	my $cachetime = 246060;
&do_cache_new($cachename,$cdom,\%lti,$cachetime);	&do_cache_new($cachename,$cdom,\%lti,$cachetime);
Line 12347 sub get_domain_lti {	Line 12718 sub get_domain_lti {
}	}

sub get_course_lti {	sub get_course_lti {
my ($cnum,$cdom) = @_;	my ($cnum,$cdom,$context) = @_;
	my ($name,$cachename,%lti);
	if ($context eq 'consumer') {
	$name = 'ltitools';
	$cachename = 'courseltitools';
	} elsif ($context eq 'provider') {
	$name = 'lti';
	$cachename = 'courselti';
	} else {
	return %lti;
	}
my $hashid=$cdom.'_'.$cnum;	my $hashid=$cdom.'_'.$cnum;
my %courselti;	my ($result,$cached)=&is_cached_new($cachename,$hashid);
my ($result,$cached)=&is_cached_new('courselti',$hashid);
if (defined($cached)) {	if (defined($cached)) {
if (ref($result) eq 'HASH') {	if (ref($result) eq 'HASH') {
%courselti = %{$result};	%lti = %{$result};
}	}
} else {	} else {
%courselti = &dump('lti',$cdom,$cnum,undef,undef,undef,1);	%lti = &dump($name,$cdom,$cnum,undef,undef,undef,1);
my $cachetime = 246060;	my $cachetime = 246060;
&do_cache_new('courselti',$hashid,\%courselti,$cachetime);	&do_cache_new($cachename,$hashid,\%lti,$cachetime);
}	}
return %courselti;	return %lti;
}	}

sub courselti_itemid {	sub courselti_itemid {
Line 12369 sub courselti_itemid {	Line 12749 sub courselti_itemid {
$chome = &homeserver($cnum,$cdom);	$chome = &homeserver($cnum,$cdom);
return if ($chome eq 'no_host');	return if ($chome eq 'no_host');
if (ref($params) eq 'HASH') {	if (ref($params) eq 'HASH') {
my $items = &freeze_escape($params);
my $rep;	my $rep;
if (grep { $_ eq $chome } current_machine_ids()) {	if (grep { $_ eq $chome } current_machine_ids()) {
$rep = LONCAPA::Lond::crslti_itemid($cdom,$cnum,$url,$method,$params,$perlvar{'lonVersion'});	$rep = LONCAPA::Lond::crslti_itemid($cdom,$cnum,$url,$method,$params,$perlvar{'lonVersion'});
Line 12393 sub domainlti_itemid {	Line 12772 sub domainlti_itemid {
$primary_id = &domain($cdom,'primary');	$primary_id = &domain($cdom,'primary');
return if ($primary_id eq '');	return if ($primary_id eq '');
if (ref($params) eq 'HASH') {	if (ref($params) eq 'HASH') {
my $items = &freeze_escape($params);
my $rep;	my $rep;
if (grep { $_ eq $primary_id } current_machine_ids()) {	if (grep { $_ eq $primary_id } current_machine_ids()) {
$rep = LONCAPA::Lond::domlti_itemid($cdom,$context,$url,$method,$params,$perlvar{'lonVersion'});	$rep = LONCAPA::Lond::domlti_itemid($cdom,$context,$url,$method,$params,$perlvar{'lonVersion'});
Line 12412 sub domainlti_itemid {	Line 12790 sub domainlti_itemid {
return $itemid;	return $itemid;
}	}

sub get_numsuppfiles {	sub get_ltitools_id {
my ($cnum,$cdom,$ignorecache)=@_;	my ($context,$cdom,$cnum,$title) = @_;
	my ($lockhash,$tries,$gotlock,$id,$error);

	# get lock on ltitools db
	$lockhash = {
	lock => $env{'user.name'}.
	':'.$env{'user.domain'},
	};
	$tries = 0;
	if ($context eq 'domain') {
	$gotlock = &newput_dom('ltitools',$lockhash,$cdom);
	} else {
	$gotlock = &newput('ltitools',$lockhash,$cdom,$cnum);
	}
	while (($gotlock ne 'ok') && ($tries<10)) {
	$tries ++;
	sleep (0.1);
	if ($context eq 'domain') {
	$gotlock = &newput_dom('ltitools',$lockhash,$cdom);
	} else {
	$gotlock = &newput('ltitools',$lockhash,$cdom,$cnum);
	}
	}
	if ($gotlock eq 'ok') {
	my %currids;
	if ($context eq 'domain') {
	%currids = &dump_dom('ltitools',$cdom);
	} else {
	%currids = &dump('ltitools',$cdom,$cnum);
	}
	if ($currids{'lock'}) {
	delete($currids{'lock'});
	if (keys(%currids)) {
	my @curr = sort { $a <=> $b } keys(%currids);
	if ($curr[-1] =~ /^\d+$/) {
	$id = 1 + $curr[-1];
	}
	} else {
	$id = 1;
	}
	if ($id) {
	if ($context eq 'domain') {
	unless (&newput_dom('ltitools',{ $id => $title },$cdom) eq 'ok') {
	$error = 'nostore';
	}
	} else {
	unless (&newput('ltitools',{ $id => $title },$cdom,$cnum) eq 'ok') {
	$error = 'nostore';
	}
	}
	} else {
	$error = 'nonumber';
	}
	}
	my $dellockoutcome;
	if ($context eq 'domain') {
	$dellockoutcome = &del_dom('ltitools',['lock'],$cdom);
	} else {
	$dellockoutcome = &del('ltitools',['lock'],$cdom,$cnum);
	}
	} else {
	$error = 'nolock';
	}
	return ($id,$error);
	}

	sub count_supptools {
	my ($cnum,$cdom,$ignorecache,$reload)=@_;
my $hashid=$cnum.':'.$cdom;	my $hashid=$cnum.':'.$cdom;
my ($suppcount,$cached);	my ($numexttools,$cached);
unless ($ignorecache) {	unless ($ignorecache) {
($suppcount,$cached) = &is_cached_new('suppcount',$hashid);	($numexttools,$cached) = &is_cached_new('supptools',$hashid);
}	}
unless (defined($cached)) {	unless (defined($cached)) {
my $chome=&homeserver($cnum,$cdom);	my $chome=&homeserver($cnum,$cdom);
	$numexttools = 0;
unless ($chome eq 'no_host') {	unless ($chome eq 'no_host') {
($suppcount,my $supptools,my $errors) = (0,0,0);	my ($supplemental) = &Apache::loncommon::get_supplemental($cnum,$cdom,$reload);
my $suppmap = 'supplemental.sequence';	if (ref($supplemental) eq 'HASH') {
($suppcount,$supptools,$errors) =	if ((ref($supplemental->{'ids'}) eq 'HASH') && (ref($supplemental->{'hidden'}) eq 'HASH')) {
&Apache::loncommon::recurse_supplemental($cnum,$cdom,$suppmap,$suppcount,	foreach my $key (keys(%{$supplemental->{'ids'}})) {
$supptools,$errors);	if ($key =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) {
	$numexttools ++;
	}
	}
	}
	}
}	}
&do_cache_new('suppcount',$hashid,$suppcount,600);	&do_cache_new('supptools',$hashid,$numexttools,600);
}	}
return $suppcount;	return $numexttools;
	}

	sub has_unhidden_suppfiles {
	my ($cnum,$cdom,$ignorecache,$possdel)=@_;
	my $hashid=$cnum.':'.$cdom;
	my ($showsupp,$cached);
	unless ($ignorecache) {
	($showsupp,$cached) = &is_cached_new('showsupp',$hashid);
	}
	unless (defined($cached)) {
	my $chome=&homeserver($cnum,$cdom);
	unless ($chome eq 'no_host') {
	my ($supplemental) = &Apache::loncommon::get_supplemental($cnum,$cdom,$ignorecache,$possdel);
	if (ref($supplemental) eq 'HASH') {
	if ((ref($supplemental->{'ids'}) eq 'HASH') && (ref($supplemental->{'hidden'}) eq 'HASH')) {
	foreach my $key (keys(%{$supplemental->{'ids'}})) {
	next if ($key =~ /\.sequence$/);
	if (ref($supplemental->{'ids'}->{$key}) eq 'ARRAY') {
	foreach my $id (@{$supplemental->{'ids'}->{$key}}) {
	unless ($supplemental->{'hidden'}->{$id}) {
	$showsupp = 1;
	last;
	}
	}
	}
	last if ($showsupp);
	}
	}
	}
	}
	&do_cache_new('showsupp',$hashid,$showsupp,600);
	}
	return $showsupp;
}	}

#	#
Line 13506 sub get_reservable_slots {	Line 13990 sub get_reservable_slots {
sub get_course_slots {	sub get_course_slots {
my ($cnum,$cdom) = @_;	my ($cnum,$cdom) = @_;
my $hashid=$cnum.':'.$cdom;	my $hashid=$cnum.':'.$cdom;
my ($result,$cached) = &Apache::lonnet::is_cached_new('allslots',$hashid);	my ($result,$cached) = &is_cached_new('allslots',$hashid);
if (defined($cached)) {	if (defined($cached)) {
if (ref($result) eq 'HASH') {	if (ref($result) eq 'HASH') {
return %{$result};	return %{$result};
}	}
} else {	} else {
my %slots=&Apache::lonnet::dump('slots',$cdom,$cnum);	my %slots=&dump('slots',$cdom,$cnum);
my ($tmp) = keys(%slots);	my ($tmp) = keys(%slots);
if ($tmp !~ /^(con_lost\|error\|no_such_host)/i) {	if ($tmp !~ /^(con_lost\|error\|no_such_host)/i) {
&do_cache_new('allslots',$hashid,\%slots,600);	&do_cache_new('allslots',$hashid,\%slots,600);
Line 13558 sub get_coursechange {	Line 14042 sub get_coursechange {
}	}

sub devalidate_coursechange_cache {	sub devalidate_coursechange_cache {
my ($cnum,$cdom)=@_;	my ($cdom,$cnum)=@_;
my $hashid=$cnum.':'.$cdom;	my $hashid=$cdom.'_'.$cnum;
&devalidate_cache_new('crschange',$hashid);	&devalidate_cache_new('crschange',$hashid);
}	}

	sub get_suppchange {
	my ($cdom,$cnum) = @_;
	if ($cdom eq '' \|\| $cnum eq '') {
	return unless ($env{'request.course.id'});
	$cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
	$cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
	}
	my $hashid=$cdom.'_'.$cnum;
	my ($change,$cached)=&is_cached_new('suppchange',$hashid);
	if ((defined($cached)) && ($change ne '')) {
	return $change;
	} else {
	my %crshash = &get('environment',['internal.supplementalchange'],$cdom,$cnum);
	if ($crshash{'internal.supplementalchange'} eq '') {
	$change = $env{'course.'.$cdom.'_'.$cnum.'.internal.created'};
	if ($change eq '') {
	%crshash = &get('environment',['internal.created'],$cdom,$cnum);
	$change = $crshash{'internal.created'};
	}
	} else {
	$change = $crshash{'internal.supplementalchange'};
	}
	my $cachetime = 600;
	&do_cache_new('suppchange',$hashid,$change,$cachetime);
	}
	return $change;
	}

	sub devalidate_suppchange_cache {
	my ($cdom,$cnum)=@_;
	my $hashid=$cdom.'_'.$cnum;
	&devalidate_cache_new('suppchange',$hashid);
	}

	sub update_supp_caches {
	my ($cdom,$cnum) = @_;
	my %servers = &internet_dom_servers($cdom);
	my @ids=&current_machine_ids();
	foreach my $server (keys(%servers)) {
	next if (grep(/^\Q$server\E$/,@ids));
	my $hashid=$cnum.':'.$cdom;
	my $cachekey = &escape('showsupp').':'.&escape($hashid);
	&remote_devalidate_cache($server,[$cachekey]);
	}
	&has_unhidden_suppfiles($cnum,$cdom,1,1);
	&count_supptools($cnum,$cdom,1);
	my $now = time;
	if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
	&Apache::lonnet::appenv({'request.course.suppupdated' => $now});
	}
	&put('environment',{'internal.supplementalchange' => $now},
	$cdom,$cnum);
	&Apache::lonnet::appenv(
	{'course.'.$cdom.'_'.$cnum.'.internal.supplementalchange' => $now});
	&do_cache_new('suppchange',$cdom.'_'.$cnum,$now,600);
	}

# ------------------------------------------------- Update symbolic store links	# ------------------------------------------------- Update symbolic store links

sub symblist {	sub symblist {
Line 14726 sub get_requestor_ip {	Line 15267 sub get_requestor_ip {

sub get_proxy_settings {	sub get_proxy_settings {
my ($dom_in_use) = @_;	my ($dom_in_use) = @_;
my %domdefaults = &Apache::lonnet::get_domain_defaults($dom_in_use);	my %domdefaults = &get_domain_defaults($dom_in_use);
my $proxyinfo = {	my $proxyinfo = {
ipheader => $domdefaults{'waf_ipheader'},	ipheader => $domdefaults{'waf_ipheader'},
trusted => $domdefaults{'waf_trusted'},	trusted => $domdefaults{'waf_trusted'},
Line 14759 sub get_proxy_alias {	Line 15300 sub get_proxy_alias {
if ($cached) {	if ($cached) {
return $alias;	return $alias;
}	}
my $dom = &Apache::lonnet::host_domain($lonid);	my $dom = &host_domain($lonid);
if ($dom ne '') {	if ($dom ne '') {
my $cachetime = 606024;	my $cachetime = 606024;
my %domconfig =	my %domconfig =
&Apache::lonnet::get_dom('configuration',['wafproxy'],$dom);	&get_dom('configuration',['wafproxy'],$dom);
if (ref($domconfig{'wafproxy'}) eq 'HASH') {	if (ref($domconfig{'wafproxy'}) eq 'HASH') {
if (ref($domconfig{'wafproxy'}{'alias'}) eq 'HASH') {	if (ref($domconfig{'wafproxy'}{'alias'}) eq 'HASH') {
$alias = $domconfig{'wafproxy'}{'alias'}{$lonid};	$alias = $domconfig{'wafproxy'}{'alias'}{$lonid};
Line 14810 sub alias_sso {	Line 15351 sub alias_sso {
if ($cached) {	if ($cached) {
return $use_alias;	return $use_alias;
}	}
my $dom = &Apache::lonnet::host_domain($lonid);	my $dom = &host_domain($lonid);
if ($dom ne '') {	if ($dom ne '') {
my $cachetime = 606024;	my $cachetime = 606024;
my %domconfig =	my %domconfig =
&Apache::lonnet::get_dom('configuration',['wafproxy'],$dom);	&get_dom('configuration',['wafproxy'],$dom);
if (ref($domconfig{'wafproxy'}) eq 'HASH') {	if (ref($domconfig{'wafproxy'}) eq 'HASH') {
if (ref($domconfig{'wafproxy'}{'saml'}) eq 'HASH') {	if (ref($domconfig{'wafproxy'}{'saml'}) eq 'HASH') {
$use_alias = $domconfig{'wafproxy'}{'saml'}{$lonid};	$use_alias = $domconfig{'wafproxy'}{'saml'}{$lonid};
Line 14842 sub get_saml_landing {	Line 15383 sub get_saml_landing {
$lonid = $perlvar{'lonHostID'};	$lonid = $perlvar{'lonHostID'};
}	}
if ($lonid) {	if ($lonid) {
unless (&Apache::lonnet::host_domain($lonid) eq $defdom) {	unless (&host_domain($lonid) eq $defdom) {
return;	return;
}	}
} else {	} else {
Line 14855 sub get_saml_landing {	Line 15396 sub get_saml_landing {
if ($cached) {	if ($cached) {
return $landing;	return $landing;
}	}
my $dom = &Apache::lonnet::host_domain($lonid);	my $dom = &host_domain($lonid);
if ($dom ne '') {	if ($dom ne '') {
my $cachetime = 606024;	my $cachetime = 606024;
my %domconfig =	my %domconfig =
&Apache::lonnet::get_dom('configuration',['login'],$dom);	&get_dom('configuration',['login'],$dom);
if (ref($domconfig{'login'}) eq 'HASH') {	if (ref($domconfig{'login'}) eq 'HASH') {
if (ref($domconfig{'login'}{'saml'}) eq 'HASH') {	if (ref($domconfig{'login'}{'saml'}) eq 'HASH') {
if (ref($domconfig{'login'}{'saml'}{$lonid}) eq 'HASH') {	if (ref($domconfig{'login'}{'saml'}{$lonid}) eq 'HASH') {
Line 14989 sub get_dns {	Line 15530 sub get_dns {
my ($url,$func,$ignore_cache,$nocache,$hashref) = @_;	my ($url,$func,$ignore_cache,$nocache,$hashref) = @_;
if (!$ignore_cache) {	if (!$ignore_cache) {
my ($content,$cached)=	my ($content,$cached)=
&Apache::lonnet::is_cached_new('dns',$url);	&is_cached_new('dns',$url);
if ($cached) {	if ($cached) {
&$func($content,$hashref);	&$func($content,$hashref);
return;	return;
Line 15068 sub get_dns {	Line 15609 sub get_dns {
sub parse_dns_checksums_tab {	sub parse_dns_checksums_tab {
my ($lines,$hashref) = @_;	my ($lines,$hashref) = @_;
my $lonhost = $perlvar{'lonHostID'};	my $lonhost = $perlvar{'lonHostID'};
my $machine_dom = &Apache::lonnet::host_domain($lonhost);	my $machine_dom = &host_domain($lonhost);
my $loncaparev = &get_server_loncaparev($machine_dom);	my $loncaparev = &get_server_loncaparev($machine_dom);
my $distro = (split(/\:/,&get_server_distarch($lonhost)))[0];	my $distro = (split(/\:/,&get_server_distarch($lonhost)))[0];
my $webconfdir = '/etc/httpd/conf';	my $webconfdir = '/etc/httpd/conf';
Line 15112 sub parse_dns_checksums_tab {	Line 15653 sub parse_dns_checksums_tab {

sub fetch_dns_checksums {	sub fetch_dns_checksums {
my %checksums;	my %checksums;
my $machine_dom = &Apache::lonnet::host_domain($perlvar{'lonHostID'});	my $machine_dom = &host_domain($perlvar{'lonHostID'});
my $loncaparev = &get_server_loncaparev($machine_dom,$perlvar{'lonHostID'});	my $loncaparev = &get_server_loncaparev($machine_dom,$perlvar{'lonHostID'});
my ($release,$timestamp) = split(/\-/,$loncaparev);	my ($release,$timestamp) = split(/\-/,$loncaparev);
&get_dns("/adm/dns/checksums/$release",\&parse_dns_checksums_tab,1,1,	&get_dns("/adm/dns/checksums/$release",\&parse_dns_checksums_tab,1,1,
Line 15500 sub parse_getdns_url {	Line 16041 sub parse_getdns_url {
return %iphost;	return %iphost;
}	}
my ($ip_info,$cached)=	my ($ip_info,$cached)=
&Apache::lonnet::is_cached_new('iphost','iphost');	&is_cached_new('iphost','iphost');
if ($cached) {	if ($cached) {
%iphost = %{$ip_info->[0]};	%iphost = %{$ip_info->[0]};
%name_to_ip = %{$ip_info->[1]};	%name_to_ip = %{$ip_info->[1]};
Line 15512 sub parse_getdns_url {	Line 16053 sub parse_getdns_url {
# get yesterday's info for fallback	# get yesterday's info for fallback
my %old_name_to_ip;	my %old_name_to_ip;
my ($ip_info,$cached)=	my ($ip_info,$cached)=
&Apache::lonnet::is_cached_new('iphost','iphost');	&is_cached_new('iphost','iphost');
if ($cached) {	if ($cached) {
%old_name_to_ip = %{$ip_info->[1]};	%old_name_to_ip = %{$ip_info->[1]};
}	}
Line 15579 sub parse_getdns_url {	Line 16120 sub parse_getdns_url {
my ($lonid) = @_;	my ($lonid) = @_;
return if ($lonid eq '');	return if ($lonid eq '');
my ($idnref,$cached)=	my ($idnref,$cached)=
&Apache::lonnet::is_cached_new('internetnames',$lonid);	&is_cached_new('internetnames',$lonid);
if ($cached) {	if ($cached) {
return $idnref;	return $idnref;
}	}
Line 16419 data base, returning a hash that is keye	Line 16960 data base, returning a hash that is keye
values that are the resource value. I believe that the timestamps and	values that are the resource value. I believe that the timestamps and
versions are also returned.	versions are also returned.

get_numsuppfiles($cnum,$cdom) : retrieve number of files in a course's
supplemental content area. This routine caches the number of files for
10 minutes.

=back	=back

=head2 Course Modification	=head2 Course Modification

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

Removed from v.1.1487
changed lines
	Added in v.1.1514