--- loncom/lonnet/perl/lonnet.pm 2021/01/02 23:04:20 1.1172.2.133 +++ loncom/lonnet/perl/lonnet.pm 2021/01/28 22:41:44 1.1172.2.136 @@ -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.136 2021/01/28 22:41:44 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, @@ -1375,6 +1376,15 @@ sub spare_can_host { $canhost = 0; } } + if ($canhost) { + if (ref($defdomdefaults{'offloadoth'}) eq 'HASH') { + if ($defdomdefaults{'offloadoth'}{$try_server}) { + unless (&shared_institution($udom,$try_server)) { + $canhost = 0; + } + } + } + } if (($canhost) && ($uint_dom)) { my @intdoms; my $internet_names = &get_internet_names($try_server); @@ -2415,6 +2425,9 @@ sub get_domain_defaults { if (ref($domconfig{'usersessions'}{'offloadnow'}) eq 'HASH') { $domdefaults{'offloadnow'} = $domconfig{'usersessions'}{'offloadnow'}; } + if (ref($domconfig{'usersessions'}{offloadoth'} eq 'HASH') { + $domdefaults{'offloadoth'} = $domconfig{'usersessions'}{'offloadoth'}; + } } if (ref($domconfig{'selfenrollment'}) eq 'HASH') { if (ref($domconfig{'selfenrollment'}{'admin'}) eq 'HASH') { @@ -5522,13 +5535,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 +5556,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 +5587,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 +5604,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 +7037,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='.&escape($ip). '&host='.&escape($perlvar{'lonHostID'}). '&version='.$esc_v. '&by='.&escape($env{'user.name'}.':'.$env{'user.domain'}); @@ -9946,13 +9962,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; @@ -13342,9 +13359,12 @@ sub default_login_domain { } sub shared_institution { - my ($dom) = @_; + my ($dom,$lonhost) = @_; + if ($lonhost eq '') { + $lonhost = $perlvar{'lonHostID'}; + } my $same_intdom; - my $hostintdom = &internet_dom($perlvar{'lonHostID'}); + my $hostintdom = &internet_dom($lonhost); if ($hostintdom ne '') { my %iphost = &get_iphost(); my $primary_id = &domain($dom,'primary'); @@ -13401,6 +13421,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 {