--- loncom/auth/lonshibauth.pm	2021/12/12 20:56:36	1.14.2.1
+++ loncom/auth/lonshibauth.pm	2022/09/17 23:38:50	1.17
@@ -2,7 +2,7 @@
 # Redirect Single Sign On authentication to designated URL: 
 # /adm/sso, by default.
 #
-# $Id: lonshibauth.pm,v 1.14.2.1 2021/12/12 20:56:36 raeburn Exp $
+# $Id: lonshibauth.pm,v 1.17 2022/09/17 23:38:50 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -155,7 +155,8 @@ In the case of redirection a query strin
 which will contain either (a) the originally requested URL,
 if not /adm/sso (or lonOtherAuthenUrl URL), and 
 any existing query string in the original request, or
-(b) if redirect is to /adm/login to support dual SSO and
+(b) if original request was for /tiny/domain/uniqueID,
+or if redirect is to /adm/login to support dual SSO and
 non-SSO, a query string which contains sso=tokenID, where the
 token contains information for deep-linking to course/resource. 
 
@@ -192,9 +193,30 @@ Output: 1
 $querystring - query string to append to URL
 when redirecting.
 
-If role and/or symb are present in the original query string:
-then they will be stored in the token file on the server,
-for access later to support deep-linking.
+If any of the following items are present in the original query string:
+role, symb, and linkkey, then they will be stored in the token file
+on the server, for access later to support deep-linking.  If the ltoken
+item is available, from successful launch from an LTI Consumer where
+LON-CAPA is the LTI Provider, but not configured to accept user 
+information, and the destination is a deep-link URL /tiny/domain/uniqueiD,
+then the LTI number, type (c or d), and tiny URL will be saved as the
+linkprot item in a token file.
+
+=item set_mailtoken()
+
+Inputs: 2
+$r - request object
+$lonhost - hostID of current server
+
+Output: 1
+$querystring - query string to append to URL
+when redirecting.
+
+Called if requested URL is /adm/email, dual SSO and non-SSO login
+are supported by /adm/login and original query string contains values 
+for elements: display, username and domain, which will then be
+stored in the token file on the server to support direct access
+to a specific message sent to the user.
 
 =back
 
