[LON-CAPA-cvs] cvs: loncom /auth lonacc.pm lonauth.pm lonshibauth.pm migrateuser.pm switchserver.pm /interface lonexttool.pm lonrequestcourse.pm lonsyllabus.pm resetpw.pm selfenroll.pm /lonnet/perl lonnet.pm

raeburn raeburn at source.lon-capa.org
Tue May 4 14:47:38 EDT 2021


raeburn		Tue May  4 18:47:38 2021 EDT

  Modified files:              
    /loncom/interface	lonexttool.pm lonrequestcourse.pm lonsyllabus.pm 
                     	resetpw.pm selfenroll.pm 
    /loncom/auth	lonacc.pm lonauth.pm lonshibauth.pm migrateuser.pm 
                	switchserver.pm 
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - Bug 6914.
    Replace hostname with alias when creating absolute URLs, if alias in use.
  
  
-------------- next part --------------
Index: loncom/interface/lonexttool.pm
diff -u loncom/interface/lonexttool.pm:1.20 loncom/interface/lonexttool.pm:1.21
--- loncom/interface/lonexttool.pm:1.20	Tue Aug 14 18:20:17 2018
+++ loncom/interface/lonexttool.pm	Tue May  4 18:47:36 2021
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Launch External Tool Provider (LTI)
 #
-# $Id: lonexttool.pm,v 1.20 2018/08/14 18:20:17 raeburn Exp $
+# $Id: lonexttool.pm,v 1.21 2021/05/04 18:47:36 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -312,7 +312,7 @@
     my $domdesc = &Apache::lonnet::domain($cdom);
     my $primary_id = &Apache::lonnet::domain($cdom,'primary');
     my $int_dom = &Apache::lonnet::internet_dom($primary_id);
