--- loncom/lti/ltiauth.pm	2021/08/12 00:05:27	1.23
+++ loncom/lti/ltiauth.pm	2021/11/24 04:25:03	1.27
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Basic LTI Authentication Module
 #
-# $Id: ltiauth.pm,v 1.23 2021/08/12 00:05:27 raeburn Exp $
+# $Id: ltiauth.pm,v 1.27 2021/11/24 04:25:03 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -197,7 +197,7 @@ sub handler {
                                 delete($env{'form.'.$key});
                             }
                             my $ltoken = &Apache::lonnet::tmpput({'linkprot' => $itemid.$ltitype.':'.$tail},
-                                                                 $lonhost);
+                                                                 $lonhost,'link');
                             if ($ltoken) {
                                 $r->internal_redirect($tail.'?ltoken='.$ltoken);
                                 $r->set_handlers('PerlHandler'=> undef);
@@ -613,20 +613,26 @@ sub handler {
 
     my $reqcrs;
     if ($cnum eq '') {
-        if ((@ltiroles) && ($lti{$itemid}{'mapcrs'}) &&
-            ($ltiroles[0] eq 'Instructor') && ($lcroles[0] eq 'cc') && ($lti{$itemid}{'makecrs'})) {
-            my (%can_request,%request_domains);
-            &Apache::lonnet::check_can_request($cdom,\%can_request,\%request_domains,$uname,$udom);
-            if ($can_request{'lti'}) {
-                $reqcrs = 1;
-                &lti_session($r,$itemid,$uname,$udom,$uhome,$lonhost,undef,$mapurl,$tail,
-                             $symb,$cdom,$cnum,$params,\@ltiroles,$lti{$itemid},\@lcroles,
-                             $reqcrs,$sourcecrs);
+        if ($lti{$itemid}{'crsinc'}) {
+            if ((@ltiroles) && ($lti{$itemid}{'mapcrs'}) &&
+                ($ltiroles[0] eq 'Instructor') && ($lcroles[0] eq 'cc') && ($lti{$itemid}{'makecrs'})) {
+                my (%can_request,%request_domains);
+                &Apache::lonnet::check_can_request($cdom,\%can_request,\%request_domains,$uname,$udom);
+                if ($can_request{'lti'}) {
+                    $reqcrs = 1;
+                    &lti_session($r,$itemid,$uname,$udom,$uhome,$lonhost,undef,$mapurl,$tail,
+                                 $symb,$cdom,$cnum,$params,\@ltiroles,$lti{$itemid},\@lcroles,
+                                 $reqcrs,$sourcecrs);
+                } else {
+                    &invalid_request($r,27);
+                }
             } else {
-                &invalid_request($r,27);
+                &invalid_request($r,28);
             }
         } else {
-            &invalid_request($r,28);
+            &lti_session($r,$itemid,$uname,$udom,$uhome,$lonhost,undef,$mapurl,$tail,
+                         $symb,$cdom,$cnum,$params,\@ltiroles,$lti{$itemid},\@lcroles,
+                         $reqcrs,$sourcecrs);
         }
         return OK;
     }
@@ -634,7 +640,7 @@ sub handler {
 #
 # If LON-CAPA course is a Community, and LON-CAPA role
 # indicated is cc, change role indicated to co.
-# 
+#
 
     my %crsenv;
     if ($lcroles[0] eq 'cc') {
@@ -739,11 +745,41 @@ sub handler {
     }
 
 #
-# Store consumer-to-LON-CAPA course mapping
+# Retrieve course type of LON-CAPA course to check if mapping from a Consumer
+# course identifier permitted for this type of course (one of: official,
+# unofficial, community, textbook, placement or lti.
+#
+
+    unless (%crsenv) {
+        %crsenv = &Apache::lonnet::coursedescription($cdom.'_'.$cnum);
+    }
+    my $crstype = lc($crsenv{'type'});
+    if ($crstype eq '') {
+        $crstype = 'course';
+    }
+    if ($crstype eq 'course') {
+        if ($crsenv{'internal.coursecode'}) {
+            $crstype = 'official';
+        } elsif ($crsenv{'internal.textbook'}) {
+            $crstype = 'textbook';
+        } elsif ($crsenv{'internal.lti'}) {
+            $crstype = 'lti';
+        } else {
+            $crstype = 'unofficial';
+        }
+    }
+
+#
+# Store consumer-to-LON-CAPA course mapping if permitted
 #
 
-    if (($sourcecrs ne '')  && ($consumers{$sourcecrs} eq '') && ($cnum ne '')) {
-        &Apache::lonnet::put_dom('lticonsumers',{ $sourcecrs => $cnum },$cdom);
+    if (($lti{$itemid}{'storecrs'}) && ($sourcecrs ne '') && 
+        ($consumers{$sourcecrs} eq '') && ($cnum ne '')) {
+        if (ref($lti{$itemid}{'mapcrstype'}) eq 'ARRAY') {
+            if (grep(/^$crstype$/,@{$lti{$itemid}{'mapcrstype'}})) {
+                &Apache::lonnet::put_dom('lticonsumers',{ $sourcecrs => $cnum },$cdom);
+            }
+        }
     }
 
 #
@@ -894,7 +930,9 @@ sub lti_session {
                 $env{'request.lti.uri'} = $tail;
             } else {
                 unless ($tail eq '/adm/roles') {
-                    $env{'form.origurl'} = '/adm/navmaps';
+                    if ($cnum) {
+                        $env{'form.origurl'} = '/adm/navmaps';
+                    }
                 }
             }
         }
@@ -930,7 +968,7 @@ sub lti_session {
         if ($params->{'launch_presentation_document_target'}) {
             $env{'request.lti.target'} = $params->{'launch_presentation_document_target'};
         }
-        foreach my $key (%{$params}) {
+        foreach my $key (keys(%{$params})) {
             delete($env{'form.'.$key});
         }
         my $redirecturl = '/adm/switchserver';
@@ -942,7 +980,7 @@ sub lti_session {
     } else {
         # need to login them in, so generate the need data that
         # migrate expects to do login
-        foreach my $key (%{$params}) {
+        foreach my $key (keys(%{$params})) {
             delete($env{'form.'.$key});
         }
         if (($ltihash->{'callback'}) && ($params->{$ltihash->{'callback'}})) {
@@ -1002,7 +1040,9 @@ sub lti_session {
                 $info{'origurl'} = $tail;
             } else {
                 unless ($tail eq '/adm/roles') {
-                    $info{'origurl'} = '/adm/navmaps';
+                    if ($cnum) {
+                        $info{'origurl'} = '/adm/navmaps';
+                    }
                 }
             }
         }