--- loncom/lonnet/perl/lonnet.pm 2021/01/02 23:04:20 1.1172.2.133 +++ loncom/lonnet/perl/lonnet.pm 2021/01/04 03:55:50 1.1172.2.134 @@ -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 @@ our @EXPORT = qw(%env); $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 @@ sub checkout { 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("WARNING: ". @@ -5542,7 +5544,7 @@ sub checkout { 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 @@ sub checkin { $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 @@ sub checkin { 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 @@ sub putstore { 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 @@ sub modifyuserauth { ' 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 @@ sub uses_sts { 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 {