--- loncom/lonnet/perl/lonnet.pm	2021/04/29 17:45:23	1.1449
+++ loncom/lonnet/perl/lonnet.pm	2021/05/10 18:13:50	1.1453
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1449 2021/04/29 17:45:23 raeburn Exp $
+# $Id: lonnet.pm,v 1.1453 2021/05/10 18:13:50 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -976,7 +976,7 @@ sub userload {
 # ------------------------------ Find server with least workload from spare.tab
 
 sub spareserver {
-    my ($loadpercent,$userloadpercent,$want_server_name,$udom) = @_;
+    my ($r,$loadpercent,$userloadpercent,$want_server_name,$udom) = @_;
     my $spare_server;
     if ($userloadpercent !~ /\d/) { $userloadpercent=0; }
     my $lowest_load=($loadpercent > $userloadpercent) ? $loadpercent 
@@ -1021,6 +1021,8 @@ sub spareserver {
                 if ($protocol{$spare_server} eq 'https') {
                     $protocol = $protocol{$spare_server};
                 }
+                my $alias = &Apache::lonnet::use_proxy_alias($r,$spare_server);
+                $hostname = $alias if ($alias ne '');
 	        $spare_server = $protocol.'://'.$hostname;
             }
         }
@@ -2851,7 +2853,7 @@ sub retrieve_instcodes {
 }
 
 sub course_portal_url {
-    my ($cnum,$cdom) = @_;
+    my ($cnum,$cdom,$r) = @_;
     my $chome = &homeserver($cnum,$cdom);
     my $hostname = &hostname($chome);
     my $protocol = $protocol{$chome};
@@ -2861,6 +2863,8 @@ sub course_portal_url {
     if ($domdefaults{'portal_def'}) {
         $firsturl = $domdefaults{'portal_def'};
     } else {
+        my $alias = &Apache::lonnet::use_proxy_alias($r,$chome);
+        $hostname = $alias if ($alias ne '');
         $firsturl = $protocol.'://'.$hostname;
     }
     return $firsturl;
@@ -8238,8 +8242,8 @@ sub allowed {
                         my $adom = $1;
                         foreach my $key (keys(%env)) {
                             if ($key =~ m{^user\.role\.(ca|aa)/\Q$adom\E}) {
-                                my ($start,$end) = split('.',$env{$key});
-                                if (($now >= $start) && (!$end || $end < $now)) {
+                                my ($start,$end) = split(/\./,$env{$key});
+                                if (($now >= $start) && (!$end || $end > $now)) {
                                     $ownaccess = 1;
                                     last;
                                 }
@@ -8251,8 +8255,8 @@ sub allowed {
                         foreach my $role ('ca','aa') { 
                             if ($env{"user.role.$role./$adom/$aname"}) {
                                 my ($start,$end) =
-                                    split('.',$env{"user.role.$role./$adom/$aname"});
-                                if (($now >= $start) && (!$end || $end < $now)) {
+                                    split(/\./,$env{"user.role.$role./$adom/$aname"});
+                                if (($now >= $start) && (!$end || $end > $now)) {
                                     $ownaccess = 1;
                                     last;
                                 }
@@ -8529,13 +8533,17 @@ sub allowed {
 # Locks might take effect only after 10 minutes cache expiration for other
 # courses, and 2 minutes for current course
 
-    my $envkey;
     if ($thisallowed=~/L/) {
-        foreach $envkey (keys(%env)) {
+        my $now = time;
+        foreach my $envkey (keys(%env)) {
            if ($envkey=~/^user\.role\.(st|ta)\.([^\.]*)/) {
                my $courseid=$2;
                my $roleid=$1.'.'.$2;
                $courseid=~s/^\///;
+               unless ($env{'request.role'} eq $roleid) {
+                   my ($start,$end) = split(/\./,$env{$envkey});
+                   next unless (($now >= $start) && (!$end || $end > $now));
+               }
                my $expiretime=600;
                if ($env{'request.role'} eq $roleid) {
 		  $expiretime=120;
@@ -14453,13 +14461,19 @@ sub ip_match {
 }
 
 sub get_proxy_alias {
-    my $lonhost = $perlvar{'lonHostID'};
-    if ($lonhost ne '') {
-        my ($alias,$cached) = &is_cached_new('proxyalias',$lonhost);
+    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($lonhost);
+        my $dom = &Apache::lonnet::host_domain($lonid);
         if ($dom ne '') {
             my $cachetime = 60*60*24;
             my %domconfig =
@@ -14467,10 +14481,32 @@ sub get_proxy_alias {
             my $alias;
             if (ref($domconfig{'wafproxy'}) eq 'HASH') {
                 if (ref($domconfig{'wafproxy'}{'alias'}) eq 'HASH') {
-                    $alias = $domconfig{'wafproxy'}{'alias'}{$lonhost};
+                    $alias = $domconfig{'wafproxy'}{'alias'}{$lonid};
                 }
             }
-            return &do_cache_new('proxyalias',$lonhost,$alias,$cachetime);
+            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;