--- loncom/lontrans.pm	2021/12/14 20:59:19	1.14.10.2
+++ loncom/lontrans.pm	2022/01/02 20:43:50	1.14.10.2.2.1
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # URL translation for User Files
 #
-# $Id: lontrans.pm,v 1.14.10.2 2021/12/14 20:59:19 raeburn Exp $
+# $Id: lontrans.pm,v 1.14.10.2.2.1 2022/01/02 20:43:50 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -33,8 +33,7 @@ use Apache::Constants qw(:common :remote
 use Apache::lonnet();
 use Apache::loncommon;
 use Apache::File();
-use LONCAPA;
-
+use LONCAPA qw(:DEFAULT :match);
 
 sub handler {
     my $r = shift;
@@ -59,7 +58,8 @@ sub handler {
             my ($redirect,$remote_ip);
             if ($hdrhost eq $alias) {
                 $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;
                 }
                 if ($r->uri eq $ssourl) {
@@ -76,6 +76,7 @@ sub handler {
                 $remote_ip = &Apache::lonnet::get_requestor_ip($r,REMOTE_NOLOOKUP,1);
                 unless (($remote_ip eq '127.0.0.1') || ($remote_ip eq '::1') ||
                         ($remote_ip eq &Apache::lonnet::get_host_ip($lonhost)) ||
+                        ($r->uri=~m{^/adm/(lti|launch)/}) ||
                         ($vpnint && &Apache::lonnet::ip_match($remote_ip,$vpnint))) {
                     $redirect = $alias;
                     if (($r->uri=~m{^/raw/}) || ($r->uri=~m{^/adm/dns/})) {
@@ -119,7 +120,12 @@ sub handler {
                     $uri = $1.&escape($2).$3;
                 }
                 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;
                 }
                 $r->header_out(Location => $location);
@@ -127,6 +133,12 @@ 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/|) {
         my $fn = $r->uri();
         $fn=~s/^\/raw//;
@@ -165,13 +177,47 @@ sub set_token {
         foreach my $pair (split(/&/,$r->args)) {
             my ($name,$value) = split(/=/,$pair);
             $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 =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
             $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 ($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'}) {
             if ($user{'role'} ne '') {
                 $info{'role'} = $user{'role'};
@@ -199,9 +245,3 @@ sub set_token {
 1;
 __END__
 
-
-
-
-
-
-