--- loncom/lonnet/perl/lonnet.pm 2021/04/29 17:45:23 1.1449 +++ loncom/lonnet/perl/lonnet.pm 2021/05/04 18:47:38 1.1451 @@ -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.1451 2021/05/04 18:47:38 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; @@ -14453,13 +14457,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 +14477,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;