[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1444 and 1.1448

version 1.1444, 2021/03/31 02:19:59 version 1.1448, 2021/04/18 02:24:05
Line 740  sub check_for_valid_session { Line 740  sub check_for_valid_session {
     if (ref($userhashref) eq 'HASH') {      if (ref($userhashref) eq 'HASH') {
         $userhashref->{'name'} = $disk_env{'user.name'};          $userhashref->{'name'} = $disk_env{'user.name'};
         $userhashref->{'domain'} = $disk_env{'user.domain'};          $userhashref->{'domain'} = $disk_env{'user.domain'};
           if ($disk_env{'request.role'}) {
               $userhashref->{'role'} = $disk_env{'request.role'};
           }
         $userhashref->{'lti'} = $disk_env{'request.lti.login'};          $userhashref->{'lti'} = $disk_env{'request.lti.login'};
         if ($userhashref->{'lti'}) {          if ($userhashref->{'lti'}) {
             $userhashref->{'ltitarget'} = $disk_env{'request.lti.target'};              $userhashref->{'ltitarget'} = $disk_env{'request.lti.target'};
Line 3482  sub ssi_body { Line 3485  sub ssi_body {
 # --------------------------------------------------------- Server Side Include  # --------------------------------------------------------- Server Side Include
   
 sub absolute_url {  sub absolute_url {
     my ($host_name) = @_;      my ($host_name,$unalias,$keep_proto) = @_;
     my $protocol = ($ENV{'SERVER_PORT'} == 443?'https://':'http://');      my $protocol = ($ENV{'SERVER_PORT'} == 443?'https://':'http://');
     if ($host_name eq '') {      if ($host_name eq '') {
  $host_name = $ENV{'SERVER_NAME'};   $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;      return $protocol.$host_name;
 }  }
   
Line 3503  sub absolute_url { Line 3524  sub absolute_url {
 sub ssi {  sub ssi {
   
     my ($fn,%form)=@_;      my ($fn,%form)=@_;
     my $request;      my ($host,$request,$response);
       $host = &absolute_url('',1);
   
     $form{'no_update_last_known'}=1;      $form{'no_update_last_known'}=1;
     &Apache::lonenc::check_encrypt(\$fn);      &Apache::lonenc::check_encrypt(\$fn);
     if (%form) {      if (%form) {
       $request=new HTTP::Request('POST',&absolute_url().$fn);        $request=new HTTP::Request('POST',$host.$fn);
       $request->content(join('&',map {         $request->content(join('&',map { 
             my $name = escape($_);              my $name = escape($_);
             "$name=" . ( ref($form{$_}) eq 'ARRAY'               "$name=" . ( ref($form{$_}) eq 'ARRAY' 
Line 3516  sub ssi { Line 3538  sub ssi {
             : &escape($form{$_}) );                  : &escape($form{$_}) );    
         } keys(%form)));          } keys(%form)));
     } else {      } else {
       $request=new HTTP::Request('GET',&absolute_url().$fn);        $request=new HTTP::Request('GET',$host.$fn);
     }      }
   
     $request->header(Cookie => $ENV{'HTTP_COOKIE'});      $request->header(Cookie => $ENV{'HTTP_COOKIE'});
Line 3530  sub ssi { Line 3552  sub ssi {
                                  ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')))) {                                   ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')))) {
         $islocal = 1;          $islocal = 1;
     }      }
     my $response= &LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar,      $response= &LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar,
                                                 '','','',$islocal);                                               '','','',$islocal);
   
     if (wantarray) {      if (wantarray) {
  return ($response->content, $response);   return ($response->content, $response);
Line 9441  sub auto_validate_inst_crosslist { Line 9463  sub auto_validate_inst_crosslist {
     unless (($homeserver eq '') || ($homeserver eq 'no_host')) {      unless (($homeserver eq '') || ($homeserver eq 'no_host')) {
         $response=&reply('autovalidateinstcrosslist:'.$cdom.':'.          $response=&reply('autovalidateinstcrosslist:'.$cdom.':'.
                          &escape($instcode).':'.&escape($inst_xlist).':'.                           &escape($instcode).':'.&escape($inst_xlist).':'.
                          &escape($coowner),$homeserver)));                           &escape($coowner),$homeserver);
     }      }
     return $response;      return $response;
 }  }
Line 10278  sub autoupdate_coowners { Line 10300  sub autoupdate_coowners {
                                 foreach my $xlist (split(',',$xlists)) {                                  foreach my $xlist (split(',',$xlists)) {
                                     my ($inst_crosslist,$lcsec) = split(':',$xlist);                                      my ($inst_crosslist,$lcsec) = split(':',$xlist);
                                     $result =                                      $result =
                                         &Apache::lonnet::auto_validate_inst_crosslist($cnum,$cdom,$instcode,                                          &auto_validate_inst_crosslist($cnum,$cdom,$instcode,
                                                                                       $inst_crosslist,$uname.':'.$udom);                                                                        $inst_crosslist,$uname.':'.$udom);
                                         last if ($result eq 'valid');                                      last if ($result eq 'valid');
                                     }  
                                 }                                  }
                             }                              }
                         }                          }
Line 14337  sub get_requestor_ip { Line 14358  sub get_requestor_ip {
     my ($r,$nolookup,$noproxy) = @_;      my ($r,$nolookup,$noproxy) = @_;
     my $from_ip;      my $from_ip;
     if (ref($r)) {      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 {      } else {
         $from_ip = $ENV{'REMOTE_ADDR'};          $from_ip = $ENV{'REMOTE_ADDR'};
     }      }
Removed from v.1.1444  
changed lines
  Added in v.1.1448

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>