@@ -233,18 +255,37 @@ sub handler {
         }
         my $dest = $protocol.'://'.$hostname.$target;
         if ($target eq '/adm/login') {
-             my $querystring = &set_token($r,$lonhost);
+             my $uri = $r->uri;
+             my $querystring;
+             if (($uri eq '/adm/email') && ($r->args ne '')) {
+                 $querystring = &set_mailtoken($r,$lonhost);
+             } else {
+                 $querystring = &set_token($r,$lonhost);
+             }
              if ($querystring ne '') {
                  $dest .= '?'.$querystring;
              }
         } else {
             my $uri = $r->uri;
-            if ($r->args ne '') {
-                $dest .= (($dest=~/\?/)?'&':'?').$r->args;
-            }
-            unless (($uri eq '/adm/roles') || ($uri eq '/adm/logout')) {
-                unless ($r->args =~ /origurl=/) {
-                    $dest.=(($dest=~/\?/)?'&':'?').'origurl='.$uri;
+            if ($uri =~ m{^/tiny/$match_domain/\w+$}) {
+                my $querystring = &set_token($r,$lonhost);
+                if ($querystring ne '') {
+                    $dest .= '?'.$querystring;
+                }
+            } elsif ((&Apache::lonnet::get_saml_landing()) &&
+                     ($uri eq '/adm/email') && ($r->args ne '')) {
+                my $querystring = &set_mailtoken($r,$lonhost);
+                if ($querystring ne '') {
+                    $dest .= '?'.$querystring;
+                }
+            } else {
+                if ($r->args ne '') {
+                    $dest .= (($dest=~/\?/)?'&':'?').$r->args;
+                }
+                unless (($uri eq '/adm/roles') || ($uri eq '/adm/logout')) {
+                    unless ($r->args =~ /origurl=/) {
+                        $dest.=(($dest=~/\?/)?'&':'?').'origurl='.$uri;
+                    }
                 }
             }
         }
@@ -258,7 +299,7 @@ sub handler {
 sub set_token {
     my ($r,$lonhost) = @_;
     my ($firsturl,$querystring,$ssotoken,@names,%token);
-    @names = ('role','symb');
+    @names = ('role','symb','ltoken','linkkey');
     map { $token{$_} = 1; } @names;
     unless (($r->uri eq '/adm/roles') || ($r->uri eq '/adm/logout')) {
         $firsturl = $r->uri;
@@ -266,10 +307,43 @@ sub set_token {
     if ($r->args ne '') {
         &Apache::loncommon::get_unprocessed_cgi($r->args);
     }
+    if ($r->uri =~ m{^/tiny/$match_domain/\w+$}) {
+        if ($env{'form.ttoken'}) {
+            my %info = &Apache::lonnet::tmpget($env{'form.ttoken'});
+            &Apache::lonnet::tmpdel($env{'form.ttoken'});
+            if ($info{'ltoken'}) {
+                $env{'form.ltoken'} = $info{'ltoken'};
+            } elsif ($info{'linkkey'} ne '') {
+                $env{'form.linkkey'} = $info{'linkkey'};
+            }
+        } else {
+            unless (($env{'form.ltoken'}) || ($env{'form.linkkey'})) {
+                &Apache::lonacc::get_posted_cgi($r,['linkkey']);
+            }
+        }
+        unless (($r->is_initial_req()) || ($env{'form.ltoken'}) ||
+                ($env{'form.linkkey'})) {
+            return;
+        }
+    }
     my $extras;
     foreach my $name (@names) {
         if ($env{'form.'.$name} ne '') {
-            $extras .= '&'.$name.'='.&escape($env{'form.'.$name});
+            if ($name eq 'ltoken') {
+                my %info = &Apache::lonnet::tmpget($env{'form.ltoken'});
+                &Apache::lonnet::tmpdel($env{'form.ltoken'});
+                if ($info{'linkprot'}) {
+                    $extras .= '&linkprot='.&escape($info{'linkprot'});
+                    foreach my $item ('linkprotuser','linkprotexit') {
+                        if ($info{$item} ne '') {
+                            $extras .= '&'.$item.'='.&escape($info{$item});
+                        }
+                    }
+                    last;
+                }
+            } else {
+                $extras .= '&'.$name.'='.&escape($env{'form.'.$name});
+            }
         }
     }
     if (($firsturl ne '') || ($extras ne '')) {
@@ -282,7 +356,37 @@ sub set_token {
         foreach my $key (sort(keys(%env))) {
             if ($key =~ /^form\.(.+)$/) {
                 my $name = $1;
-                next if ($token{$name});
+                next if (($token{$name}) || ($name eq 'ttoken'));
+                $querystring .= '&'.$name.'='.$env{$key};
+            }
+        }
+    }
+    return $querystring;
+}
+
+sub set_mailtoken {
+    my ($r,$lonhost) = @_;
+    my $firsturl = $r->uri;
+    my ($querystring,$ssotoken,$extras);
+    &Apache::loncommon::get_unprocessed_cgi($r->args);
+    my $extras;
+    if (($env{'form.display'} ne '') &&
+        ($env{'form.username'} =~ /^$match_username$/) &&
+        ($env{'form.domain'} =~ /^$match_domain$/)) {  
+        $extras .= '&display='.&escape($env{'form.display'}).
+                   '&mailrecip='.&escape($env{'form.username'}.':'.$env{'form.domain'});
+    }
+    if (($firsturl ne '') || ($extras ne '')) {
+        $extras .= ':sso';
+        $ssotoken = &Apache::lonnet::reply('tmpput:'.&escape($firsturl).
+                                           $extras,$lonhost);
+        $querystring = 'sso='.$ssotoken;
+    }
+    if ($r->args ne '') {
+        foreach my $key (sort(keys(%env))) {
+            if ($key =~ /^form\.(.+)$/) {
+                my $name = $1;
+                next if (($name eq 'display') || ($name eq 'username') || ($name eq 'domain'));
                 $querystring .= '&'.$name.'='.$env{$key};
             }
         }