--- loncom/lonnet/perl/lonnet.pm 2021/03/31 02:19:59 1.1444 +++ loncom/lonnet/perl/lonnet.pm 2021/04/18 02:08:47 1.1447 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1444 2021/03/31 02:19:59 raeburn Exp $ +# $Id: lonnet.pm,v 1.1447 2021/04/18 02:08:47 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -3482,11 +3482,29 @@ sub ssi_body { # --------------------------------------------------------- Server Side Include sub absolute_url { - my ($host_name) = @_; + my ($host_name,$unalias,$keep_proto) = @_; my $protocol = ($ENV{'SERVER_PORT'} == 443?'https://':'http://'); if ($host_name eq '') { $host_name = $ENV{'SERVER_NAME'}; } + if ($unalias) { + my $alias = &get_proxy_alias(); + if ($alias eq $host_name) { + my $lonhost = $perlvar{'lonHostID'}; + my $hostname = &hostname($lonhost); + my $lcproto; + if (($keep_proto) || ($hostname eq '')) { + $lcproto = $protocol; + } else { + $lcproto = $protocol{$lonhost}; + $lcproto = 'http' if ($lcproto ne 'https'); + $lcproto .= '://'; + } + unless ($hostname eq '') { + return $lcproto.$hostname; + } + } + } return $protocol.$host_name; } @@ -3503,12 +3521,13 @@ sub absolute_url { sub ssi { my ($fn,%form)=@_; - my $request; + my ($host,$request,$response); + $host = &absolute_url('',1); $form{'no_update_last_known'}=1; &Apache::lonenc::check_encrypt(\$fn); if (%form) { - $request=new HTTP::Request('POST',&absolute_url().$fn); + $request=new HTTP::Request('POST',$host.$fn); $request->content(join('&',map { my $name = escape($_); "$name=" . ( ref($form{$_}) eq 'ARRAY' @@ -3516,7 +3535,7 @@ sub ssi { : &escape($form{$_}) ); } keys(%form))); } else { - $request=new HTTP::Request('GET',&absolute_url().$fn); + $request=new HTTP::Request('GET',$host.$fn); } $request->header(Cookie => $ENV{'HTTP_COOKIE'}); @@ -3530,8 +3549,8 @@ sub ssi { ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')))) { $islocal = 1; } - my $response= &LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar, - '','','',$islocal); + $response= &LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar, + '','','',$islocal); if (wantarray) { return ($response->content, $response); @@ -9441,7 +9460,7 @@ sub auto_validate_inst_crosslist { unless (($homeserver eq '') || ($homeserver eq 'no_host')) { $response=&reply('autovalidateinstcrosslist:'.$cdom.':'. &escape($instcode).':'.&escape($inst_xlist).':'. - &escape($coowner),$homeserver))); + &escape($coowner),$homeserver); } return $response; } @@ -10278,10 +10297,9 @@ sub autoupdate_coowners { foreach my $xlist (split(',',$xlists)) { my ($inst_crosslist,$lcsec) = split(':',$xlist); $result = - &Apache::lonnet::auto_validate_inst_crosslist($cnum,$cdom,$instcode, - $inst_crosslist,$uname.':'.$udom); - last if ($result eq 'valid'); - } + &auto_validate_inst_crosslist($cnum,$cdom,$instcode, + $inst_crosslist,$uname.':'.$udom); + last if ($result eq 'valid'); } } } @@ -14337,7 +14355,17 @@ sub get_requestor_ip { my ($r,$nolookup,$noproxy) = @_; my $from_ip; if (ref($r)) { - $from_ip = $r->get_remote_host($nolookup); + if ($r->can('useragent_ip')) { + if ($noproxy && $r->can('client_ip')) { + $from_ip = $r->client_ip(); + } else { + $from_ip = $r->useragent_ip(); + } + } elsif ($r->connection->can('remote_ip')) { + $from_ip = $r->connection->remote_ip(); + } else { + $from_ip = $r->get_remote_host($nolookup); + } } else { $from_ip = $ENV{'REMOTE_ADDR'}; }