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.1409 and 1.1458

version 1.1409, 2019/04/29 22:19:45	version 1.1458, 2021/06/07 12:15:04
Line 79 use Encode;	Line 79 use Encode;

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

my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash,	my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash,
%userrolehash, $processmarker, $dumpcount, %coursedombuf,	%userrolehash, $processmarker, $dumpcount, %coursedombuf,
Line 96 use Cache::Memcached;	Line 96 use Cache::Memcached;
use Digest::MD5;	use Digest::MD5;
use Math::Random;	use Math::Random;
use File::MMagic;	use File::MMagic;
	use Net::CIDR;
	use Sys::Hostname::FQDN();
use LONCAPA qw(:DEFAULT :match);	use LONCAPA qw(:DEFAULT :match);
use LONCAPA::Configuration;	use LONCAPA::Configuration;
use LONCAPA::lonmetadata;	use LONCAPA::lonmetadata;
Line 128 our @EXPORT = qw(%env);	Line 130 our @EXPORT = qw(%env);
$logid ++;	$logid ++;
my $now = time();	my $now = time();
my $id=$now.'00000'.$$.'00000'.$logid;	my $id=$now.'00000'.$$.'00000'.$logid;
	my $ip = &get_requestor_ip();
my $logentry = {	my $logentry = {
$id => {	$id => {
'exe_uname' => $env{'user.name'},	'exe_uname' => $env{'user.name'},
'exe_udom' => $env{'user.domain'},	'exe_udom' => $env{'user.domain'},
'exe_time' => $now,	'exe_time' => $now,
'exe_ip' => $ENV{'REMOTE_ADDR'},	'exe_ip' => $ip,
'delflag' => $delflag,	'delflag' => $delflag,
'logentry' => $storehash,	'logentry' => $storehash,
'uname' => $uname,	'uname' => $uname,
Line 738 sub check_for_valid_session {	Line 741 sub check_for_valid_session {
if (ref($userhashref) eq 'HASH') {	if (ref($userhashref) eq 'HASH') {
$userhashref->{'name'} = $disk_env{'user.name'};	$userhashref->{'name'} = $disk_env{'user.name'};
$userhashref->{'domain'} = $disk_env{'user.domain'};	$userhashref->{'domain'} = $disk_env{'user.domain'};
	if ($disk_env{'request.role'}) {
	$userhashref->{'role'} = $disk_env{'request.role'};
	}
$userhashref->{'lti'} = $disk_env{'request.lti.login'};	$userhashref->{'lti'} = $disk_env{'request.lti.login'};
if ($userhashref->{'lti'}) {	if ($userhashref->{'lti'}) {
$userhashref->{'ltitarget'} = $disk_env{'request.lti.target'};	$userhashref->{'ltitarget'} = $disk_env{'request.lti.target'};
Line 971 sub userload {	Line 977 sub userload {
# ------------------------------ Find server with least workload from spare.tab	# ------------------------------ Find server with least workload from spare.tab

sub spareserver {	sub spareserver {
my ($loadpercent,$userloadpercent,$want_server_name,$udom) = @_;	my ($r,$loadpercent,$userloadpercent,$want_server_name,$udom) = @_;
my $spare_server;	my $spare_server;
if ($userloadpercent !~ /\d/) { $userloadpercent=0; }	if ($userloadpercent !~ /\d/) { $userloadpercent=0; }
my $lowest_load=($loadpercent > $userloadpercent) ? $loadpercent	my $lowest_load=($loadpercent > $userloadpercent) ? $loadpercent
Line 1016 sub spareserver {	Line 1022 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);
	$hostname = $alias if ($alias ne '');
$spare_server = $protocol.'://'.$hostname;	$spare_server = $protocol.'://'.$hostname;
}	}
}	}
Line 1082 sub find_existing_session {	Line 1090 sub find_existing_session {
return;	return;
}	}

	sub delusersession {
	my ($lonid,$udom,$uname) = @_;
	my $uprimary_id = &domain($udom,'primary');
	my $uintdom = &internet_dom($uprimary_id);
	my $intdom = &internet_dom($lonid);
	my $serverhomedom = &host_domain($lonid);
	if (($uintdom ne '') && ($uintdom eq $intdom)) {
	return &reply(join(':','delusersession',
	map {&escape($_)} ($udom,$uname)),$lonid);
	}
	return;
	}

# check if user's browser sent load balancer cookie and server still has session	# check if user's browser sent load balancer cookie and server still has session
# and is not overloaded.	# and is not overloaded.
sub check_for_balancer_cookie {	sub check_for_balancer_cookie {
Line 1137 sub check_for_balancer_cookie {	Line 1158 sub check_for_balancer_cookie {
return ($otherserver,$cookie);	return ($otherserver,$cookie);
}	}

	sub updatebalcookie {
	my ($cookie,$balancer,$lastentry)=@_;
	if ($cookie =~ /^($match_domain)\_($match_username)\_[a-f0-9]{32}$/) {
	my ($udom,$uname) = ($1,$2);
	my $uprimary_id = &domain($udom,'primary');
	my $uintdom = &internet_dom($uprimary_id);
	my $intdom = &internet_dom($balancer);
	my $serverhomedom = &host_domain($balancer);
	if (($uintdom ne '') && ($uintdom eq $intdom)) {
	return &reply('updatebalcookie:'.&escape($cookie).':'.&escape($lastentry),$balancer);
	}
	}
	return;
	}

sub delbalcookie {	sub delbalcookie {
my ($cookie,$balancer) =@_;	my ($cookie,$balancer) =@_;
if ($cookie =~ /^($match_domain)\_($match_username)\_[a-f0-9]{32}$/) {	if ($cookie =~ /^($match_domain)\_($match_username)\_[a-f0-9]{32}$/) {
Line 1146 sub delbalcookie {	Line 1182 sub delbalcookie {
my $intdom = &internet_dom($balancer);	my $intdom = &internet_dom($balancer);
my $serverhomedom = &host_domain($balancer);	my $serverhomedom = &host_domain($balancer);
if (($uintdom ne '') && ($uintdom eq $intdom)) {	if (($uintdom ne '') && ($uintdom eq $intdom)) {
return &reply("delbalcookie:$cookie",$balancer);	return &reply('delbalcookie:'.&escape($cookie),$balancer);
}	}
}	}
}	}
Line 1217 sub choose_server {	Line 1253 sub choose_server {
return ($login_host,$hostname,$portal_path,$isredirect,$lowest_load);	return ($login_host,$hostname,$portal_path,$isredirect,$lowest_load);
}	}

	sub get_course_sessions {
	my ($cnum,$cdom,$lastactivity) = @_;
	my %servers = &internet_dom_servers($cdom);
	my %returnhash;
	foreach my $server (sort(keys(%servers))) {
	my $rep = &reply("coursesessions:$cdom:$cnum:$lastactivity",$server);
	my @pairs=split(/\&/,$rep);
	unless (($rep eq 'unknown_cmd') \|\| ($rep =~ /^error/)) {
	foreach my $item (@pairs) {
	my ($key,$value)=split(/=/,$item,2);
	$key = &unescape($key);
	next if ($key =~ /^error: 2 /);
	if (exists($returnhash{$key})) {
	next if ($value < $returnhash{$key});
	}
	$returnhash{$key}=$value;
	}
	}
	}
	return %returnhash;
	}

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

sub changepass {	sub changepass {
Line 1393 sub spare_can_host {	Line 1451 sub spare_can_host {
$canhost = 0;	$canhost = 0;
}	}
}	}
	if ($canhost) {
	if (ref($defdomdefaults{'offloadoth'}) eq 'HASH') {
	if ($defdomdefaults{'offloadoth'}{$try_server}) {
	unless (&shared_institution($udom,$try_server)) {
	$canhost = 0;
	}
	}
	}
	}
if (($canhost) && ($uint_dom)) {	if (($canhost) && ($uint_dom)) {
my @intdoms;	my @intdoms;
my $internet_names = &get_internet_names($try_server);	my $internet_names = &get_internet_names($try_server);
Line 1611 sub check_loadbalancing {	Line 1678 sub check_loadbalancing {
if ($domneedscache) {	if ($domneedscache) {
&do_cache_new('loadbalancing',$domneedscache,$is_balancer,$cachetime);	&do_cache_new('loadbalancing',$domneedscache,$is_balancer,$cachetime);
}	}
if ($is_balancer) {	if (($is_balancer) && ($caller ne 'switchserver')) {
my $lowest_load = 30000;	my $lowest_load = 30000;
if (ref($offloadto) eq 'HASH') {	if (ref($offloadto) eq 'HASH') {
if (ref($offloadto->{'primary'}) eq 'ARRAY') {	if (ref($offloadto->{'primary'}) eq 'ARRAY') {
Line 1651 sub check_loadbalancing {	Line 1718 sub check_loadbalancing {
}	}
}	}
}	}
unless ($homeintdom) {	}
undef($setcookie);	if (($is_balancer) && (!$homeintdom)) {
}	undef($setcookie);
}	}
return ($is_balancer,$otherserver,$setcookie,$offloadto,$dom_balancers);	return ($is_balancer,$otherserver,$setcookie,$offloadto,$dom_balancers);
}	}
Line 2103 sub get_dom {	Line 2170 sub get_dom {
}	}
if ($udom && $uhome && ($uhome ne 'no_host')) {	if ($udom && $uhome && ($uhome ne 'no_host')) {
my $rep;	my $rep;
if ($namespace =~ /^enc/) {	if (grep { $_ eq $uhome } &current_machine_ids()) {
$rep=&reply("encrypt:egetdom:$udom:$namespace:$items",$uhome);	# domain information is hosted on this machine
	my $cmd = 'getdom';
	if ($namespace =~ /^enc/) {
	$cmd = 'egetdom';
	}
	$rep = &LONCAPA::Lond::get_dom("$cmd:$udom:$namespace:$items");
} else {	} else {
$rep=&reply("getdom:$udom:$namespace:$items",$uhome);	if ($namespace =~ /^enc/) {
	$rep=&reply("encrypt:egetdom:$udom:$namespace:$items",$uhome);
	} else {
	$rep=&reply("getdom:$udom:$namespace:$items",$uhome);
	}
}	}
my %returnhash;	my %returnhash;
if ($rep eq '' \|\| $rep =~ /^error: 2 /) {	if ($rep eq '' \|\| $rep =~ /^error: 2 /) {
Line 2248 sub inst_directory_query {	Line 2324 sub inst_directory_query {
if ($homeserver ne '') {	if ($homeserver ne '') {
unless ($homeserver eq $perlvar{'lonHostID'}) {	unless ($homeserver eq $perlvar{'lonHostID'}) {
if ($srch->{'srchby'} eq 'email') {	if ($srch->{'srchby'} eq 'email') {
my $lcrev = &get_server_loncaparev(undef,$homeserver);	my $lcrev = &get_server_loncaparev($udom,$homeserver);
my ($major,$minor) = ($lcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);	my ($major,$minor) = ($lcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
if (($major eq '' && $minor eq '') \|\| ($major < 2) \|\|	if (($major eq '' && $minor eq '') \|\| ($major < 2) \|\|
(($major == 2) && ($minor < 12))) {	(($major == 2) && ($minor < 12))) {
Line 2299 sub usersearch {	Line 2375 sub usersearch {
if (&host_domain($tryserver) eq $dom) {	if (&host_domain($tryserver) eq $dom) {
unless ($tryserver eq $perlvar{'lonHostID'}) {	unless ($tryserver eq $perlvar{'lonHostID'}) {
if ($srch->{'srchby'} eq 'email') {	if ($srch->{'srchby'} eq 'email') {
my $lcrev = &get_server_loncaparev(undef,$tryserver);	my $lcrev = &get_server_loncaparev($dom,$tryserver);
my ($major,$minor) = ($lcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);	my ($major,$minor) = ($lcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
next if (($major eq '' && $minor eq '') \|\| ($major < 2) \|\|	next if (($major eq '' && $minor eq '') \|\| ($major < 2) \|\|
(($major == 2) && ($minor < 12)));	(($major == 2) && ($minor < 12)));
Line 2544 sub get_domain_defaults {	Line 2620 sub get_domain_defaults {
'coursedefaults','usersessions',	'coursedefaults','usersessions',
'requestauthor','selfenrollment',	'requestauthor','selfenrollment',
'coursecategories','ssl','autoenroll',	'coursecategories','ssl','autoenroll',
'trust','helpsettings'],$domain);	'trust','helpsettings','wafproxy'],$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 2637 sub get_domain_defaults {	Line 2713 sub get_domain_defaults {
if (ref($domconfig{'usersessions'}{'offloadnow'}) eq 'HASH') {	if (ref($domconfig{'usersessions'}{'offloadnow'}) eq 'HASH') {
$domdefaults{'offloadnow'} = $domconfig{'usersessions'}{'offloadnow'};	$domdefaults{'offloadnow'} = $domconfig{'usersessions'}{'offloadnow'};
}	}
	if (ref($domconfig{'usersessions'}{'offloadoth'}) eq 'HASH') {
	$domdefaults{'offloadoth'} = $domconfig{'usersessions'}{'offloadoth'};
	}
}	}
if (ref($domconfig{'selfenrollment'}) eq 'HASH') {	if (ref($domconfig{'selfenrollment'}) eq 'HASH') {
if (ref($domconfig{'selfenrollment'}{'admin'}) eq 'HASH') {	if (ref($domconfig{'selfenrollment'}{'admin'}) eq 'HASH') {
Line 2669 sub get_domain_defaults {	Line 2748 sub get_domain_defaults {
if (ref($domconfig{'coursecategories'}) eq 'HASH') {	if (ref($domconfig{'coursecategories'}) eq 'HASH') {
$domdefaults{'catauth'} = 'std';	$domdefaults{'catauth'} = 'std';
$domdefaults{'catunauth'} = 'std';	$domdefaults{'catunauth'} = 'std';
if ($domconfig{'coursecategories'}{'auth'}) {	if ($domconfig{'coursecategories'}{'auth'}) {
$domdefaults{'catauth'} = $domconfig{'coursecategories'}{'auth'};	$domdefaults{'catauth'} = $domconfig{'coursecategories'}{'auth'};
}	}
if ($domconfig{'coursecategories'}{'unauth'}) {	if ($domconfig{'coursecategories'}{'unauth'}) {
Line 2704 sub get_domain_defaults {	Line 2783 sub get_domain_defaults {
$domdefaults{'adhocroles'} = $domconfig{'helpsettings'}{'adhoc'};	$domdefaults{'adhocroles'} = $domconfig{'helpsettings'}{'adhoc'};
}	}
}	}
	if (ref($domconfig{'wafproxy'}) eq 'HASH') {
	foreach my $item ('ipheader','trusted','vpnint','vpnext','sslopt') {
	if ($domconfig{'wafproxy'}{$item}) {
	$domdefaults{'waf_'.$item} = $domconfig{'wafproxy'}{$item};
	}
	}
	}
&do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime);	&do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime);
return %domdefaults;	return %domdefaults;
}	}

	sub get_dom_cats {
	my ($dom) = @_;
	return unless (&domain($dom));
	my ($cats,$cached)=&is_cached_new('cats',$dom);
	unless (defined($cached)) {
	my %domconfig = &get_dom('configuration',['coursecategories'],$dom);
	if (ref($domconfig{'coursecategories'}) eq 'HASH') {
	if (ref($domconfig{'coursecategories'}{'cats'}) eq 'HASH') {
	%{$cats} = %{$domconfig{'coursecategories'}{'cats'}};
	} else {
	$cats = {};
	}
	} else {
	$cats = {};
	}
	&Apache::lonnet::do_cache_new('cats',$dom,$cats,3600);
	}
	return $cats;
	}

	sub get_dom_instcats {
	my ($dom) = @_;
	return unless (&domain($dom));
	my ($instcats,$cached)=&is_cached_new('instcats',$dom);
	unless (defined($cached)) {
	my (%coursecodes,%codes,@codetitles,%cat_titles,%cat_order);
	my $totcodes = &retrieve_instcodes(\%coursecodes,$dom);
	if ($totcodes > 0) {
	my $caller = 'global';
	if (&auto_instcode_format($caller,$dom,\%coursecodes,\%codes,
	\@codetitles,\%cat_titles,\%cat_order) eq 'ok') {
	$instcats = {
	codes => \%codes,
	codetitles => \@codetitles,
	cat_titles => \%cat_titles,
	cat_order => \%cat_order,
	};
	&do_cache_new('instcats',$dom,$instcats,3600);
	}
	}
	}
	return $instcats;
	}

	sub retrieve_instcodes {
	my ($coursecodes,$dom) = @_;
	my $totcodes;
	my %courses = &courseiddump($dom,'.',1,'.','.','.',undef,undef,'Course');
	foreach my $course (keys(%courses)) {
	if (ref($courses{$course}) eq 'HASH') {
	if ($courses{$course}{'inst_code'} ne '') {
	$$coursecodes{$course} = $courses{$course}{'inst_code'};
	$totcodes ++;
	}
	}
	}
	return $totcodes;
	}

sub course_portal_url {	sub course_portal_url {
my ($cnum,$cdom) = @_;	my ($cnum,$cdom,$r) = @_;
my $chome = &homeserver($cnum,$cdom);	my $chome = &homeserver($cnum,$cdom);
my $hostname = &hostname($chome);	my $hostname = &hostname($chome);
my $protocol = $protocol{$chome};	my $protocol = $protocol{$chome};
Line 2719 sub course_portal_url {	Line 2864 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);
	$hostname = $alias if ($alias ne '');
$firsturl = $protocol.'://'.$hostname;	$firsturl = $protocol.'://'.$hostname;
}	}
return $firsturl;	return $firsturl;
Line 3289 sub repcopy {	Line 3436 sub repcopy {
}	}
}	}

	# ------------------------------------------------- Unsubscribe from a resource

	sub unsubscribe {
	my ($fname) = @_;
	my $answer;
	if ($fname=~/\/(aboutme\|syllabus\|bulletinboard\|smppg)$/) { return $answer; }
	$fname=~s/[\n\r]//g;
	my $author=$fname;
	$author=~s/\/home\/httpd\/html\/res\/([^\/])\/([^\/]).*/$1\/$2/;
	my ($udom,$uname)=split(/\//,$author);
	my $home=homeserver($uname,$udom);
	if ($home eq 'no_host') {
	$answer = 'no_host';
	} elsif (grep { $_ eq $home } &current_machine_ids()) {
	$answer = 'home';
	} else {
	my $defdom = $perlvar{'lonDefDomain'};
	if (&will_trust('content',$defdom,$udom)) {
	$answer = reply("unsub:$fname",$home);
	} else {
	$answer = 'untrusted';
	}
	}
	return $answer;
	}

# ------------------------------------------------ Get server side include body	# ------------------------------------------------ Get server side include body
sub ssi_body {	sub ssi_body {
my ($filelink,%form)=@_;	my ($filelink,%form)=@_;
Line 3317 sub ssi_body {	Line 3490 sub ssi_body {
# --------------------------------------------------------- Server Side Include	# --------------------------------------------------------- Server Side Include

sub absolute_url {	sub absolute_url {
my ($host_name) = @_;	my ($host_name,$unalias,$keep_proto) = @_;
my $protocol = ($ENV{'SERVER_PORT'} == 443?'https://':'http://');	my $protocol = ($ENV{'SERVER_PORT'} == 443?'https://':'http://');
if ($host_name eq '') {	if ($host_name eq '') {
$host_name = $ENV{'SERVER_NAME'};	$host_name = $ENV{'SERVER_NAME'};
}	}
	if ($unalias) {
	my $alias = &get_proxy_alias();
	if ($alias eq $host_name) {
	my $lonhost = $perlvar{'lonHostID'};
	my $hostname = &hostname($lonhost);
	my $lcproto;
	if (($keep_proto) \|\| ($hostname eq '')) {
	$lcproto = $protocol;
	} else {
	$lcproto = $protocol{$lonhost};
	$lcproto = 'http' if ($lcproto ne 'https');
	$lcproto .= '://';
	}
	unless ($hostname eq '') {
	return $lcproto.$hostname;
	}
	}
	}
return $protocol.$host_name;	return $protocol.$host_name;
}	}

Line 3338 sub absolute_url {	Line 3529 sub absolute_url {
sub ssi {	sub ssi {

my ($fn,%form)=@_;	my ($fn,%form)=@_;
my $request;	my ($host,$request,$response);
	$host = &absolute_url('',1);

$form{'no_update_last_known'}=1;	$form{'no_update_last_known'}=1;
&Apache::lonenc::check_encrypt(\$fn);	&Apache::lonenc::check_encrypt(\$fn);
if (%form) {	if (%form) {
$request=new HTTP::Request('POST',&absolute_url().$fn);	$request=new HTTP::Request('POST',$host.$fn);
$request->content(join('&',map {	$request->content(join('&',map {
my $name = escape($_);	my $name = escape($_);
"$name=" . ( ref($form{$_}) eq 'ARRAY'	"$name=" . ( ref($form{$_}) eq 'ARRAY'
Line 3351 sub ssi {	Line 3543 sub ssi {
: &escape($form{$_}) );	: &escape($form{$_}) );
} keys(%form)));	} keys(%form)));
} else {	} else {
$request=new HTTP::Request('GET',&absolute_url().$fn);	$request=new HTTP::Request('GET',$host.$fn);
}	}

$request->header(Cookie => $ENV{'HTTP_COOKIE'});	$request->header(Cookie => $ENV{'HTTP_COOKIE'});
Line 3365 sub ssi {	Line 3557 sub ssi {
($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')))) {	($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')))) {
$islocal = 1;	$islocal = 1;
}	}
my $response= &LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar,	$response= &LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar,
'','','',$islocal);	'','','',$islocal);

if (wantarray) {	if (wantarray) {
return ($response->content, $response);	return ($response->content, $response);
Line 3434 sub remove_stale_resfile {	Line 3626 sub remove_stale_resfile {
$stale = 1;	$stale = 1;
}	}
if ($stale) {	if ($stale) {
unlink($fname);	if (unlink($fname)) {
if ($uri!~/\.meta$/) {	if ($uri!~/\.meta$/) {
unlink($fname.'.meta');	if (-e $fname.'.meta') {
	unlink($fname.'.meta');
	}
	}
	my $unsubresult = &unsubscribe($fname);
	unless ($unsubresult eq 'ok') {
	&logthis("no unsub of $fname from $homeserver, reason: $unsubresult");
	}
	$removed = 1;
}	}
&reply("unsub:$fname",$homeserver);
$removed = 1;
}	}
}	}
}	}
Line 3589 sub can_edit_resource {	Line 3787 sub can_edit_resource {
$forceedit = 1;	$forceedit = 1;
}	}
$cfile = $resurl;	$cfile = $resurl;
	} elsif (($resurl =~ m{^/ext/}) && ($symb ne '')) {
	my ($map,$id,$res) = &decode_symb($symb);
	if ($map =~ /\.page$/) {
	$incourse = 1;
	if ($env{'form.forceedit'}) {
	$forceview = 1;
	$cfile = $map;
	} else {
	$forceedit = 1;
	$cfile = '/adm/wrapper'.$resurl;
	}
	}
} elsif ($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) {	} elsif ($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) {
$incourse = 1;	$incourse = 1;
if ($env{'form.forceedit'}) {	if ($env{'form.forceedit'}) {
Line 3614 sub can_edit_resource {	Line 3824 sub can_edit_resource {
$cfile = $template;	$cfile = $template;
}	}
} elsif (($resurl =~ m{^/adm/wrapper/ext/}) && ($env{'form.folderpath'} =~ /^supplemental/)) {	} elsif (($resurl =~ m{^/adm/wrapper/ext/}) && ($env{'form.folderpath'} =~ /^supplemental/)) {
$incourse = 1;	$incourse = 1;
if ($env{'form.forceedit'}) {	if ($env{'form.forceedit'}) {
$forceview = 1;	$forceview = 1;
} else {	} else {
$forceedit = 1;	$forceedit = 1;
}	}
$cfile = $resurl;	$cfile = $resurl;
} elsif (($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) && ($env{'form.folderpath'} =~ /^supplemental/)) {	} elsif (($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) && ($env{'form.folderpath'} =~ /^supplemental/)) {
$incourse = 1;	$incourse = 1;
if ($env{'form.forceedit'}) {	if ($env{'form.forceedit'}) {
Line 3891 sub clean_filename {	Line 4101 sub clean_filename {
# Replace all .\d. sequences with _\d. so they no longer look like version	# Replace all .\d. sequences with _\d. so they no longer look like version
# numbers	# numbers
$fname=~s/\.(\d+)(?=\.)/_$1/g;	$fname=~s/\.(\d+)(?=\.)/_$1/g;
	# Replace three or more adjacent underscores with one for consistency
	# with loncfile::filename_check() so complete url can be extracted by
	# lonnet::decode_symb()
	$fname=~s/_{3,}/_/g;
return $fname;	return $fname;
}	}

Line 4861 sub courseacclog {	Line 5075 sub courseacclog {
if ($formitem =~ /^HWFILE(?:SIZE\|TOOBIG)/) {	if ($formitem =~ /^HWFILE(?:SIZE\|TOOBIG)/) {
$what.=':'.$formitem.'='.$env{$key};	$what.=':'.$formitem.'='.$env{$key};
} elsif ($formitem !~ /^HWFILE(?:[^.]+)$/) {	} elsif ($formitem !~ /^HWFILE(?:[^.]+)$/) {
$what.=':'.$formitem.'='.$env{$key};	if ($formitem eq 'proctorpassword') {
	$what.=':'.$formitem.'=' . '*' x length($env{$key});
	} else {
	$what.=':'.$formitem.'='.$env{$key};
	}
}	}
}	}
}	}
Line 5943 sub tmpreset {	Line 6161 sub tmpreset {
if (!$domain) { $domain=$env{'user.domain'}; }	if (!$domain) { $domain=$env{'user.domain'}; }
if (!$stuname) { $stuname=$env{'user.name'}; }	if (!$stuname) { $stuname=$env{'user.name'}; }
if ($domain eq 'public' && $stuname eq 'public') {	if ($domain eq 'public' && $stuname eq 'public') {
$stuname=$ENV{'REMOTE_ADDR'};	$stuname=&get_requestor_ip();
}	}
my $path=LONCAPA::tempdir();	my $path=LONCAPA::tempdir();
my %hash;	my %hash;
Line 5980 sub tmpstore {	Line 6198 sub tmpstore {
if (!$domain) { $domain=$env{'user.domain'}; }	if (!$domain) { $domain=$env{'user.domain'}; }
if (!$stuname) { $stuname=$env{'user.name'}; }	if (!$stuname) { $stuname=$env{'user.name'}; }
if ($domain eq 'public' && $stuname eq 'public') {	if ($domain eq 'public' && $stuname eq 'public') {
$stuname=$ENV{'REMOTE_ADDR'};	$stuname=&get_requestor_ip();
}	}
my $now=time;	my $now=time;
my %hash;	my %hash;
Line 6024 sub tmprestore {	Line 6242 sub tmprestore {
if (!$domain) { $domain=$env{'user.domain'}; }	if (!$domain) { $domain=$env{'user.domain'}; }
if (!$stuname) { $stuname=$env{'user.name'}; }	if (!$stuname) { $stuname=$env{'user.name'}; }
if ($domain eq 'public' && $stuname eq 'public') {	if ($domain eq 'public' && $stuname eq 'public') {
$stuname=$ENV{'REMOTE_ADDR'};	$stuname=&get_requestor_ip();
}	}
my %returnhash;	my %returnhash;
$namespace=~s/\//\_/g;	$namespace=~s/\//\_/g;
Line 6080 sub store {	Line 6298 sub store {
}	}
if (!$home) { $home=$env{'user.home'}; }	if (!$home) { $home=$env{'user.home'}; }

$$storehash{'ip'}=$ENV{'REMOTE_ADDR'};	$$storehash{'ip'}=&get_requestor_ip();
$$storehash{'host'}=$perlvar{'lonHostID'};	$$storehash{'host'}=$perlvar{'lonHostID'};

my $namevalue='';	my $namevalue='';
Line 6116 sub cstore {	Line 6334 sub cstore {
}	}
if (!$home) { $home=$env{'user.home'}; }	if (!$home) { $home=$env{'user.home'}; }

$$storehash{'ip'}=$ENV{'REMOTE_ADDR'};	$$storehash{'ip'}=&get_requestor_ip();
$$storehash{'host'}=$perlvar{'lonHostID'};	$$storehash{'host'}=$perlvar{'lonHostID'};

my $namevalue='';	my $namevalue='';
Line 7111 sub putstore {	Line 7329 sub putstore {
foreach my $key (keys(%{$storehash})) {	foreach my $key (keys(%{$storehash})) {
$namevalue.=&escape($key).'='.&freeze_escape($storehash->{$key}).'&';	$namevalue.=&escape($key).'='.&freeze_escape($storehash->{$key}).'&';
}	}
$namevalue .= 'ip='.&escape($ENV{'REMOTE_ADDR'}).	my $ip = &get_requestor_ip();
	$namevalue .= 'ip='.&escape($ip).
'&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'});
Line 7898 sub customaccess {	Line 8117 sub customaccess {
# ------------------------------------------------- Check for a user privilege	# ------------------------------------------------- Check for a user privilege

sub allowed {	sub allowed {
my ($priv,$uri,$symb,$role,$clientip,$noblockcheck)=@_;	my ($priv,$uri,$symb,$role,$clientip,$noblockcheck,$ignorecache)=@_;
my $ver_orguri=$uri;	my $ver_orguri=$uri;
$uri=&deversion($uri);	$uri=&deversion($uri);
my $orguri=$uri;	my $orguri=$uri;
Line 7915 sub allowed {	Line 8134 sub allowed {

if (defined($env{'allowed.'.$priv})) { return $env{'allowed.'.$priv}; }	if (defined($env{'allowed.'.$priv})) { return $env{'allowed.'.$priv}; }
# Free bre access to adm and meta resources	# Free bre access to adm and meta resources
if (((($uri=~/^adm\//) && ($uri !~ m{/(?:smppg\|bulletinboard\|ext\.tool)$}))	if (((($uri=~/^adm\//) && ($uri !~ m{/(?:smppg\|bulletinboard\|viewclasslist\|aboutme\|ext\.tool)$}))
\|\| (($uri=~/\.meta$/) && ($uri!~m\|^uploaded/\|) ))	\|\| (($uri=~/\.meta$/) && ($uri!~m\|^uploaded/\|) ))
&& ($priv eq 'bre')) {	&& ($priv eq 'bre')) {
return 'F';	return 'F';
Line 8024 sub allowed {	Line 8243 sub allowed {
my $adom = $1;	my $adom = $1;
foreach my $key (keys(%env)) {	foreach my $key (keys(%env)) {
if ($key =~ m{^user\.role\.(ca\|aa)/\Q$adom\E}) {	if ($key =~ m{^user\.role\.(ca\|aa)/\Q$adom\E}) {
my ($start,$end) = split('.',$env{$key});	my ($start,$end) = split(/\./,$env{$key});
if (($now >= $start) && (!$end \|\| $end < $now)) {	if (($now >= $start) && (!$end \|\| $end > $now)) {
$ownaccess = 1;	$ownaccess = 1;
last;	last;
}	}
Line 8037 sub allowed {	Line 8256 sub allowed {
foreach my $role ('ca','aa') {	foreach my $role ('ca','aa') {
if ($env{"user.role.$role./$adom/$aname"}) {	if ($env{"user.role.$role./$adom/$aname"}) {
my ($start,$end) =	my ($start,$end) =
split('.',$env{"user.role.$role./$adom/$aname"});	split(/\./,$env{"user.role.$role./$adom/$aname"});
if (($now >= $start) && (!$end \|\| $end < $now)) {	if (($now >= $start) && (!$end \|\| $end > $now)) {
$ownaccess = 1;	$ownaccess = 1;
last;	last;
}	}
Line 8089 sub allowed {	Line 8308 sub allowed {
($env{'course.'.$env{'request.course.id'}.'.internal.courseowner'} eq $env{'user.name'}.':'.$env{'user.domain'})) {	($env{'course.'.$env{'request.course.id'}.'.internal.courseowner'} eq $env{'user.name'}.':'.$env{'user.domain'})) {
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};	my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
if ($cdom ne '') {	if ($cdom ne '') {
my %passwdconf = &Apache::lonnet::get_passwdconf($cdom);	my %passwdconf = &get_passwdconf($cdom);
if ($passwdconf{'crsownerchg'}) {	if (ref($passwdconf{'crsownerchg'}) eq 'HASH') {
$thisallowed.=$rem;	if (ref($passwdconf{'crsownerchg'}{'by'}) eq 'ARRAY') {
	if (@{$passwdconf{'crsownerchg'}{'by'}}) {
	my @inststatuses = split(':',$env{'environment.inststatus'});
	unless (@inststatuses) {
	@inststatuses = ('default');
	}
	foreach my $status (@inststatuses) {
	if (grep(/^\Q$status\E$/,@{$passwdconf{'crsownerchg'}{'by'}})) {
	$thisallowed.=$rem;
	}
	}
	}
	}
}	}
}	}
}	}
Line 8117 sub allowed {	Line 8348 sub allowed {
} elsif ($noblockcheck) {	} elsif ($noblockcheck) {
$thisallowed.=$value;	$thisallowed.=$value;
} else {	} else {
my @blockers = &has_comm_blocking($priv,$symb,$uri);	my @blockers = &has_comm_blocking($priv,$symb,$uri,$ignorecache);
if (@blockers > 0) {	if (@blockers > 0) {
$thisallowed = 'B';	$thisallowed = 'B';
} else {	} else {
Line 8140 sub allowed {	Line 8371 sub allowed {
} elsif ($noblockcheck) {	} elsif ($noblockcheck) {
$thisallowed='F';	$thisallowed='F';
} else {	} else {
my @blockers = &has_comm_blocking($priv,$symb,$refuri);	my @blockers = &has_comm_blocking($priv,'',$refuri,'',1);
if (@blockers > 0) {	if (@blockers > 0) {
$thisallowed = 'B';	$thisallowed = 'B';
} else {	} else {
Line 8210 sub allowed {	Line 8441 sub allowed {
=~/\Q$priv\E\&([^\:]*)/) {	=~/\Q$priv\E\&([^\:]*)/) {
my $value = $1;	my $value = $1;
if ($priv eq 'bre') {	if ($priv eq 'bre') {
if ($noblockcheck) {	my $deeplinkblock = &deeplink_check($priv,$symb,$uri);
	if ($deeplinkblock) {
	$thisallowed = 'D';
	} elsif ($noblockcheck) {
$thisallowed.=$value;	$thisallowed.=$value;
} else {	} else {
my @blockers = &has_comm_blocking($priv,$symb,$uri);	my @blockers = &has_comm_blocking($priv,$symb,$uri,$ignorecache);
if (@blockers > 0) {	if (@blockers > 0) {
$thisallowed = 'B';	$thisallowed = 'B';
} else {	} else {
Line 8226 sub allowed {	Line 8460 sub allowed {
$checkreferer=0;	$checkreferer=0;
}	}
}	}

if ($checkreferer) {	if ($checkreferer) {
my $refuri=$env{'httpref.'.$orguri};	my $refuri=$env{'httpref.'.$orguri};
unless ($refuri) {	unless ($refuri) {
Line 8258 sub allowed {	Line 8492 sub allowed {
} elsif ($noblockcheck) {	} elsif ($noblockcheck) {
$thisallowed.=$value;	$thisallowed.=$value;
} else {	} else {
my @blockers = &has_comm_blocking($priv,$symb,$refuri);	my @blockers = &has_comm_blocking($priv,'',$refuri,'',1);
if (@blockers > 0) {	if (@blockers > 0) {
$thisallowed = 'B';	$thisallowed = 'B';
} else {	} else {
Line 8300 sub allowed {	Line 8534 sub allowed {
#	#

# Possibly locked functionality, check all courses	# Possibly locked functionality, check all courses
	# In roles.tab, L (unless locked) available for bre, pch, plc, pac and sma.
# Locks might take effect only after 10 minutes cache expiration for other	# Locks might take effect only after 10 minutes cache expiration for other
# courses, and 2 minutes for current course	# courses, and 2 minutes for current course, in which user has st or ta role
	# which is neither expired nor a future role (unless current course).

my $envkey;	my ($needlockcheck,$now,$crsonly);
if ($thisallowed=~/L/) {	if ($thisallowed=~/L/) {
foreach $envkey (keys(%env)) {	$now = time;
	if ($priv eq 'bre') {
	if ($uri ne '') {
	if ($orguri =~ m{^/+res/}) {
	if ($uri =~ m{^lib/templates/}) {
	if ($env{'request.course.id'}) {
	$crsonly = 1;
	$needlockcheck = 1;
	}
	} else {
	$needlockcheck = 1;
	}
	} elsif ($env{'request.course.id'}) {
	my ($crsdom,$crsnum) = split('_',$env{'request.course.id'});
	if (($uri =~ m{^(adm\|uploaded\|public)/$crsdom/$crsnum/}) \|\|
	($uri =~ m{^adm/$match_domain/$match_username/\d+/(smppg\|bulletinboard)$})) {
	$crsonly = 1;
	}
	$needlockcheck = 1;
	}
	}
	} elsif (($priv eq 'pch') \|\| ($priv eq 'plc') \|\| ($priv eq 'pac') \|\| ($priv eq 'sma')) {
	$needlockcheck = 1;
	}
	}
	if ($needlockcheck) {
	foreach my $envkey (keys(%env)) {
if ($envkey=~/^user\.role\.(st\|ta)\.([^\.]*)/) {	if ($envkey=~/^user\.role\.(st\|ta)\.([^\.]*)/) {
my $courseid=$2;	my $courseid=$2;
my $roleid=$1.'.'.$2;	my $roleid=$1.'.'.$2;
$courseid=~s/^\///;	$courseid=~s/^\///;
	unless ($env{'request.role'} eq $roleid) {
	my ($start,$end) = split(/\./,$env{$envkey});
	next unless (($now >= $start) && (!$end \|\| $end > $now));
	}
my $expiretime=600;	my $expiretime=600;
if ($env{'request.role'} eq $roleid) {	if ($env{'request.role'} eq $roleid) {
$expiretime=120;	$expiretime=120;
Line 8332 sub allowed {	Line 8598 sub allowed {
}	}
if (($env{$prefix.'priv.'.$priv.'.lock.sections'}=~/\,\Q$csec\E\,/)	if (($env{$prefix.'priv.'.$priv.'.lock.sections'}=~/\,\Q$csec\E\,/)
\|\| ($env{$prefix.'priv.'.$priv.'.lock.sections'} eq 'all')) {	\|\| ($env{$prefix.'priv.'.$priv.'.lock.sections'} eq 'all')) {
if ($env{'priv.'.$priv.'.lock.expire'}>time) {	if ($env{$prefix.'priv.'.$priv.'.lock.expire'}>time) {
&log($env{'user.domain'},$env{'user.name'},	&log($env{'user.domain'},$env{'user.name'},
$env{'user.home'},	$env{'user.home'},
'Locked by priv: '.$priv.' for '.$uri.' due to '.	'Locked by priv: '.$priv.' for '.$uri.' due to '.
Line 8344 sub allowed {	Line 8610 sub allowed {
}	}
}	}
}	}

#	#
# Rest of the restrictions depend on selected course	# Rest of the restrictions depend on selected course
#	#
Line 8513 sub constructaccess {	Line 8779 sub constructaccess {
#	#
# User for whom data are being temporarily cached.	# User for whom data are being temporarily cached.
my $cacheduser='';	my $cacheduser='';
	# Course for which data are being temporarily cached.
	my $cachedcid='';
# Cached blockers for this user (a hash of blocking items).	# Cached blockers for this user (a hash of blocking items).
my %cachedblockers=();	my %cachedblockers=();
# When the data were last cached.	# When the data were last cached.
my $cachedlast='';	my $cachedlast='';

sub load_all_blockers {	sub load_all_blockers {
my ($uname,$udom,$blocks)=@_;	my ($uname,$udom)=@_;
if (($uname ne '') && ($udom ne '')) {	if (($uname ne '') && ($udom ne '')) {
if (($cacheduser eq $uname.':'.$udom) &&	if (($cacheduser eq $uname.':'.$udom) &&
	($cachedcid eq $env{'request.course.id'}) &&
(abs($cachedlast-time)<5)) {	(abs($cachedlast-time)<5)) {
return;	return;
}	}
}	}
$cachedlast=time;	$cachedlast=time;
$cacheduser=$uname.':'.$udom;	$cacheduser=$uname.':'.$udom;
%cachedblockers = &get_commblock_resources($blocks);	$cachedcid=$env{'request.course.id'};
	%cachedblockers = &get_commblock_resources();
	return;
}	}

sub get_comm_blocks {	sub get_comm_blocks {
Line 8608 sub get_commblock_resources {	Line 8879 sub get_commblock_resources {
if ($mapsymb) {	if ($mapsymb) {
if (ref($navmap)) {	if (ref($navmap)) {
my $mapres = $navmap->getBySymb($mapsymb);	my $mapres = $navmap->getBySymb($mapsymb);
@to_test = $mapres->retrieveResources($mapres,undef,0,0,0,1);	if (ref($mapres)) {
foreach my $res (@to_test) {	my $first = $mapres->map_start();
my $symb = $res->symb();	my $finish = $mapres->map_finish();
next if ($symb eq $mapsymb);	my $it = $navmap->getIterator($first,$finish,undef,0,0);
if ($symb ne '') {	if (ref($it)) {
@interval=&EXT("resource.0.interval",$symb);	my $res;
if ($interval[1] eq 'map') {	while ($res = $it->next(undef,1)) {
last;	next unless (ref($res));
	my $symb = $res->symb();
	next if (($symb eq $mapsymb) \|\| ($symb eq ''));
	@interval=&EXT("resource.0.interval",$symb);
	if ($interval[1] eq 'map') {
	if ($res->answerable()) {
	push(@to_test,$res);
	last;
	}
	}
}	}
}	}
}	}
Line 8666 sub get_commblock_resources {	Line 8946 sub get_commblock_resources {
}	}

sub has_comm_blocking {	sub has_comm_blocking {
my ($priv,$symb,$uri,$blocks) = @_;	my ($priv,$symb,$uri,$ignoresymbdb,$noenccheck,$blocked,$blocks) = @_;
my @blockers;	my @blockers;
return unless ($env{'request.course.id'});	return unless ($env{'request.course.id'});
return unless ($priv eq 'bre');	return unless ($priv eq 'bre');
return if ($env{'user.priv.'.$env{'request.role'}} =~/evb\&([^\:]*)/);	return if ($env{'user.priv.'.$env{'request.role'}} =~/evb\&([^\:]*)/);
return if ($env{'request.state'} eq 'construct');	return if ($env{'request.state'} eq 'construct');
&load_all_blockers($env{'user.name'},$env{'user.domain'},$blocks);	my %blockinfo;
return unless (keys(%cachedblockers) > 0);	if (ref($blocks) eq 'HASH') {
	%blockinfo = &get_commblock_resources($blocks);
	} else {
	&load_all_blockers($env{'user.name'},$env{'user.domain'});
	%blockinfo = %cachedblockers;
	}
	return unless (keys(%blockinfo) > 0);
my (%possibles,@symbs);	my (%possibles,@symbs);
if (!$symb) {	if (!$symb) {
$symb = &symbread($uri,1,1,1,\%possibles);	$symb = &symbread($uri,1,1,1,\%possibles,$ignoresymbdb,$noenccheck);
}	}
if ($symb) {	if ($symb) {
@symbs = ($symb);	@symbs = ($symb);
Line 8687 sub has_comm_blocking {	Line 8973 sub has_comm_blocking {
foreach my $symb (@symbs) {	foreach my $symb (@symbs) {
last if ($noblock);	last if ($noblock);
my ($map,$resid,$resurl)=&decode_symb($symb);	my ($map,$resid,$resurl)=&decode_symb($symb);
foreach my $block (keys(%cachedblockers)) {	foreach my $block (keys(%blockinfo)) {
if ($block =~ /^firstaccess____(.+)$/) {	if ($block =~ /^firstaccess____(.+)$/) {
my $item = $1;	my $item = $1;
if (($item eq $map) \|\| ($item eq $symb)) {	unless ($blocked) {
$noblock = 1;	if (($item eq $map) \|\| ($item eq $symb)) {
last;	$noblock = 1;
	last;
	}
}	}
}	}
if (ref($cachedblockers{$block}) eq 'HASH') {	if (ref($blockinfo{$block}) eq 'HASH') {
if (ref($cachedblockers{$block}{'resources'}) eq 'HASH') {	if (ref($blockinfo{$block}{'resources'}) eq 'HASH') {
if ($cachedblockers{$block}{'resources'}{$symb}) {	if ($blockinfo{$block}{'resources'}{$symb}) {
unless (grep(/^\Q$block\E$/,@blockers)) {	unless (grep(/^\Q$block\E$/,@blockers)) {
push(@blockers,$block);	push(@blockers,$block);
}	}
}	}
}	}
}	if (ref($blockinfo{$block}{'maps'}) eq 'HASH') {
if (ref($cachedblockers{$block}{'maps'}) eq 'HASH') {	if ($blockinfo{$block}{'maps'}{$map}) {
if ($cachedblockers{$block}{'maps'}{$map}) {	unless (grep(/^\Q$block\E$/,@blockers)) {
unless (grep(/^\Q$block\E$/,@blockers)) {	push(@blockers,$block);
push(@blockers,$block);	}
}	}
}	}
}	}
}	}
}	}
return if ($noblock);	unless ($noblock) {
return @blockers;	return @blockers;
	}
	return;
}	}
}	}

Line 9199 sub auto_validate_instcode {	Line 9489 sub auto_validate_instcode {
return ($outcome,$description,$defaultcredits);	return ($outcome,$description,$defaultcredits);
}	}

	sub auto_validate_inst_crosslist {
	my ($cnum,$cdom,$instcode,$inst_xlist,$coowner) = @_;
	my ($homeserver,$response);
	if (($cdom =~ /^$match_domain$/) && ($cnum =~ /^$match_courseid$/)) {
	$homeserver = &homeserver($cnum,$cdom);
	}
	if (!defined($homeserver)) {
	if ($cdom =~ /^$match_domain$/) {
	$homeserver = &domain($cdom,'primary');
	}
	}
	unless (($homeserver eq '') \|\| ($homeserver eq 'no_host')) {
	$response=&reply('autovalidateinstcrosslist:'.$cdom.':'.
	&escape($instcode).':'.&escape($inst_xlist).':'.
	&escape($coowner),$homeserver);
	}
	return $response;
	}

sub auto_create_password {	sub auto_create_password {
my ($cnum,$cdom,$authparam,$udom) = @_;	my ($cnum,$cdom,$authparam,$udom) = @_;
my ($homeserver,$response);	my ($homeserver,$response);
Line 10020 sub autoupdate_coowners {	Line 10329 sub autoupdate_coowners {
if ($domdesign{$cdom.'.autoassign.co-owners'}) {	if ($domdesign{$cdom.'.autoassign.co-owners'}) {
my %coursehash = &coursedescription($cdom.'_'.$cnum);	my %coursehash = &coursedescription($cdom.'_'.$cnum);
my $instcode = $coursehash{'internal.coursecode'};	my $instcode = $coursehash{'internal.coursecode'};
	my $xlists = $coursehash{'internal.crosslistings'};
if ($instcode ne '') {	if ($instcode ne '') {
if (($start && $start <= $now) && ($end == 0) \|\| ($end > $now)) {	if (($start && $start <= $now) && ($end == 0) \|\| ($end > $now)) {
unless ($coursehash{'internal.courseowner'} eq $uname.':'.$udom) {	unless ($coursehash{'internal.courseowner'} eq $uname.':'.$udom) {
my ($delcoowners,@newcoowners,$putresult,$delresult,$coowners);	my ($delcoowners,@newcoowners,$putresult,$delresult,$coowners);
my ($result,$desc) = &auto_validate_instcode($cnum,$cdom,$instcode,$uname.':'.$udom);	my ($result,$desc) = &auto_validate_instcode($cnum,$cdom,$instcode,$uname.':'.$udom);
	unless ($result eq 'valid') {
	if ($xlists ne '') {
	foreach my $xlist (split(',',$xlists)) {
	my ($inst_crosslist,$lcsec) = split(':',$xlist);
	$result =
	&auto_validate_inst_crosslist($cnum,$cdom,$instcode,
	$inst_crosslist,$uname.':'.$udom);
	last if ($result eq 'valid');
	}
	}
	}
if ($result eq 'valid') {	if ($result eq 'valid') {
if ($coursehash{'internal.co-owners'}) {	if ($coursehash{'internal.co-owners'}) {
foreach my $coowner (split(',',$coursehash{'internal.co-owners'})) {	foreach my $coowner (split(',',$coursehash{'internal.co-owners'})) {
Line 10037 sub autoupdate_coowners {	Line 10358 sub autoupdate_coowners {
} else {	} else {
push(@newcoowners,$uname.':'.$udom);	push(@newcoowners,$uname.':'.$udom);
}	}
} else {	} elsif ($coursehash{'internal.co-owners'}) {
if ($coursehash{'internal.co-owners'}) {	foreach my $coowner (split(',',$coursehash{'internal.co-owners'})) {
foreach my $coowner (split(',',$coursehash{'internal.co-owners'})) {	unless ($coowner eq $uname.':'.$udom) {
unless ($coowner eq $uname.':'.$udom) {	push(@newcoowners,$coowner);
push(@newcoowners,$coowner);
}
}
unless (@newcoowners > 0) {
$delcoowners = 1;
$coowners = '';
}	}
}	}
	unless (@newcoowners > 0) {
	$delcoowners = 1;
	$coowners = '';
	}
}	}
if (@newcoowners \|\| $delcoowners) {	if (@newcoowners \|\| $delcoowners) {
&store_coowners($cdom,$cnum,$coursehash{'home'},	&store_coowners($cdom,$cnum,$coursehash{'home'},
Line 10122 sub modifyuserauth {	Line 10441 sub modifyuserauth {
' in domain '.$env{'request.role.domain'});	' in domain '.$env{'request.role.domain'});
my $reply=&reply('encrypt:changeuserauth:'.$udom.':'.$uname.':'.$umode.':'.	my $reply=&reply('encrypt:changeuserauth:'.$udom.':'.$uname.':'.$umode.':'.
&escape($upass),$uhome);	&escape($upass),$uhome);
	my $ip = &get_requestor_ip();
&log($env{'user.domain'},$env{'user.name'},$env{'user.home'},	&log($env{'user.domain'},$env{'user.name'},$env{'user.home'},
'Authentication changed for '.$udom.', '.$uname.', '.$umode.	'Authentication changed for '.$udom.', '.$uname.', '.$umode.
'(Remote '.$ENV{'REMOTE_ADDR'}.'): '.$reply);	'(Remote '.$ip.'): '.$reply);
&log($udom,,$uname,$uhome,	&log($udom,,$uname,$uhome,
'Authentication changed by '.$env{'user.domain'}.', '.	'Authentication changed by '.$env{'user.domain'}.', '.
$env{'user.name'}.', '.$umode.	$env{'user.name'}.', '.$umode.
'(Remote '.$ENV{'REMOTE_ADDR'}.'): '.$reply);	'(Remote '.$ip.'): '.$reply);
unless ($reply eq 'ok') {	unless ($reply eq 'ok') {
&logthis('Authentication mode error: '.$reply);	&logthis('Authentication mode error: '.$reply);
return 'error: '.$reply;	return 'error: '.$reply;
Line 10457 sub writecoursepref {	Line 10777 sub writecoursepref {

sub createcourse {	sub createcourse {
my ($udom,$description,$url,$course_server,$nonstandard,$inst_code,	my ($udom,$description,$url,$course_server,$nonstandard,$inst_code,
$course_owner,$crstype,$cnum,$context,$category)=@_;	$course_owner,$crstype,$cnum,$context,$category,$callercontext)=@_;
$url=&declutter($url);	$url=&declutter($url);
my $cid='';	my $cid='';
if ($context eq 'requestcourses') {	if ($context eq 'requestcourses') {
my $can_create = 0;	my $can_create = 0;
my ($ownername,$ownerdom) = split(':',$course_owner);	my ($ownername,$ownerdom) = split(':',$course_owner);
if ($udom eq $ownerdom) {	if ($udom eq $ownerdom) {
if (&usertools_access($ownername,$ownerdom,$category,undef,	my $reload;
	if (($callercontext eq 'auto') &&
	($ownerdom eq $env{'user.domain'}) && ($ownername eq $env{'user.name'})) {
	$reload = 'reload';
	}
	if (&usertools_access($ownername,$ownerdom,$category,$reload,
$context)) {	$context)) {
$can_create = 1;	$can_create = 1;
}	}
Line 10649 sub store_userdata {	Line 10974 sub store_userdata {
if (($uhome eq '') \|\| ($uhome eq 'no_host')) {	if (($uhome eq '') \|\| ($uhome eq 'no_host')) {
$result = 'error: no_host';	$result = 'error: no_host';
} else {	} else {
$storehash->{'ip'} = $ENV{'REMOTE_ADDR'};	$storehash->{'ip'} = &get_requestor_ip();
$storehash->{'host'} = $perlvar{'lonHostID'};	$storehash->{'host'} = $perlvar{'lonHostID'};

my $namevalue='';	my $namevalue='';
Line 12196 sub EXT {	Line 12521 sub EXT {
if ($space eq 'name') {	if ($space eq 'name') {
return $ENV{'SERVER_NAME'};	return $ENV{'SERVER_NAME'};
}	}
	} elsif ($realm eq 'client') {
	if ($space eq 'remote_addr') {
	return &get_requestor_ip();
	}
}	}
return '';	return '';
}	}
Line 13024 sub symbverify {	Line 13353 sub symbverify {

if (tie(%bighash,'GDBM_File',$env{'request.course.fn'}.'.db',	if (tie(%bighash,'GDBM_File',$env{'request.course.fn'}.'.db',
&GDBM_READER(),0640)) {	&GDBM_READER(),0640)) {
my $noclutter;
if (($thisurl =~ m{^/adm/wrapper/ext/}) \|\| ($thisurl =~ m{^ext/})) {	if (($thisurl =~ m{^/adm/wrapper/ext/}) \|\| ($thisurl =~ m{^ext/})) {
$thisurl =~ s/\?.+$//;	$thisurl =~ s/\?.+$//;
if ($map =~ m{^uploaded/.+\.page$}) {	if ($map =~ m{^uploaded/.+\.page$}) {
$thisurl =~ s{^(/adm/wrapper\|)/ext/}{http://};	$thisurl =~ s{^(/adm/wrapper\|)/ext/}{http://};
$thisurl =~ s{^\Qhttp://https://\E}{https://};	$thisurl =~ s{^\Qhttp://https://\E}{https://};
$noclutter = 1;
}	}
}	}
my $ids;	my $ids;
if ($noclutter) {	if ($map =~ m{^uploaded/.+\.page$}) {
$ids=$bighash{'ids_'.$thisurl};	$ids=$bighash{'ids_'.&clutter_with_no_wrapper($thisurl)};
} else {	} else {
$ids=$bighash{'ids_'.&clutter($thisurl)};	$ids=$bighash{'ids_'.&clutter($thisurl)};
}	}
Line 13135 sub deversion {	Line 13462 sub deversion {
# ------------------------------------------------------ Return symb list entry	# ------------------------------------------------------ Return symb list entry

sub symbread {	sub symbread {
my ($thisfn,$donotrecurse,$ignorecachednull,$checkforblock,$possibles)=@_;	my ($thisfn,$donotrecurse,$ignorecachednull,$checkforblock,$possibles,
	$ignoresymbdb,$noenccheck)=@_;
my $cache_str='request.symbread.cached.'.$thisfn;	my $cache_str='request.symbread.cached.'.$thisfn;
if (defined($env{$cache_str})) {	if (defined($env{$cache_str})) {
if ($ignorecachednull) {	unless (ref($possibles) eq 'HASH') {
return $env{$cache_str} unless ($env{$cache_str} eq '');	if ($ignorecachednull) {
} else {	return $env{$cache_str} unless ($env{$cache_str} eq '');
return $env{$cache_str};	} else {
	return $env{$cache_str};
	}
}	}
}	}
# no filename provided? try from environment	# no filename provided? try from environment
unless ($thisfn) {	unless ($thisfn) {
if ($env{'request.symb'}) {	if ($env{'request.symb'}) {
return $env{$cache_str}=&symbclean($env{'request.symb'});	return $env{$cache_str}=&symbclean($env{'request.symb'});
}	}
$thisfn=$env{'request.filename'};	$thisfn=$env{'request.filename'};
}	}
Line 13170 sub symbread {	Line 13500 sub symbread {
if ($targetfn =~ m\|^adm/wrapper/(ext/.*)\|) {	if ($targetfn =~ m\|^adm/wrapper/(ext/.*)\|) {
$targetfn=$1;	$targetfn=$1;
}	}
if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',	unless ($ignoresymbdb) {
&GDBM_READER(),0640)) {	if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
$syval=$hash{$targetfn};	&GDBM_READER(),0640)) {
untie(%hash);	$syval=$hash{$targetfn};
	untie(%hash);
	}
	if ($syval && $checkforblock) {
	my @blockers = &has_comm_blocking('bre',$syval,$thisfn,$ignoresymbdb,$noenccheck);
	if (@blockers) {
	$syval='';
	}
	}
}	}
# ---------------------------------------------------------- There was an entry	# ---------------------------------------------------------- There was an entry
if ($syval) {	if ($syval) {
Line 13206 sub symbread {	Line 13544 sub symbread {
$syval=&encode_symb($bighash{'map_id_'.$mapid},	$syval=&encode_symb($bighash{'map_id_'.$mapid},
$resid,$thisfn);	$resid,$thisfn);
if (ref($possibles) eq 'HASH') {	if (ref($possibles) eq 'HASH') {
$possibles->{$syval} = 1;	unless ($bighash{'randomout_'.$ids} \|\| $env{'request.role.adv'}) {
	$possibles->{$syval} = 1;
	}
}	}
if ($checkforblock) {	if ($checkforblock) {
my @blockers = &has_comm_blocking('bre',$syval,$bighash{'src_'.$ids});	unless ($bighash{'randomout_'.$ids} \|\| $env{'request.role.adv'}) {
if (@blockers) {	my @blockers = &has_comm_blocking('bre',$syval,$bighash{'src_'.$ids},'',$noenccheck);
$syval = '';	if (@blockers) {
return;	$syval = '';
	untie(%bighash);
	return $env{$cache_str}='';
	}
}	}
}	}
} elsif ((!$donotrecurse) \|\| ($checkforblock) \|\| (ref($possibles) eq 'HASH')) {	} elsif ((!$donotrecurse) \|\| ($checkforblock) \|\| (ref($possibles) eq 'HASH')) {
Line 13231 sub symbread {	Line 13574 sub symbread {
if ($bighash{'map_type_'.$mapid} ne 'page') {	if ($bighash{'map_type_'.$mapid} ne 'page') {
my $poss_syval=&encode_symb($bighash{'map_id_'.$mapid},	my $poss_syval=&encode_symb($bighash{'map_id_'.$mapid},
$resid,$thisfn);	$resid,$thisfn);
if (ref($possibles) eq 'HASH') {	next if ($bighash{'randomout_'.$id} && !$env{'request.role.adv'});
$possibles->{$syval} = 1;	next unless (($noenccheck) \|\| ($bighash{'encrypted_'.$id} eq $env{'request.enc'}));
}
if ($checkforblock) {	if ($checkforblock) {
my @blockers = &has_comm_blocking('bre',$poss_syval,$file);	my @blockers = &has_comm_blocking('bre',$poss_syval,$file,'',$noenccheck);
unless (@blockers > 0) {	if (@blockers > 0) {
	$syval = '';
	} else {
$syval = $poss_syval;	$syval = $poss_syval;
$realpossible++;	$realpossible++;
}	}
Line 13244 sub symbread {	Line 13588 sub symbread {
$syval = $poss_syval;	$syval = $poss_syval;
$realpossible++;	$realpossible++;
}	}
	if ($syval) {
	if (ref($possibles) eq 'HASH') {
	$possibles->{$syval} = 1;
	}
	}
}	}
}	}
}	}
Line 13983 sub default_login_domain {	Line 14332 sub default_login_domain {
return $domain;	return $domain;
}	}

	sub shared_institution {
	my ($dom,$lonhost) = @_;
	if ($lonhost eq '') {
	$lonhost = $perlvar{'lonHostID'};
	}
	my $same_intdom;
	my $hostintdom = &internet_dom($lonhost);
	if ($hostintdom ne '') {
	my %iphost = &get_iphost();
	my $primary_id = &domain($dom,'primary');
	my $primary_ip = &get_host_ip($primary_id);
	if (ref($iphost{$primary_ip}) eq 'ARRAY') {
	foreach my $id (@{$iphost{$primary_ip}}) {
	my $intdom = &internet_dom($id);
	if ($intdom eq $hostintdom) {
	$same_intdom = 1;
	last;
	}
	}
	}
	}
	return $same_intdom;
	}

sub uses_sts {	sub uses_sts {
my ($ignore_cache) = @_;	my ($ignore_cache) = @_;
my $lonhost = $perlvar{'lonHostID'};	my $lonhost = $perlvar{'lonHostID'};
Line 14021 sub uses_sts {	Line 14394 sub uses_sts {
return;	return;
}	}

	sub waf_allssl {
	my ($host_name) = @_;
	my $alias = &get_proxy_alias();
	if ($host_name eq '') {
	$host_name = $ENV{'SERVER_NAME'};
	}
	if (($host_name ne '') && ($alias eq $host_name)) {
	my $serverhomedom = &host_domain($perlvar{'lonHostID'});
	my %defdomdefaults = &get_domain_defaults($serverhomedom);
	if ($defdomdefaults{'waf_sslopt'}) {
	return $defdomdefaults{'waf_sslopt'};
	}
	}
	return;
	}

	sub get_requestor_ip {
	my ($r,$nolookup,$noproxy) = @_;
	my $from_ip;
	if (ref($r)) {
	if ($r->can('useragent_ip')) {
	if ($noproxy && $r->can('client_ip')) {
	$from_ip = $r->client_ip();
	} else {
	$from_ip = $r->useragent_ip();
	}
	} elsif ($r->connection->can('remote_ip')) {
	$from_ip = $r->connection->remote_ip();
	} else {
	$from_ip = $r->get_remote_host($nolookup);
	}
	} else {
	$from_ip = $ENV{'REMOTE_ADDR'};
	}
	return $from_ip if ($noproxy);
	# Who controls proxy settings for server
	my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
	my $proxyinfo = &get_proxy_settings($dom_in_use);
	if ((ref($proxyinfo) eq 'HASH') && ($from_ip)) {
	if ($proxyinfo->{'vpnint'}) {
	if (&ip_match($from_ip,$proxyinfo->{'vpnint'})) {
	return $from_ip;
	}
	}
	if ($proxyinfo->{'trusted'}) {
	if (&ip_match($from_ip,$proxyinfo->{'trusted'})) {
	my $ipheader = $proxyinfo->{'ipheader'};
	my ($ip,$xfor);
	if (ref($r)) {
	if ($ipheader) {
	$ip = $r->headers_in->{$ipheader};
	}
	$xfor = $r->headers_in->{'X-Forwarded-For'};
	} else {
	if ($ipheader) {
	$ip = $ENV{'HTTP_'.uc($ipheader)};
	}
	$xfor = $ENV{'HTTP_X_FORWARDED_FOR'};
	}
	if (($ip eq '') && ($xfor ne '')) {
	foreach my $poss_ip (reverse(split(/\s,\s/,$xfor))) {
	unless (&ip_match($poss_ip,$proxyinfo->{'trusted'})) {
	$ip = $poss_ip;
	last;
	}
	}
	}
	if ($ip ne '') {
	return $ip;
	}
	}
	}
	}
	return $from_ip;
	}

	sub get_proxy_settings {
	my ($dom_in_use) = @_;
	my %domdefaults = &Apache::lonnet::get_domain_defaults($dom_in_use);
	my $proxyinfo = {
	ipheader => $domdefaults{'waf_ipheader'},
	trusted => $domdefaults{'waf_trusted'},
	vpnint => $domdefaults{'waf_vpnint'},
	vpnext => $domdefaults{'waf_vpnext'},
	sslopt => $domdefaults{'waf_sslopt'},
	};
	return $proxyinfo;
	}

	sub ip_match {
	my ($ip,$pattern_str) = @_;
	$ip=Net::CIDR::cidrvalidate($ip);
	if ($ip) {
	return Net::CIDR::cidrlookup($ip,split(/\s,\s/,$pattern_str));
	}
	return;
	}

	sub get_proxy_alias {
	my ($lonid) = @_;
	if ($lonid eq '') {
	$lonid = $perlvar{'lonHostID'};
	}
	if (!defined(&hostname($lonid))) {
	return;
	}
	if ($lonid ne '') {
	my ($alias,$cached) = &is_cached_new('proxyalias',$lonid);
	if ($cached) {
	return $alias;
	}
	my $dom = &Apache::lonnet::host_domain($lonid);
	if ($dom ne '') {
	my $cachetime = 606024;
	my %domconfig =
	&Apache::lonnet::get_dom('configuration',['wafproxy'],$dom);
	my $alias;
	if (ref($domconfig{'wafproxy'}) eq 'HASH') {
	if (ref($domconfig{'wafproxy'}{'alias'}) eq 'HASH') {
	$alias = $domconfig{'wafproxy'}{'alias'}{$lonid};
	}
	}
	return &do_cache_new('proxyalias',$lonid,$alias,$cachetime);
	}
	}
	return;
	}

	sub use_proxy_alias {
	my ($r,$lonid) = @_;
	my $alias = &get_proxy_alias($lonid);
	if ($alias) {
	my $dom = &host_domain($lonid);
	if ($dom ne '') {
	my $proxyinfo = &get_proxy_settings($dom );
	my ($vpnint,$remote_ip);
	if (ref($proxyinfo) eq 'HASH') {
	$vpnint = $proxyinfo->{'vpnint'};
	if ($vpnint) {
	$remote_ip = &get_requestor_ip($r,1,1);
	}
	}
	unless ($vpnint && &ip_match($remote_ip,$vpnint)) {
	return $alias;
	}
	}
	}
	return;
	}

# ------------------------------------------------------------- Declutters URLs	# ------------------------------------------------------------- Declutters URLs

sub declutter {	sub declutter {
Line 14160 sub get_dns {	Line 14683 sub get_dns {
}	}
while (%alldns) {	while (%alldns) {
my ($dns) = sort { $b cmp $a } keys(%alldns);	my ($dns) = sort { $b cmp $a } keys(%alldns);
my $request=new HTTP::Request('GET',"$alldns{$dns}://$dns$url");	my ($contents,@content);
my $response = &LONCAPA::LWPReq::makerequest('',$request,'',\%perlvar,30,0);	if ($dns eq Sys::Hostname::FQDN::fqdn()) {
delete($alldns{$dns});	my $command = (split('/',$url))[3];
next if ($response->is_error());	my ($dir,$file) = &parse_getdns_url($command,$url);
	delete($alldns{$dns});
	next if (($dir eq '') \|\| ($file eq ''));
	if (open(my $config,'<',"$dir/$file")) {
	@content = <$config>;
	close($config);
	}
	if ($url eq '/adm/dns/loncapaCRL') {
	$contents = join('',@content);
	}
	} else {
	my $request=new HTTP::Request('GET',"$alldns{$dns}://$dns$url");
	my $response = &LONCAPA::LWPReq::makerequest('',$request,'',\%perlvar,30,0);
	delete($alldns{$dns});
	next if ($response->is_error());
	if ($url eq '/adm/dns/loncapaCRL') {
	$contents = $response->content;
	} else {
	@content = split("\n",$response->content);
	}
	}
if ($url eq '/adm/dns/loncapaCRL') {	if ($url eq '/adm/dns/loncapaCRL') {
return &$func($response);	return &$func($contents);
} else {	} else {
my @content = split("\n",$response->content);
unless ($nocache) {	unless ($nocache) {
&do_cache_new('dns',$url,\@content,302460*60);	&do_cache_new('dns',$url,\@content,302460*60);
}	}
Line 14255 sub fetch_crl_pemfile {	Line 14797 sub fetch_crl_pemfile {
}	}

sub save_crl_pem {	sub save_crl_pem {
my ($response) = @_;	my ($content) = @_;
my ($msg,$hadchanges);	my ($msg,$hadchanges);
if (ref($response)) {	if ($content ne '') {
my $now = time;	my $now = time;
my $lonca = $perlvar{'lonCertificateDirectory'}.'/'.$perlvar{'lonnetCertificateAuthority'};	my $lonca = $perlvar{'lonCertificateDirectory'}.'/'.$perlvar{'lonnetCertificateAuthority'};
my $tmpcrl = $tmpdir.'/'.$perlvar{'lonnetCertRevocationList'}.'_'.$now.'.'.$$.'.tmp';	my $tmpcrl = $tmpdir.'/'.$perlvar{'lonnetCertRevocationList'}.'_'.$now.'.'.$$.'.tmp';
if (open(my $fh,'>',"$tmpcrl")) {	if (open(my $fh,'>',"$tmpcrl")) {
print $fh $response->content;	print $fh $content;
close($fh);	close($fh);
if (-e $lonca) {	if (-e $lonca) {
if (open(PIPE,"openssl crl -in $tmpcrl -inform pem -CAfile $lonca -noout 2>&1 \|")) {	if (open(PIPE,"openssl crl -in $tmpcrl -inform pem -CAfile $lonca -noout 2>&1 \|")) {
Line 14323 sub save_crl_pem {	Line 14865 sub save_crl_pem {
return ($msg,$hadchanges);	return ($msg,$hadchanges);
}	}

	sub parse_getdns_url {
	my ($command,$url) = @_;
	my $dir = $perlvar{'lonTabDir'};
	my $file;
	if ($command eq 'hosts') {
	$file = 'dns_hosts.tab';
	} elsif ($command eq 'domain') {
	$file = 'dns_domain.tab';
	} elsif ($command eq 'checksums') {
	my $version = (split('/',$url))[4];
	$file = "dns_checksums/$version.tab",
	} elsif ($command eq 'loncapaCRL') {
	$dir = $perlvar{'lonCertificateDirectory'};
	$file = $perlvar{'lonnetCertRevocationList'};
	}
	return ($dir,$file);
	}

# ------------------------------------------------------------ Read domain file	# ------------------------------------------------------------ Read domain file
{	{
my $loaded;	my $loaded;
Line 14894 BEGIN {	Line 15454 BEGIN {
$deftex = LONCAPA::texengine();	$deftex = LONCAPA::texengine();
}	}

	# ------------- set default minimum length for passwords for internal auth users
	{
	$passwdmin = LONCAPA::passwd_min();
	}

$memcache=new Cache::Memcached({'servers' => ['127.0.0.1:11211'],	$memcache=new Cache::Memcached({'servers' => ['127.0.0.1:11211'],
'compress_threshold'=> 20_000,	'compress_threshold'=> 20_000,
});	});

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

Removed from v.1.1409
changed lines
	Added in v.1.1458