version 1.1449, 2021/04/29 17:45:23
|
version 1.1453, 2021/05/10 18:13:50
|
Line 976 sub userload {
|
Line 976 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 1021 sub spareserver {
|
Line 1021 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 2851 sub retrieve_instcodes {
|
Line 2853 sub retrieve_instcodes {
|
} |
} |
|
|
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 2861 sub course_portal_url {
|
Line 2863 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 8238 sub allowed {
|
Line 8242 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 8251 sub allowed {
|
Line 8255 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 8529 sub allowed {
|
Line 8533 sub allowed {
|
# 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 |
|
|
my $envkey; |
|
if ($thisallowed=~/L/) { |
if ($thisallowed=~/L/) { |
foreach $envkey (keys(%env)) { |
my $now = time; |
|
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 14453 sub ip_match {
|
Line 14461 sub ip_match {
|
} |
} |
|
|
sub get_proxy_alias { |
sub get_proxy_alias { |
my $lonhost = $perlvar{'lonHostID'}; |
my ($lonid) = @_; |
if ($lonhost ne '') { |
if ($lonid eq '') { |
my ($alias,$cached) = &is_cached_new('proxyalias',$lonhost); |
$lonid = $perlvar{'lonHostID'}; |
|
} |
|
if (!defined(&hostname($lonid))) { |
|
return; |
|
} |
|
if ($lonid ne '') { |
|
my ($alias,$cached) = &is_cached_new('proxyalias',$lonid); |
if ($cached) { |
if ($cached) { |
return $alias; |
return $alias; |
} |
} |
my $dom = &Apache::lonnet::host_domain($lonhost); |
my $dom = &Apache::lonnet::host_domain($lonid); |
if ($dom ne '') { |
if ($dom ne '') { |
my $cachetime = 60*60*24; |
my $cachetime = 60*60*24; |
my %domconfig = |
my %domconfig = |
Line 14467 sub get_proxy_alias {
|
Line 14481 sub get_proxy_alias {
|
my $alias; |
my $alias; |
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'}{$lonhost}; |
$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); |
} |
} |
} |
} |
return &do_cache_new('proxyalias',$lonhost,$alias,$cachetime); |
unless ($vpnint && &ip_match($remote_ip,$vpnint)) { |
|
return $alias; |
|
} |
} |
} |
} |
} |
return; |
return; |