[LON-CAPA-cvs] cvs: loncom(version_2_11_X) /lonnet/perl lonnet.pm

[raeburn]

raeburn		Mon Jan  4 03:55:51 2021 EDT

  Modified files:              (Branch: version_2_11_X)
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - For 2.11
    Backport 1.1434 (part), 1.1435 (part)
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1172.2.133 loncom/lonnet/perl/lonnet.pm:1.1172.2.134
--- loncom/lonnet/perl/lonnet.pm:1.1172.2.133	Sat Jan  2 23:04:20 2021
+++ loncom/lonnet/perl/lonnet.pm	Mon Jan  4 03:55:50 2021
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1172.2.133 2021/01/02 23:04:20 raeburn Exp $
+# $Id: lonnet.pm,v 1.1172.2.134 2021/01/04 03:55:50 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -125,12 +125,13 @@
 	$logid ++;
         my $now = time();
 	my $id=$now.'00000'.$$.'00000'.$logid;
+        my $ip = &get_requestor_ip();  
         my $logentry = {
                          $id => {
                                   'exe_uname' => $env{'user.name'},
                                   'exe_udom'  => $env{'user.domain'},
                                   'exe_time'  => $now,
-                                  'exe_ip'    => $ENV{'REMOTE_ADDR'},
+                                  'exe_ip'    => $ip,
                                   'delflag'   => $delflag,
                                   'logentry'  => $storehash,
                                   'uname'     => $uname,
@@ -5522,13 +5523,14 @@
     my ($symb,$tuname,$tudom,$tcrsid)=@_;
     my $now=time;
     my $lonhost=$perlvar{'lonHostID'};
+    my $ip = &get_requestor_ip();
     my $infostr=&escape(
                  'CHECKOUTTOKEN&'.
                  $tuname.'&'.
                  $tudom.'&'.
                  $tcrsid.'&'.
                  $symb.'&'.
-                 $now.'&'.$ENV{'REMOTE_ADDR'});
+                 $now.'&'.$ip);
     my $token=&reply('tmpput:'.$infostr,$lonhost);
     if ($token=~/^error\:/) {
         &logthis("<font color=\"blue\">WARNING: ".
@@ -5542,7 +5544,7 @@
 
     my %infohash=('resource.0.outtoken' => $token,
                   'resource.0.checkouttime' => $now,
-                  'resource.0.outremote' => $ENV{'REMOTE_ADDR'});
+                  'resource.0.outremote' => $ip);
 
     unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {
        return '';
@@ -5573,6 +5575,7 @@
     $lonhost=~tr/A-Z/a-z/;
     my $dtoken=$ta.'_'.&hostname($lonhost).'_'.$tb;
     $dtoken=~s/\W/\_/g;
+    my $ip = &get_requestor_ip();
     my ($dummy,$tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)=
                  split(/\&/,&unescape(&reply('tmpget:'.$dtoken,$lonhost)));
 
@@ -5589,7 +5592,7 @@
 
     my %infohash=('resource.0.intoken' => $token,
                   'resource.0.checkintime' => $now,
-                  'resource.0.inremote' => $ENV{'REMOTE_ADDR'});
+                  'resource.0.inremote' => $ip);
 
     unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {
        return '';
@@ -7022,7 +7025,8 @@
        foreach my $key (keys(%{$storehash})) {
            $namevalue.=&escape($key).'='.&freeze_escape($storehash->{$key}).'&';
        }
-       $namevalue .= 'ip='.&escape($ENV{'REMOTE_ADDR'}).
+       my $ip = &get_requestor_ip();
+       $namevalue .= 'ip='.$ip.
                      '&host='.&escape($perlvar{'lonHostID'}).
                      '&version='.$esc_v.
                      '&by='.&escape($env{'user.name'}.':'.$env{'user.domain'});
@@ -9946,13 +9950,14 @@
              ' in domain '.$env{'request.role.domain'});  
     my $reply=&reply('encrypt:changeuserauth:'.$udom.':'.$uname.':'.$umode.':'.
 		     &escape($upass),$uhome);
+    my $ip = &get_requestor_ip();
     &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},
         'Authentication changed for '.$udom.', '.$uname.', '.$umode.
-         '(Remote '.$ENV{'REMOTE_ADDR'}.'): '.$reply);
+         '(Remote '.$ip.'): '.$reply);
     &log($udom,,$uname,$uhome,
         'Authentication changed by '.$env{'user.domain'}.', '.
                                      $env{'user.name'}.', '.$umode.
-         '(Remote '.$ENV{'REMOTE_ADDR'}.'): '.$reply);
+         '(Remote '.$ip.'): '.$reply);
     unless ($reply eq 'ok') {
         &logthis('Authentication mode error: '.$reply);
 	return 'error: '.$reply;
@@ -13401,6 +13406,17 @@
     return;
 }
 
+sub get_requestor_ip {
+    my ($r,$nolookup,$noproxy) = @_;
+    my $from_ip;
+    if (ref($r)) {
+        $from_ip = $r->get_remote_host($nolookup);
+    } else {
+        $from_ip = $ENV{'REMOTE_ADDR'};
+    }
+    return $from_ip;
+}
+
 # ------------------------------------------------------------- Declutters URLs
 
 sub declutter {