--- loncom/lonnet/perl/lonnet.pm	2021/04/18 02:08:47	1.1447
+++ 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.1447 2021/04/18 02:08:47 raeburn Exp $
+# $Id: lonnet.pm,v 1.1453 2021/05/10 18:13:50 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -740,6 +740,9 @@ sub check_for_valid_session {
     if (ref($userhashref) eq 'HASH') {
         $userhashref->{'name'} = $disk_env{'user.name'};
         $userhashref->{'domain'} = $disk_env{'user.domain'};
+        if ($disk_env{'request.role'}) {
+            $userhashref->{'role'} = $disk_env{'request.role'};
+        }
         $userhashref->{'lti'} = $disk_env{'request.lti.login'};
         if ($userhashref->{'lti'}) {
             $userhashref->{'ltitarget'} = $disk_env{'request.lti.target'};
@@ -973,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 
@@ -1018,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;
             }
         }
@@ -2778,7 +2783,7 @@ sub get_domain_defaults {
         }
     }
     if (ref($domconfig{'wafproxy'}) eq 'HASH') {
-        foreach my $item ('ipheader','trusted','vpnint','vpnext') {
+        foreach my $item ('ipheader','trusted','vpnint','vpnext','sslopt') {
             if ($domconfig{'wafproxy'}{$item}) {
                 $domdefaults{'waf_'.$item} = $domconfig{'wafproxy'}{$item};
             }
@@ -2848,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};
@@ -2858,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;
@@ -8235,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;
                                 }
@@ -8248,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;
                                 }
@@ -8526,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;
@@ -14351,6 +14362,22 @@ sub uses_sts {
     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;
@@ -14419,6 +14446,7 @@ sub get_proxy_settings {
                        trusted  => $domdefaults{'waf_trusted'},
                        vpnint   => $domdefaults{'waf_vpnint'},
                        vpnext   => $domdefaults{'waf_vpnext'},
+                       sslopt   => $domdefaults{'waf_sslopt'},
                     };
     return $proxyinfo;
 }
@@ -14433,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 =
@@ -14447,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',$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;