-    my $portal_url = &Apache::lonnet::course_portal_url($cnum,$cdom);
+    my $portal_url = &Apache::lonnet::course_portal_url($cnum,$cdom,$r);
 
     my %ltiparams = (
         lti_version                            => $version,
Index: loncom/interface/lonrequestcourse.pm
diff -u loncom/interface/lonrequestcourse.pm:1.110 loncom/interface/lonrequestcourse.pm:1.111
--- loncom/interface/lonrequestcourse.pm:1.110	Sat Mar  6 13:44:51 2021
+++ loncom/interface/lonrequestcourse.pm	Tue May  4 18:47:36 2021
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Request a course
 #
-# $Id: lonrequestcourse.pm,v 1.110 2021/03/06 13:44:51 raeburn Exp $
+# $Id: lonrequestcourse.pm,v 1.111 2021/05/04 18:47:36 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -4066,7 +4066,7 @@
             } elsif ($disposition eq 'pending') {
                 my $pendingform;
                 if ($crstype ne 'official') {
-                    $pendingform = &pending_validation_form($dom,$cnum,$crstype,$now,$token,
+                    $pendingform = &pending_validation_form($r,$dom,$cnum,$crstype,$now,$token,
                                                             $lonhost,$env{'form.cdescr'});
                 }
                 if ($pendingform) {
@@ -4384,7 +4384,7 @@
 }
 
 sub pending_validation_form {
-    my ($cdom,$cnum,$crstype,$now,$token,$lonhost,$cdesc) = @_;
+    my ($r,$cdom,$cnum,$crstype,$now,$token,$lonhost,$cdesc) = @_;
     my $output;
     my %postvalues = (
                       'owner'      => $env{'user.name'}.':'.$env{'user.domain'},
@@ -4420,6 +4420,8 @@
                 my $hostname = &Apache::lonnet::hostname($lonhost);
                 my $protocol = $Apache::lonnet::protocol{$lonhost};
                 $protocol = 'http' if ($protocol ne 'https');
+                my $alias = &Apache::lonnet::use_proxy_alias($r,$lonhost);
+                $hostname = $alias if ($alias ne '');
                 my $crscreator = $protocol.'://'.$hostname.'/cgi-bin/createpending.pl';
                 $output .= '<input type="hidden" name="crscreator" value="'.$crscreator.'" />'."\n".
                            '<input type="hidden" name="token" value="'.$token.'" />'."\n".
Index: loncom/interface/lonsyllabus.pm
diff -u loncom/interface/lonsyllabus.pm:1.149 loncom/interface/lonsyllabus.pm:1.150
--- loncom/interface/lonsyllabus.pm:1.149	Thu Apr 29 17:45:22 2021
+++ loncom/interface/lonsyllabus.pm	Tue May  4 18:47:36 2021
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Syllabus
 #
-# $Id: lonsyllabus.pm,v 1.149 2021/04/29 17:45:22 raeburn Exp $
+# $Id: lonsyllabus.pm,v 1.150 2021/05/04 18:47:36 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -317,6 +317,8 @@
             my $hostname = &Apache::lonnet::hostname($homeserver);
             my $protocol = $Apache::lonnet::protocol{$homeserver};
             $protocol = 'http' if ($protocol ne 'https');
+            my $alias = &Apache::lonnet::use_proxy_alias($r,$homeserver);
+            $hostname = $alias if ($alias ne '');
             my $link = $protocol.'://'.$hostname.$r->uri;
             $r->print('<div class="LC_left_float">'
                      .'<span class="LC_help_open_topic LC_info">'
@@ -326,7 +328,7 @@
                      .'</span>'
                      .'</div><div style="padding:0;clear:both;margin:0;border:0"></div>'."\n");
             my $lonhost = $r->dir_config('lonHostID');
-            $r->print(&chooser($external,$uploaded,$minimal,$cdom,$cnum,$lonhost,
+            $r->print(&chooser($r,$external,$uploaded,$minimal,$cdom,$cnum,$lonhost,
                                \%syllabusfields,\%syllabus));
         }
     } else {
@@ -789,7 +791,7 @@
 }
 
 sub chooser {
-    my ($external,$uploaded,$minimal,$cdom,$cnum,$lonhost,$fields,$values) = @_;
+    my ($r,$external,$uploaded,$minimal,$cdom,$cnum,$lonhost,$fields,$values) = @_;
     my %lt = &Apache::lonlocal::texthash(
                  'type'          => 'Syllabus Type',
                  'url'           => 'External URL',
@@ -854,7 +856,7 @@
                '<div id="minimal" class="LC_left_float" style="display: '.$display{'minimal'}.'">'."\n".
                '<fieldset><legend>'.$lt{'minimal'}.'</legend>';
     if ($minimal) {
-        my ($absurl,$filename,$depbutton) = &syllabus_file_info($minimal,$cnum,$cdom,$lonhost,'minimal');
+        my ($absurl,$filename,$depbutton) = &syllabus_file_info($r,$minimal,$cnum,$cdom,$lonhost,'minimal');
         $output .= '<a href="javascript:extUrlPreview('."'currminimal'".');">'.$lt{'pr'}.'</a>'.
                    '<input type="hidden" name="minimalfile" value="'.&HTML::Entities::encode($absurl).'?inhibitmenu=yes" id="currminimal" />'.
                    $depbutton;
@@ -867,7 +869,7 @@
                '<div id="file" class="LC_left_float" style="display: '.$display{'file'}.'">'."\n".
                '<fieldset><legend>'.$lt{'file'}.'</legend>';
     if ($uploaded) {
-        my ($absurl,$filename,$depbutton) = &syllabus_file_info($uploaded,$cnum,$cdom,$lonhost,'file');
+        my ($absurl,$filename,$depbutton) = &syllabus_file_info($r,$uploaded,$cnum,$cdom,$lonhost,'file');
         $output .= '<span class="LC_nobreak">'.$lt{'curr'}.' '.
                    '<input type="hidden" name="uploadedfile" value="'.&HTML::Entities::encode($absurl).'?inhibitmenu=yes" id="currfile" />'.
                    '<a href="javascript:extUrlPreview('."'currfile'".');">'.$filename.'</a></span>'.$depbutton.
@@ -902,10 +904,12 @@
 }
 
 sub syllabus_file_info {
-    my ($item,$cnum,$cdom,$lonhost,$context) = @_;
+    my ($r,$item,$cnum,$cdom,$lonhost,$context) = @_;
     my $hostname = &Apache::lonnet::hostname($lonhost);
     my $protocol = $Apache::lonnet::protocol{$lonhost};
     $protocol = 'http' if ($protocol ne 'https');
+    my $alias = &Apache::lonnet::use_proxy_alias($r,$lonhost);
+    $hostname = $alias if ($alias ne '');
     my $absurl = $protocol.'://'.$hostname.$item;
     my ($filename) = ($item =~ m{([^/]+)$});
     my $file=&Apache::lonnet::filelocation("",$item);
Index: loncom/interface/resetpw.pm
diff -u loncom/interface/resetpw.pm:1.48 loncom/interface/resetpw.pm:1.49
--- loncom/interface/resetpw.pm:1.48	Fri Dec 18 15:23:02 2020
+++ loncom/interface/resetpw.pm	Tue May  4 18:47:36 2021
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Allow access to password changing via a token sent to user's e-mail. 
 #
-# $Id: resetpw.pm,v 1.48 2020/12/18 15:23:02 raeburn Exp $
+# $Id: resetpw.pm,v 1.49 2021/05/04 18:47:36 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -300,7 +300,7 @@
             $output = &invalid_state('baddomain',$domdesc,
                                      $contact_name,$contact_email); 
         } elsif ($otherinst) {
-            ($header,$output) = &homeserver_redirect($uname,$udom,$domdesc,$brcrum);
+            ($header,$output) = &homeserver_redirect($r,$uname,$udom,$domdesc,$brcrum);
         } elsif (($uname) || ($useremail)) {
             my $earlyout;
             unless ($passwdconf{'captcha'} eq 'unused') {
@@ -579,7 +579,7 @@
 }
 
 sub homeserver_redirect {
-    my ($uname,$udom,$domdesc,$brcrum) = @_;
+    my ($r,$uname,$udom,$domdesc,$brcrum) = @_;
     my $uhome;
     if (($uname ne '') && ($udom ne '')) {
         $uhome = &Apache::lonnet::homeserver($uname,$udom);
@@ -590,6 +590,8 @@
     my $hostname = &Apache::lonnet::hostname($uhome);
     my $protocol = $Apache::lonnet::protocol{$uhome};
     $protocol = 'http' if ($protocol ne 'https');
+    my $alias = &Apache::lonnet::use_proxy_alias($r,$uhome);
+    $hostname = $alias if ($alias ne '');
     my $url = $protocol.'://'.$hostname.'/adm/resetpw';
     # Breadcrumbs
     my $start_page = &Apache::loncommon::start_page('Switching Server',undef,
@@ -755,6 +757,8 @@
                         my $hostname = &Apache::lonnet::hostname($homeserver);
                         my $protocol = $Apache::lonnet::protocol{$homeserver};
                         $protocol = 'http' if ($protocol ne 'https');
+                        my $alias = &Apache::lonnet::use_proxy_alias($r,$homeserver);
+                        $hostname = $alias if ($alias ne '');
                         my $url = $protocol.'://'.$hostname.'/adm/resetpw';
                         my ($opentag,$closetag);
                         if ($url) {
Index: loncom/interface/selfenroll.pm
diff -u loncom/interface/selfenroll.pm:1.35 loncom/interface/selfenroll.pm:1.36
--- loncom/interface/selfenroll.pm:1.35	Thu Dec 27 18:14:25 2018
+++ loncom/interface/selfenroll.pm	Tue May  4 18:47:36 2021
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Allow users to self-enroll in a course
 #
-# $Id: selfenroll.pm,v 1.35 2018/12/27 18:14:25 raeburn Exp $
+# $Id: selfenroll.pm,v 1.36 2021/05/04 18:47:36 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -455,7 +455,7 @@
         }
         if ($selfenroll_approval) {
             my $outcome = 
-                &store_selfenroll_request($udom,$uname,$usec,$cdom,$cnum,
+                &store_selfenroll_request($r,$udom,$uname,$usec,$cdom,$cnum,
                                           $selfenroll_notifylist,$owner,
                                           $selfenroll_approval,$crstype,$lonhost,$handle);
             $r->print($outcome);
@@ -535,7 +535,7 @@
 }
 
 sub store_selfenroll_request {
-    my ($udom,$uname,$usec,$cdom,$cnum,$selfenroll_notifylist,$owner,
+    my ($r,$udom,$uname,$usec,$cdom,$cnum,$selfenroll_notifylist,$owner,
         $selfenroll_approval,$crstype,$lonhost,$handle) = @_;
     my $namespace = 'selfenrollrequests';
     my $output;
@@ -551,7 +551,7 @@
         }
         if ($status eq 'pending') {
             my $token = $info{$cdom.'_'.$cnum}{'token'};
-            my ($statusupdate,$pendingform) = &pending_selfenrollment_form($cdom,$cnum,$crstype,$token,$lonhost);
+            my ($statusupdate,$pendingform) = &pending_selfenrollment_form($r,$cdom,$cnum,$crstype,$token,$lonhost);
             if ($statusupdate eq 'pending') {
                 $output .= $pendingform;
             }
@@ -589,7 +589,7 @@
             }
             $output = &mt('Your request for self-enrollment has been recorded.').'<br />';
             if ($status eq 'pending') {
-                my ($statusupdate,$pendingform) = &pending_selfenrollment_form($cdom,$cnum,$crstype,$token,$lonhost);
+                my ($statusupdate,$pendingform) = &pending_selfenrollment_form($r,$cdom,$cnum,$crstype,$token,$lonhost);
                 if ($statusupdate eq 'request') {
                     $status = $statusupdate;
                 } else {
@@ -630,7 +630,7 @@
 }
 
 sub pending_selfenrollment_form {
-    my ($cdom,$cnum,$crstype,$token,$lonhost) = @_;
+    my ($r,$cdom,$cnum,$crstype,$token,$lonhost) = @_;
     my ($status,$output);
     my $coursetype = &Apache::lonuserutils::get_extended_type($cdom,$cnum,$crstype);
     my %postvalues = (
@@ -667,6 +667,8 @@
                 my $hostname = &Apache::lonnet::hostname($lonhost);
                 my $protocol = $Apache::lonnet::protocol{$lonhost};
                 $protocol = 'http' if ($protocol ne 'https');
+                my $alias = &Apache::lonnet::use_proxy_alias($r,$lonhost);
+                $hostname = $alias if ($alias ne '');
                 my $enroller = $protocol.'://'.$hostname.'/cgi-bin/enrollqueued.pl';
                 $output .= '<input type="hidden" name="enroller" value="'.$enroller.'" />'."\n".
                            '<input type="hidden" name="token" value="'.$token.'" />'."\n".
Index: loncom/auth/lonacc.pm
diff -u loncom/auth/lonacc.pm:1.189 loncom/auth/lonacc.pm:1.190
--- loncom/auth/lonacc.pm:1.189	Sun Apr 18 02:08:46 2021
+++ loncom/auth/lonacc.pm	Tue May  4 18:47:37 2021
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Cookie Based Access Handler
 #
-# $Id: lonacc.pm,v 1.189 2021/04/18 02:08:46 raeburn Exp $
+# $Id: lonacc.pm,v 1.190 2021/05/04 18:47:37 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -349,7 +349,7 @@
                     my $lowest_load;
                     ($otherserver,undef,undef,undef,$lowest_load) = &Apache::lonnet::choose_server($domain);
                     if ($lowest_load > 100) {
-                        $otherserver = &Apache::lonnet::spareserver($lowest_load,$lowest_load,1,$domain);
+                        $otherserver = &Apache::lonnet::spareserver($r,$lowest_load,$lowest_load,1,$domain);
                     }
                     if ($otherserver ne '') {
                         my @hosts = &Apache::lonnet::current_machine_ids();
Index: loncom/auth/lonauth.pm
diff -u loncom/auth/lonauth.pm:1.162 loncom/auth/lonauth.pm:1.163
--- loncom/auth/lonauth.pm:1.162	Fri Dec 18 15:23:03 2020
+++ loncom/auth/lonauth.pm	Tue May  4 18:47:37 2021
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # User Authentication Module
 #
-# $Id: lonauth.pm,v 1.162 2020/12/18 15:23:03 raeburn Exp $
+# $Id: lonauth.pm,v 1.163 2021/05/04 18:47:37 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -656,7 +656,7 @@
                 my $lowest_load;
                 ($otherserver,undef,undef,undef,$lowest_load) = &Apache::lonnet::choose_server($form{'udom'});
                 if ($lowest_load > 100) {
-                    $otherserver = &Apache::lonnet::spareserver($lowest_load,$lowest_load,1,$form{'udom'});
+                    $otherserver = &Apache::lonnet::spareserver($r,$lowest_load,$lowest_load,1,$form{'udom'});
                 }
             }
             if ($otherserver ne '') {
@@ -746,7 +746,7 @@
 
 # ---------------------------------------------------------- Are we overloaded?
         if ((($userloadpercent>100.0)||($loadpercent>100.0))) {
-            my $unloaded=Apache::lonnet::spareserver($loadpercent,$userloadpercent,1,$form{'udom'});
+            my $unloaded=Apache::lonnet::spareserver($r,$loadpercent,$userloadpercent,1,$form{'udom'});
             if (!$unloaded) {
                 ($unloaded) = &Apache::lonnet::choose_server($form{'udom'});
             }
@@ -830,6 +830,8 @@
             if ($login_host ne '') {
                 my $protocol = $Apache::lonnet::protocol{$login_host};
                 $protocol = 'http' if ($protocol ne 'https');
+                my $alias = &Apache::lonnet::use_proxy_alias($r,$login_host);
+                $hostname = $alias if ($alias ne '');
                 my $newurl = $protocol.'://'.$hostname.'/adm/createaccount';
 #FIXME Should preserve where user was going and linkprot by setting ltoken at $login_host
                 $r->print(&Apache::loncommon::start_page('Create a user account in LON-CAPA').
Index: loncom/auth/lonshibauth.pm
diff -u loncom/auth/lonshibauth.pm:1.3 loncom/auth/lonshibauth.pm:1.4
--- loncom/auth/lonshibauth.pm:1.3	Sun May 17 17:34:43 2015
+++ loncom/auth/lonshibauth.pm	Tue May  4 18:47:37 2021
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Redirect Shibboleth authentication to designated URL (/adm/sso).
 #
-# $Id: lonshibauth.pm,v 1.3 2015/05/17 17:34:43 raeburn Exp $
+# $Id: lonshibauth.pm,v 1.4 2021/05/04 18:47:37 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -80,6 +80,8 @@
         if (!$hostname) { $hostname = $r->hostname(); }
         my $protocol = $Apache::lonnet::protocol{$lonhost};
         unless ($protocol eq 'https') { $protocol = 'http'; }
+        my $alias = &Apache::lonnet::use_proxy_alias($r,$lonhost);
+        $hostname = $alias if ($alias ne '');
         my $dest = $protocol.'://'.$hostname.$target;
         $r->subprocess_env;
         if ($ENV{'QUERY_STRING'} ne '') {
Index: loncom/auth/migrateuser.pm
diff -u loncom/auth/migrateuser.pm:1.49 loncom/auth/migrateuser.pm:1.50
--- loncom/auth/migrateuser.pm:1.49	Fri Dec 18 15:23:03 2020
+++ loncom/auth/migrateuser.pm	Tue May  4 18:47:37 2021
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Starts a user off based of an existing token.
 #
-# $Id: migrateuser.pm,v 1.49 2020/12/18 15:23:03 raeburn Exp $
+# $Id: migrateuser.pm,v 1.50 2021/05/04 18:47:37 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -30,7 +30,7 @@
 
 use strict;
 use LONCAPA qw(:DEFAULT :match);
-use Apache::Constants qw(:common :http :methods);
+use Apache::Constants qw(:common :http :methods :remotehost);
 use Apache::lonauth;
 use Apache::lonnet;
 use Apache::loncommon;
@@ -253,6 +253,8 @@
                 if ($hostname) {
                     my $protocol = $Apache::lonnet::protocol{$switchto};
                     $protocol = 'http' if ($protocol ne 'https');
+                    my $alias = &Apache::lonnet::use_proxy_alias($r,$switchto);
+                    $hostname = $alias if ($alias ne '');
                     $url = $protocol.'://'.$hostname;
                     if ($rule_in_effect eq 'balancer') {
                         $message .= '<br />'.
@@ -308,7 +310,7 @@
 }
 
 sub logout {
-    my ($r,$handle,$data,$lti_env) = @_;
+    my ($r,$ip,$handle,$data,$lti_env) = @_;
     my $lonidsdir=$r->dir_config('lonIDsDir');
     if (unlink("$lonidsdir/$handle.id")) {
         if (($env{'user.linkedenv'} =~ /^[a-f0-9]+_linked$/) &&
@@ -319,7 +321,6 @@
     }
     my %temp=('logout' => time);
     &Apache::lonnet::put('email_status',\%temp);
-    my $ip = &Apache::lonnet::get_requestor_ip();
     &Apache::lonnet::log($env{'user.domain'},
                          $env{'user.name'},
                          $env{'user.home'},
@@ -588,7 +589,7 @@
     }
     my ($home, at ids);
     @ids=&Apache::lonnet::current_machine_ids();
-    my $ip = &Apache::lonnet::get_requestor_ip(); 
+    my $ip = &Apache::lonnet::get_requestor_ip($r,REMOTE_NOLOOKUP); 
     if ($data{'ip'} ne $ip) {
         &Apache::lonnet::logthis('IP change when session migration requested -- was: '.
                  $data{'ip'}.'; now: '.$ip.' for '.$data{'username'}.':'.$data{'domain'});
@@ -772,7 +773,7 @@
 # (and session) or has an LTI session cookie for a different username,
 # logout the existing session, and start a new one
                 if ($needslogout) {
-                    &logout($r,$handle,\%data,$lti_env);
+                    &logout($r,$ip,$handle,\%data,$lti_env);
                 } elsif (($data{'lti.reqcrs'}) && ($data{'lti.reqrole'} eq 'cc')) {
                     $form{'lti.reqcrs'} = $data{'lti.reqcrs'};
                     $form{'lti.reqrole'} = $data{'lti.reqrole'};
@@ -918,7 +919,7 @@
                 $needslogout = 1;
             }
             if ($needslogout) {
-                &logout($r,$handle,\%data,$lti_env);
+                &logout($r,$ip,$handle,\%data,$lti_env);
                 return OK;
             }
         }
Index: loncom/auth/switchserver.pm
diff -u loncom/auth/switchserver.pm:1.54 loncom/auth/switchserver.pm:1.55
--- loncom/auth/switchserver.pm:1.54	Mon May  3 15:27:43 2021
+++ loncom/auth/switchserver.pm	Tue May  4 18:47:37 2021
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Switch Servers Handler
 #
-# $Id: switchserver.pm,v 1.54 2021/05/03 15:27:43 raeburn Exp $
+# $Id: switchserver.pm,v 1.55 2021/05/04 18:47:37 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -29,7 +29,7 @@
 package Apache::switchserver;
 
 use strict;
-use Apache::Constants qw(:common);
+use Apache::Constants qw(:common :remotehost);
 use Apache::lonnet;
 use Digest::MD5 qw(md5_hex);
 use CGI::Cookie();
@@ -111,7 +111,7 @@
 						   $env{'user.name'});
 	if (! $env{'form.otherserver'}) {
 	    $env{'form.otherserver'} = 
-		&Apache::lonnet::spareserver(30000,undef,1);
+		&Apache::lonnet::spareserver($r,30000,undef,1);
 	}
 	$switch_to=&Apache::lonnet::hostname($env{'form.otherserver'});
     }
@@ -215,7 +215,7 @@
     } else {
         $logmsg .= " (no role)";
     }
-    my $ip = &Apache::lonnet::get_requestor_ip();
+    my $ip = &Apache::lonnet::get_requestor_ip($r,REMOTE_NOLOOKUP);
     $logmsg .= ' '.$ip;
     &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},
 			 $env{'user.home'},$logmsg);
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1450 loncom/lonnet/perl/lonnet.pm:1.1451
--- loncom/lonnet/perl/lonnet.pm:1.1450	Mon May  3 15:27:45 2021
+++ loncom/lonnet/perl/lonnet.pm	Tue May  4 18:47:38 2021
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1450 2021/05/03 15:27:45 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 @@
 # ------------------------------ 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 @@
                 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 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 @@
     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;


More information about the LON-CAPA-cvs mailing list