--- loncom/lti/ltiauth.pm	2017/12/06 01:53:56	1.1
+++ loncom/lti/ltiauth.pm	2018/01/12 20:42:38	1.5
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Basic LTI Authentication Module
 #
-# $Id: ltiauth.pm,v 1.1 2017/12/06 01:53:56 raeburn Exp $
+# $Id: ltiauth.pm,v 1.5 2018/01/12 20:42:38 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -36,6 +36,7 @@ use Apache::lonlocal;
 use Apache::lonnet;
 use Apache::loncommon;
 use Apache::lonacc;
+use LONCAPA::ltiutils;
 
 sub handler {
     my $r = shift;
@@ -141,8 +142,8 @@ sub handler {
 # (b) from tail of requested URL (after /adm/lti) if it has format of a symb  
 # (c) from tail of requested URL (after /adm/lti) if it has format of a map 
 # (d) from tail of requested URL (after /adm/lti) if it has format /domain/courseID
-# (e) from tail of requested URL (after /adm/lti) if it has format /tiny/domain/...
-# i.e., a shortened URL (see bug #6400) -- not implemented yet.   
+# (e) from tail of requested URL (after /adm/lti) if it has format /tiny/domain/\w+
+#     i.e., a shortened URL (see bug #6400).
 # (f) same as user's domain 
 #
 # Request invalid if custom_coursedomain is defined and is inconsistent with
@@ -180,13 +181,34 @@ sub handler {
                 $symb = $tail;
                 $symb =~ s{^/+}{};
             }
-#FIXME Need to handle encrypted URLs 
+#FIXME Need to handle encrypted URLs
         } elsif ($tail =~ m{^/($match_domain)/($match_courseid)$}) {
             ($urlcdom,$urlcnum) = ($1,$2);
             if (($cdom ne '') && ($cdom ne $urlcdom)) {
                 &invalid_request($r,4);
                 return OK;
             }
+        } elsif ($tail =~ m{^/tiny/($match_domain)/(\w+)$}) {
+            ($urlcdom,my $key) = ($1,$2);
+            if (($cdom ne '') && ($cdom ne $urlcdom)) {
+                &invalid_request($r,5);
+                return OK;
+            }
+            my $tinyurl;
+            my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$urlcdom."\0".$key);
+            if (defined($cached)) {
+                $tinyurl = $result;
+            } else {
+                my $configuname = &Apache::lonnet::get_domainconfiguser($urlcdom);
+                my %currtiny = &Apache::lonnet::get('tiny',[$key],$urlcdom,$configuname);
+                if ($currtiny{$key} ne '') {
+                    $tinyurl = $currtiny{$key};
+                    &Apache::lonnet::do_cache_new('tiny',$urlcdom."\0".$key,$currtiny{$key},600);
+                }
+            }
+            if ($tinyurl ne '') {
+                $urlcnum = (split(/\&/,$tinyurl))[0];
+            }
         }
         if (($cdom eq '') && ($urlcdom ne '')) { 
             my $cprimary_id = &Apache::lonnet::domain($urlcdom,'primary');
@@ -216,7 +238,7 @@ sub handler {
  
     my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
     unless (keys(%lti) > 0) {
-        &invalid_request($r,5);
+        &invalid_request($r,6);
         return OK;
     }
     my %lti_by_key;
@@ -240,13 +262,12 @@ sub handler {
         $protocol = 'https';
     }
 
-    my $itemid;
-    my $key = $params->{'oauth_consumer_key'};
-    my @ltiroles;
-    if (ref($lti_by_key{$key}) eq 'ARRAY') {
-        foreach my $id (@{$lti_by_key{$key}}) {
+    my ($itemid,$consumer_key,$secret,@ltiroles);
+    $consumer_key = $params->{'oauth_consumer_key'};
+    if (ref($lti_by_key{$consumer_key}) eq 'ARRAY') {
+        foreach my $id (@{$lti_by_key{$consumer_key}}) {
             if (ref($lti{$id}) eq 'HASH') {
-                my $secret = $lti{$id}{'secret'};
+                $secret = $lti{$id}{'secret'};
                 my $request = Net::OAuth->request('request token')->from_hash($params,
                                                    request_url => $protocol.'://'.$hostname.$requri,
                                                    request_method => $env{'request.method'},
@@ -265,7 +286,7 @@ sub handler {
 # configuration in LON-CAPA for that LTI Consumer.
 #
     unless (($itemid) && (ref($lti{$itemid}) eq 'HASH')) {
-        &invalid_request($r,6);
+        &invalid_request($r,7);
         return OK;
     }
 
@@ -273,8 +294,9 @@ sub handler {
 # Determine if nonce in POSTed data has expired.
 # If unexpired, confirm it has not already been used.
 #
-    unless (&check_nonce($r,$params->{'oauth_nonce'},$params->{'oauth_timestamp'},$lti{$itemid}{'lifetime'},$cdom)) {
-        &invalid_request($r,7);
+    unless (&LONCAPA::ltiutils::check_nonce($params->{'oauth_nonce'},$params->{'oauth_timestamp'},
+                                            $lti{$itemid}{'lifetime'},$cdom,$r->dir_config('lonLTIDir'))) {
+        &invalid_request($r,8);
         return OK;
     }
 
@@ -310,8 +332,8 @@ sub handler {
 # (b) from tail of requested URL (after /adm/lti) if it has format of a symb
 # (c) from tail of requested URL (after /adm/lti) if it has format of a map
 # (d) from tail of requested URL (after /adm/lti) if it has format /domain/courseID
-# (e) from tail of requested URL (after /adm/lti) if it has format /tiny/domain/...
-# i.e., a shortened URL (see bug #6400) -- not implemented yet.
+# (e) from tail of requested URL (after /adm/lti) if it has format /tiny/domain/\w+
+#     i.e., a shortened URL (see bug #6400).
 #
 # If Consumer course included in POSTed data points as a target course which
 # has a format which matches a LON-CAPA courseID, but the course does not
@@ -334,7 +356,7 @@ sub handler {
             if ($consumers{$sourcecrs} =~ /^$match_courseid$/) {
                 my $crshome = &Apache::lonnet::homeserver($consumers{$sourcecrs},$cdom);
                 if ($crshome =~ /(con_lost|no_host|no_such_host)/) {
-                    &invalid_request($r,8);
+                    &invalid_request($r,9);
                     return OK;
                 } else {
                     $posscnum = $consumers{$sourcecrs};
@@ -346,7 +368,7 @@ sub handler {
     if ($urlcnum ne '') {
         if ($posscnum ne '') {
             if ($posscnum ne $urlcnum) {
-                &invalid_request($r,9);
+                &invalid_request($r,10);
                 return OK;
             } else {
                 $cnum = $posscnum;
@@ -354,7 +376,7 @@ sub handler {
         } else {
             my $crshome = &Apache::lonnet::homeserver($urlcnum,$cdom);
             if ($crshome =~ /(con_lost|no_host|no_such_host)/) {
-                &invalid_request($r,10);
+                &invalid_request($r,11);
                 return OK;
             } else {
                 $cnum = $urlcnum;
@@ -426,12 +448,12 @@ sub handler {
 #FIXME Do user creation here.
                 return OK
             } else {
-                &invalid_request($r,11);
+                &invalid_request($r,12);
                 return OK;
             } 
         } 
     } else {
-        &invalid_request($r,12);
+        &invalid_request($r,13);
         return OK;
     }
 
@@ -447,7 +469,7 @@ sub handler {
 #FIXME Create a new LON-CAPA course here.
             return OK;
         } else {
-            &invalid_request($r,13);
+            &invalid_request($r,14);
             return OK; 
         }
     }
@@ -481,7 +503,8 @@ sub handler {
 #FIXME Do self-enrollment here
             return OK;
         } else {
-            &invalid_request($r,14);
+            &invalid_request($r,15);
+            return OK;
         }
     }
 
@@ -496,7 +519,7 @@ sub handler {
 # Check if user should be hosted here or switched to another server.
 #
 
-    &Apache::lonnet::logthis(" LTI authorized user: $uname:$udom role: $role course: $cnum:$cdom");
+    &Apache::lonnet::logthis(" LTI authorized user: $uname:$udom role: $role course: $cdom\_$cnum");
     $r->user($uname);
     my ($is_balancer,$otherserver,$hosthere);
     ($is_balancer,$otherserver) =
@@ -609,35 +632,6 @@ sub handler {
     return OK;
 }
 
-sub check_nonce {
-    my ($r,$nonce,$timestamp,$lifetime,$domain) = @_;
-    if (($timestamp eq '') || ($timestamp =~ /^\D/) || ($lifetime eq '') || ($lifetime =~ /\D/) || ($domain eq '')) {
-        return 0;
-    }
-    my $now = time;
-    if (($timestamp) && ($timestamp < ($now - $lifetime))) {
-        return 0;
-    }
-    if ($nonce eq '') {
-        return 0;
-    }
-    my $lonltidir = $r->dir_config('lonLTIDir');
-    if (-e "$lonltidir/$domain/$nonce") {
-        return 0;
-    } else {
-        unless (-e "$lonltidir/$domain") {
-            mkdir("$lonltidir/$domain",0755);
-        }  
-        if (open(my $fh,'>',"$lonltidir/$domain/$nonce")) {
-            print $fh $now;
-            close($fh);
-        } else {
-            return 0;
-        }
-    }
-    return 1;
-}
-
 sub invalid_request {
     my ($r,$num) = @_;
     &Apache::loncommon::content_type($r,'text/html');