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

Diff for /loncom/lontrans.pm between versions 1.14.10.2 and 1.14.10.2.2.2

version 1.14.10.2, 2021/12/14 20:59:19 version 1.14.10.2.2.2, 2022/01/05 00:51:20
Line 30  package Apache::lontrans; Line 30  package Apache::lontrans;
   
 use strict;  use strict;
 use Apache::Constants qw(:common :remotehost);  use Apache::Constants qw(:common :remotehost);
 use Apache::lonnet();  use Apache::lonnet;
 use Apache::loncommon;  use Apache::loncommon;
 use Apache::File();  use Apache::File();
 use LONCAPA;  use LONCAPA qw(:DEFAULT :match);
   
   
 sub handler {  sub handler {
     my $r = shift;      my $r = shift;
Line 59  sub handler { Line 58  sub handler {
             my ($redirect,$remote_ip);              my ($redirect,$remote_ip);
             if ($hdrhost eq $alias) {              if ($hdrhost eq $alias) {
                 $remote_ip = &Apache::lonnet::get_requestor_ip($r,REMOTE_NOLOOKUP);                  $remote_ip = &Apache::lonnet::get_requestor_ip($r,REMOTE_NOLOOKUP);
                 if (($vpnext && &Apache::lonnet::ip_match($remote_ip,$vpnext))) {                  if (($vpnext && &Apache::lonnet::ip_match($remote_ip,$vpnext)) &&
                       ($r->uri !~ m{^/adm/(lti|launch)/})) {
                     $redirect = $hostname;                      $redirect = $hostname;
                 }                  }
                 if ($r->uri eq $ssourl) {                  if ($r->uri eq $ssourl) {
Line 76  sub handler { Line 76  sub handler {
                 $remote_ip = &Apache::lonnet::get_requestor_ip($r,REMOTE_NOLOOKUP,1);                  $remote_ip = &Apache::lonnet::get_requestor_ip($r,REMOTE_NOLOOKUP,1);
                 unless (($remote_ip eq '127.0.0.1') || ($remote_ip eq '::1') ||                  unless (($remote_ip eq '127.0.0.1') || ($remote_ip eq '::1') ||
                         ($remote_ip eq &Apache::lonnet::get_host_ip($lonhost)) ||                          ($remote_ip eq &Apache::lonnet::get_host_ip($lonhost)) ||
                           ($r->uri=~m{^/adm/(lti|launch)/}) ||
                         ($vpnint && &Apache::lonnet::ip_match($remote_ip,$vpnint))) {                          ($vpnint && &Apache::lonnet::ip_match($remote_ip,$vpnint))) {
                     $redirect = $alias;                      $redirect = $alias;
                     if (($r->uri=~m{^/raw/}) || ($r->uri=~m{^/adm/dns/})) {                      if (($r->uri=~m{^/raw/}) || ($r->uri=~m{^/adm/dns/})) {
Line 119  sub handler { Line 120  sub handler {
                     $uri = $1.&escape($2).$3;                      $uri = $1.&escape($2).$3;
                 }                  }
                 my $location = $protocol.'://'.$redirect.$uri;                  my $location = $protocol.'://'.$redirect.$uri;
                 if ($r->args) {                  if ($r->uri =~ m{^/tiny/$match_domain/\w+$}) {
                       my $token = &set_token($r,$r->uri);
                       unless ($token eq '') {
                           $location .= '?ttoken='.$token;
                       }
                   } elsif ($r->args) {
                     $location .= '?'.$r->args;                      $location .= '?'.$r->args;
                 }                  }
                 $r->header_out(Location => $location);                  $r->header_out(Location => $location);
Line 127  sub handler { Line 133  sub handler {
             }              }
         }          }
     }      }
       if ($r->uri =~ m{^/tiny/$match_domain/\w+$}) {
           my $token = &set_token($r,$r->uri);
           unless ($token eq '') {
               $r->args('ttoken='.$token);
           }
       }
     if ($r->uri=~m|^(/raw)?/uploaded/|) {      if ($r->uri=~m|^(/raw)?/uploaded/|) {
         my $fn = $r->uri();          my $fn = $r->uri();
         $fn=~s/^\/raw//;          $fn=~s/^\/raw//;
Line 165  sub set_token { Line 177  sub set_token {
         foreach my $pair (split(/&/,$r->args)) {          foreach my $pair (split(/&/,$r->args)) {
             my ($name,$value) = split(/=/,$pair);              my ($name,$value) = split(/=/,$pair);
             $name = &LONCAPA::unescape($name);              $name = &LONCAPA::unescape($name);
             next unless (($name eq 'role') || ($name eq 'symb'));              next unless (($name eq 'role') || ($name eq 'symb') ||
                            ($name eq 'ltoken') || ($name eq 'linkkey') ||
                            ($name eq 'ttoken'));
             $value =~ tr/+/ /;              $value =~ tr/+/ /;
             $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;              $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
             $info{$name} = $value;              $info{$name} = $value;
         }          }
           if ($info{'ttoken'}) {
               my %current = &Apache::lonnet::tmpget($info{'ttoken'});
               delete($info{'ttoken'});
               if ($current{'origurl'} eq $r->uri) {
                   return if (keys(%current));
               }
           }
       }
   #
   # To be able to support deep-linking for a shortened URL, i.e.,
   # /tiny/$dom/$id with (a) linkkey included in POSTed data and
   # data and (b) non-Shibboleth SSO in use, ltoken (or linkprot
   # if sending to /adm/migrateuser), or linkkey are written to a
   # .tmp file in /home/httpd/perl/tmp and the query string is
   # replaced with ttoken=tokenid.  This does mean other POSTed
   # data will be discarded.
   #
       if ($r->uri =~ m{^/tiny/$match_domain/\w+$}) {
           unless (($info{'ltoken'}) || ($info{'linkkey'} ne '')) {
               &Apache::lonacc::get_posted_cgi($r,['linkkey']);
               if ($env{'form.linkkey'} ne '') {
                   $info{'linkkey'} = $env{'form.linkkey'};
               }
           }
     }      }
     if ($dest eq '/adm/migrateuser') {      if ($dest eq '/adm/migrateuser') {
           if ($info{'ltoken'}) {
               my %link_info = &Apache::lonnet::tmpget($info{'ltoken'});
               if ($link_info{'linkprot'}) {
                   $info{'linkprot'} = $link_info{'linkprot'};
               }
               &Apache::lonnet::tmpdel($info{'ltoken'});;
               delete($info{'ltoken'});
           }
         unless ($info{'role'}) {          unless ($info{'role'}) {
             if ($user{'role'} ne '') {              if ($user{'role'} ne '') {
                 $info{'role'} = $user{'role'};                  $info{'role'} = $user{'role'};
Line 199  sub set_token { Line 245  sub set_token {
 1;  1;
 __END__  __END__
   
   
   
   
   
   
   
Removed from v.1.14.10.2  
changed lines
  Added in v.1.14.10.2.2.2

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