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

Diff for /loncom/lti/ltiauth.pm between versions 1.2 and 1.17

version 1.2, 2017/12/07 15:36:25 version 1.17, 2018/12/26 20:10:29
Line 36  use Apache::lonlocal; Line 36  use Apache::lonlocal;
 use Apache::lonnet;  use Apache::lonnet;
 use Apache::loncommon;  use Apache::loncommon;
 use Apache::lonacc;  use Apache::lonacc;
   use Apache::lonrequestcourse;
 use LONCAPA::ltiutils;  use LONCAPA::ltiutils;
   
 sub handler {  sub handler {
     my $r = shift;      my $r = shift;
     my $requri = $r->uri;      my $requri = $r->uri;
 #  #
 # Retrieve data POSTed by LTI Consumer on launch    # Check for existing session, and temporarily delete any form items
   # in %env, if session exists
   #
       my %savedform;
       my $handle = &Apache::lonnet::check_for_valid_session($r);
       if ($handle ne '') {
           foreach my $key (sort(keys(%env))) {
               if ($key =~ /^form\.(.+)$/) {
                   $savedform{$1} = $env{$key};
                   delete($env{$key});
               }
           }
       }
   #
   # Retrieve data POSTed by LTI Consumer on launch
 #  #
     &Apache::lonacc::get_posted_cgi($r);      &Apache::lonacc::get_posted_cgi($r);
     my $params = {};      my $params = {};
Line 51  sub handler { Line 66  sub handler {
             $params->{$1} = $env{$key};              $params->{$1} = $env{$key};
         }          }
     }      }
   #
   # Check for existing session, and restored temporarily
   # deleted form items to %env, if session exists.
   #
       if ($handle ne '') {
           if (keys(%savedform)) {
               foreach my $key (sort(keys(%savedform))) {
                   $env{'form.'.$key} = $savedform{$key};
               }
           }
       }
   
     unless (keys(%{$params})) {      unless (keys(%{$params})) {
         &invalid_request($r,1);          &invalid_request($r,1);
Line 139  sub handler { Line 165  sub handler {
 # Order is:  # Order is:
 #  #
 # (a) from custom_coursedomain item in POSTed data  # (a) from custom_coursedomain item in POSTed data
 # (b) from tail of requested URL (after /adm/lti) if it has format of a symb    # (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   # (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  # (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/...  # (e) from tail of requested URL (after /adm/lti) if it has format /tiny/domain/\w+
 # i.e., a shortened URL (see bug #6400) -- not implemented yet.     #     i.e., a shortened URL (see bug #6400).
 # (f) same as user's domain   # (f) same as user's domain 
 #  #
 # Request invalid if custom_coursedomain is defined and is inconsistent with  # Request invalid if custom_coursedomain is defined and is inconsistent with
Line 179  sub handler { Line 205  sub handler {
                 $mapurl = $tail;                  $mapurl = $tail;
             } else {              } else {
                 $symb = $tail;                  $symb = $tail;
                 $symb =~ s{^/+}{};                  $symb =~ s{^/}{};
               }
           } elsif ($tail =~ m{^/res/(?:$match_domain)/(?:$match_username)/.+\.(?:sequence|page)(|___\d+___.+)$}) {
               if ($1 eq '') {
                   $mapurl = $tail;
               } else {
                   $symb = $tail;
                   $symb =~ s{^/res/}{};
             }              }
 #FIXME Need to handle encrypted URLs   
         } elsif ($tail =~ m{^/($match_domain)/($match_courseid)$}) {          } elsif ($tail =~ m{^/($match_domain)/($match_courseid)$}) {
             ($urlcdom,$urlcnum) = ($1,$2);              ($urlcdom,$urlcnum) = ($1,$2);
             if (($cdom ne '') && ($cdom ne $urlcdom)) {              if (($cdom ne '') && ($cdom ne $urlcdom)) {
                 &invalid_request($r,4);                  &invalid_request($r,4);
                 return OK;                  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 '')) {           if (($cdom eq '') && ($urlcdom ne '')) { 
             my $cprimary_id = &Apache::lonnet::domain($urlcdom,'primary');              my $cprimary_id = &Apache::lonnet::domain($urlcdom,'primary');
Line 217  sub handler { Line 270  sub handler {
     
     my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');      my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
     unless (keys(%lti) > 0) {      unless (keys(%lti) > 0) {
         &invalid_request($r,5);          &invalid_request($r,6);
         return OK;          return OK;
     }      }
     my %lti_by_key;      my %lti_by_key;
Line 241  sub handler { Line 294  sub handler {
         $protocol = 'https';          $protocol = 'https';
     }      }
   
     my ($itemid,$key,$secret,@ltiroles);      if (exists($params->{'oauth_callback'})) {
     $key = $params->{'oauth_consumer_key'};          $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0A;
     if (ref($lti_by_key{$key}) eq 'ARRAY') {      } else {
         foreach my $id (@{$lti_by_key{$key}}) {          $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0;
       }
   
       my ($itemid,$consumer_key,$secret);
       $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') {              if (ref($lti{$id}) eq 'HASH') {
                 $secret = $lti{$id}{'secret'};                  $secret = $lti{$id}{'secret'};
                 my $request = Net::OAuth->request('request token')->from_hash($params,                  my $request = Net::OAuth->request('request token')->from_hash($params,
Line 265  sub handler { Line 324  sub handler {
 # configuration in LON-CAPA for that LTI Consumer.  # configuration in LON-CAPA for that LTI Consumer.
 #  #
     unless (($itemid) && (ref($lti{$itemid}) eq 'HASH')) {      unless (($itemid) && (ref($lti{$itemid}) eq 'HASH')) {
         &invalid_request($r,6);          &invalid_request($r,7);
         return OK;          return OK;
     }      }
   
Line 275  sub handler { Line 334  sub handler {
 #  #
     unless (&LONCAPA::ltiutils::check_nonce($params->{'oauth_nonce'},$params->{'oauth_timestamp'},      unless (&LONCAPA::ltiutils::check_nonce($params->{'oauth_nonce'},$params->{'oauth_timestamp'},
                                             $lti{$itemid}{'lifetime'},$cdom,$r->dir_config('lonLTIDir'))) {                                              $lti{$itemid}{'lifetime'},$cdom,$r->dir_config('lonLTIDir'))) {
         &invalid_request($r,7);          &invalid_request($r,8);
         return OK;          return OK;
     }      }
   
 #  #
 # Determinine if source of username matches requirement from the   # Determine if a username is required from the domain
   # configuration for the specific LTI Consumer
   #
   
       if (!$lti{$itemid}{'requser'}) {
           if ($tail =~ m{^/tiny/($match_domain)/(\w+)$}) {
               foreach my $key (%{$params}) {
                   delete($env{'form.'.$key});
               }
               my $ltoken = &Apache::lonnet::tmpput({'linkprot' => $itemid.':'.$tail},
                                                      $lonhost);
               if ($ltoken) {
                   $r->internal_redirect($tail.'?ltoken='.$ltoken);
                   $r->set_handlers('PerlHandler'=> undef);
               } else {
                   &invalid_request($r,9);    
               }
           } else {
               &invalid_request($r,10);
           }
           return OK;
       }
   
   #
   # Determine if source of username matches requirement from the 
 # domain configuration for the specific LTI Consumer.  # domain configuration for the specific LTI Consumer.
 #   # 
   
Line 308  sub handler { Line 391  sub handler {
 #  #
 # (a) from course mapping (if the link between Consumer "course" and   # (a) from course mapping (if the link between Consumer "course" and 
 # Provider "course" has been established previously).  # Provider "course" has been established previously).
 # (b) from tail of requested URL (after /adm/lti) if it has format of a symb  # (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  # (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  # (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/...  # (e) from tail of requested URL (after /adm/lti) if it has format /tiny/domain/\w+
 # i.e., a shortened URL (see bug #6400) -- not implemented yet.  #     i.e., a shortened URL (see bug #6400).
 #  #
 # If Consumer course included in POSTed data points as a target course which  # 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  # has a format which matches a LON-CAPA courseID, but the course does not
Line 335  sub handler { Line 418  sub handler {
             if ($consumers{$sourcecrs} =~ /^$match_courseid$/) {              if ($consumers{$sourcecrs} =~ /^$match_courseid$/) {
                 my $crshome = &Apache::lonnet::homeserver($consumers{$sourcecrs},$cdom);                  my $crshome = &Apache::lonnet::homeserver($consumers{$sourcecrs},$cdom);
                 if ($crshome =~ /(con_lost|no_host|no_such_host)/) {                  if ($crshome =~ /(con_lost|no_host|no_such_host)/) {
                     &invalid_request($r,8);                      &invalid_request($r,11);
                     return OK;                      return OK;
                 } else {                  } else {
                     $posscnum = $consumers{$sourcecrs};                      $posscnum = $consumers{$sourcecrs};
Line 347  sub handler { Line 430  sub handler {
     if ($urlcnum ne '') {      if ($urlcnum ne '') {
         if ($posscnum ne '') {          if ($posscnum ne '') {
             if ($posscnum ne $urlcnum) {              if ($posscnum ne $urlcnum) {
                 &invalid_request($r,9);                  &invalid_request($r,12);
                 return OK;                  return OK;
             } else {              } else {
                 $cnum = $posscnum;                  $cnum = $posscnum;
Line 355  sub handler { Line 438  sub handler {
         } else {          } else {
             my $crshome = &Apache::lonnet::homeserver($urlcnum,$cdom);              my $crshome = &Apache::lonnet::homeserver($urlcnum,$cdom);
             if ($crshome =~ /(con_lost|no_host|no_such_host)/) {              if ($crshome =~ /(con_lost|no_host|no_such_host)/) {
                 &invalid_request($r,10);                  &invalid_request($r,13);
                 return OK;                  return OK;
             } else {              } else {
                 $cnum = $urlcnum;                  $cnum = $urlcnum;
Line 366  sub handler { Line 449  sub handler {
     }      }
   
 #  #
 # Get LON-CAPA role to use from role-mapping of Consumer roles  # Get LON-CAPA role(s) to use from role-mapping of Consumer roles
 # defined in domain configuration for the appropriate LTI  # defined in domain configuration for the appropriate LTI
 # Consumer.  # Consumer.
 #  #
 # If multiple LON-CAPA roles are indicated, choose based  # If multiple LON-CAPA roles are indicated for the current user,
 # on the order: cc, in, ta, ep, st  # ordering (from first to last) is: cc/co, in, ta, ep, st.
 #  #
   
     my $reqrole;      my (@ltiroles,@lcroles);
       my @lcroleorder = ('cc','in','ta','ep','st');
     my @roleorder = ('cc','in','ta','ep','st');      my ($lcrolesref,$ltirolesref) = 
     if ($params->{'roles'} =~ /,/) {          &LONCAPA::ltiutils::get_lc_roles($params->{'roles'},
         @ltiroles = split(/\s*,\s*/,$params->{'role'});                                           \@lcroleorder,
     } else {                                           $lti{$itemid}{maproles});
         my $singlerole = $params->{'roles'};      if (ref($lcrolesref) eq 'ARRAY') {
         $singlerole =~ s/^\s|\s+$//g;          @lcroles = @{$lcrolesref};
         @ltiroles = ($singlerole);      }
     }      if (ref($ltirolesref) eq 'ARRAY') {
     if (@ltiroles) {          @ltiroles = @{$ltirolesref};
         if (ref($lti{$itemid}{maproles}) eq 'HASH') {  
             my %possroles;  
             map { $possroles{$lti{$itemid}{maproles}{$_}} = 1; } @ltiroles;  
             my @possibles = keys(%possroles);  
             if (@possibles == 1) {  
                 if (grep(/^\Q$possibles[0]\E$/,@roleorder)) {  
                     $reqrole = $possibles[0];  
   
                 }  
             } elsif (@possibles > 1) {  
                 foreach my $item (@roleorder) {  
                     if ($possroles{$item}) {  
                         $reqrole = $item;  
                         last;  
                     }  
                 }  
             }  
         }  
     }      }
   
 #  #
Line 419  sub handler { Line 484  sub handler {
                     foreach my $ltirole (@ltiroles) {                      foreach my $ltirole (@ltiroles) {
                         if (grep(/^\Q$ltirole\E$/,@{$lti{$itemid}{'makeuser'}})) {                          if (grep(/^\Q$ltirole\E$/,@{$lti{$itemid}{'makeuser'}})) {
                             $selfcreate = 1;                              $selfcreate = 1;
                               last;
                         }                          }
                     }                      }
                 }                  }
             }              }
             if ($selfcreate) {              if ($selfcreate) {
 #FIXME Do user creation here.                  my (%rulematch,%inst_results,%curr_rules,%got_rules,%alerts);
                 return OK                  my $domdesc = &Apache::lonnet::domain($udom,'description');
                   my %data = (
                       'permanentemail' => $env{'form.lis_person_contact_email_primary'},
                       'firstname'      => $env{'form.lis_person_name_given'},
                       'lastname'       => $env{'form.lis_person_name_family'},
                       'fullname'       => $env{'form.lis_person_name_full'},
                   );
                   my $result =
                       &LONCAPA::ltiutils::create_user($lti{$itemid},$uname,$udom,
                                                       $domdesc,\%data,\%alerts,\%rulematch,
                                                       \%inst_results,\%curr_rules,%got_rules);
                   if ($result eq 'notallowed') {
                       &invalid_request($r,14);
                   } elsif ($result eq 'ok') {
                       if (($ltiroles[0] eq 'Instructor') && ($lcroles[0] eq 'cc') && ($lti{$itemid}{'mapcrs'}) &&
                           ($lti{$itemid}{'makecrs'})) {
                           unless (&Apache::lonnet::usertools_access($uname,$udom,'lti','reload','requestcourses')) {
                               &Apache::lonnet::put('environment',{ 'requestcourses.lti' => 'autolimit=', },$udom,$uname);
                           }
                       }
                   } else {
                       &invalid_request($r,15);
                       return OK;
                   }
             } else {              } else {
                 &invalid_request($r,11);                  &invalid_request($r,16);
                 return OK;                  return OK;
             }               }
         }           }
     } else {      } else {
         &invalid_request($r,12);          &invalid_request($r,17);
         return OK;          return OK;
     }      }
   
 #  #
 # If no LON-CAPA course available, check if domain's configuration  # If no LON-CAPA course available, check if domain's configuration
 # for the specific LTI Consumer allows a new course to be created   # for the specific LTI Consumer allows a new course to be created 
 # (requires role in Consumer to be: Instructor).  # (requires role in Consumer to be: Instructor and Instructor to map to CC)
 #  #
   
       my $reqcrs;
     if ($cnum eq '') {      if ($cnum eq '') {
         if ((@ltiroles) && (grep(/^Instructor$/,@ltiroles)) &&          if ((@ltiroles) && ($lti{$itemid}{'mapcrs'}) &&
             ($lti{$itemid}{'mapcrs'})) {              ($ltiroles[0] eq 'Instructor') && ($lcroles[0] eq 'cc') && ($lti{$itemid}{'makecrs'})) {
 #FIXME Create a new LON-CAPA course here.              my (%can_request,%request_domains);
             return OK;              &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,18);
               }
         } else {          } else {
             &invalid_request($r,13);              &invalid_request($r,19);
             return OK;   
         }          }
           return OK;
     }      }
   
 #  #
Line 458  sub handler { Line 556  sub handler {
 # indicated is cc, change role indicated to co.  # indicated is cc, change role indicated to co.
 #   # 
   
     if ($reqrole eq 'cc') {      my %crsenv;
       if ($lcroles[0] eq 'cc') {
         if (($cdom ne '') && ($cnum ne '')) {          if (($cdom ne '') && ($cnum ne '')) {
             my %crsenv = &Apache::lonnet::coursedescription($cnum.'_'.$cdom,{ 'one_time' => 1,});              %crsenv = &Apache::lonnet::coursedescription($cdom.'_'.$cnum,{ 'one_time' => 1,});
             if ($crsenv{'type'} eq 'Community') {              if ($crsenv{'type'} eq 'Community') {
                 $reqrole = 'co';                   $lcroles[0] = 'co';
             }              }
         }          }
     }      }
   
 #  #
 # Determine if user has required LON-CAPA role  # Determine if user has a LON-CAPA role in the mapped LON-CAPA course.
 # in the mapped LON-CAPA course.  # If multiple LON-CAPA roles are available for the user's assigned LTI roles,
   # choose the first available LON-CAPA role in the order: cc/co, in, ta, ep, st
 #  #
   
     my $role;      my ($role,$usec,$withsec);
     my %crsroles = &Apache::lonnet::get_my_roles($uname,$udom,'userroles',undef,[$reqrole],[$cdom]);      unless ((($lcroles[0] eq 'cc') || ($lcroles[0] eq 'co')) && (@lcroles == 1)) {
     if (exists($crsroles{$cnum.':'.$cdom.':'.$reqrole})) {          if ($lti{$itemid}{'section'} ne '') {
         $role = $reqrole.'./'.$cdom.'/'.$cnum;              if ($lti{$itemid}{'section'} eq 'course_section_sourcedid') {
 #FIXME Need to accommodate sections                  if ($env{'form.course_section_sourcedid'} !~ /\W/) {
     } elsif (ref($lti{$itemid}{'selfenroll'}) eq 'ARRAY') {                      $usec = $env{'form.course_section_sourcedid'};
         if (grep(/^\Q$reqrole\E$/,@{$lti{$itemid}{'selfenroll'}})) {                  }
 #FIXME Do self-enrollment here              } elsif ($env{'form.'.$lti{$itemid}{'section'}} !~ /\W/) {
                   $usec = $env{'form.'.$lti{$itemid}{'section'}};
               }
           }
           if ($usec ne '') {
               $withsec = 1;
           }
       }
   
       if (@lcroles) {
           my %crsroles = &Apache::lonnet::get_my_roles($uname,$udom,'userroles',undef,\@lcroles,
                                                        [$cdom],$withsec);
           foreach my $reqrole (@lcroles) {
               if ($withsec) {
                   my $incsec;
                   if (($reqrole eq 'cc') || ($reqrole eq 'co')) {
                       $incsec = '';
                   } else {
                       $incsec = $usec;
                   }
                   if (exists($crsroles{$cnum.':'.$cdom.':'.$reqrole.':'.$incsec})) {
                       $role = $reqrole.'./'.$cdom.'/'.$cnum;
                       if ($incsec ne '') {
                           $role .= '/'.$usec;
                       }
                       last;
                   }
               } else {
                   if (exists($crsroles{$cnum.':'.$cdom.':'.$reqrole})) {
                       $role = $reqrole.'./'.$cdom.'/'.$cnum;
                       last;
                   }
               }
           }
       }
   
   #
   # Determine if user can selfenroll
   #
   
       my ($reqrole,$selfenrollrole);
       if ($role eq '') {
           if ((@ltiroles) && (ref($lti{$itemid}{'selfenroll'}) eq 'ARRAY')) {
               foreach my $ltirole (@ltiroles) {
                   if (grep(/^\Q$ltirole\E$/,@{$lti{$itemid}{'selfenroll'}})) {
                       if (ref($lti{$itemid}{maproles}) eq 'HASH') {
                           $reqrole = $lti{$itemid}{maproles}{$ltirole};
                           last;
                       }
                   }
               }
           }
           if ($reqrole eq '') {
               &invalid_request($r,20);
             return OK;              return OK;
         } else {          } else {
             &invalid_request($r,14);              unless (%crsenv) {
                   %crsenv = &Apache::lonnet::coursedescription($cdom.'_'.$cnum);
               }
               my $default_enrollment_start_date = $crsenv{'default_enrollment_start_date'};
               my $default_enrollment_end_date   = $crsenv{'default_enrollment_end_date'};
               my $now = time;
               if ($default_enrollment_end_date && $default_enrollment_end_date <= $now) {
                   &invalid_request($r,21);
                   return OK;
               } elsif ($default_enrollment_start_date && $default_enrollment_start_date >$now) {
                   &invalid_request($r,22);
                   return OK;
               } else {
                   $selfenrollrole = $reqrole.'./'.$cdom.'/'.$cnum;
                   if (($withsec) && ($reqrole ne 'cc') && ($reqrole ne 'co')) {
                       if ($usec ne '') {
                           $selfenrollrole .= '/'.$usec;
                       }
                   }
               }
         }          }
     }      }
   
 #  #
 # Store consumer-to-LON-CAPA course mapping  # Store consumer-to-LON-CAPA course mapping
 #  #
   
     if (($sourcecrs ne '')  && ($consumers{$sourcecrs} eq '') && ($cnum ne '')) {      if (($sourcecrs ne '')  && ($consumers{$sourcecrs} eq '') && ($cnum ne '')) {
         &Apache::lonnet::put_dom('lticonsumers',{ $sourcecrs => $cnum },$cdom);          &Apache::lonnet::put_dom('lticonsumers',{ $sourcecrs => $cnum },$cdom);
     }      }
   
 #  #
 # Check if user should be hosted here or switched to another server.  # Start user session
 #  #
   
     &Apache::lonnet::logthis(" LTI authorized user: $uname:$udom role: $role course: $cnum:$cdom");      &lti_session($r,$itemid,$uname,$udom,$uhome,$lonhost,$role,$mapurl,$tail,$symb,
                    $cdom,$cnum,$params,\@ltiroles,$lti{$itemid},\@lcroles,undef,$sourcecrs,
                    $selfenrollrole);
       return OK;
   }
   
   sub lti_enroll {
       my ($uname,$udom,$selfenrollrole) = @_;
       my $enrollresult;
       my ($role,$cdom,$cnum,$sec) =
              ($selfenrollrole =~ m{^(\w+)\./($match_domain)/($match_courseid)(?:|/(\w*))$});
       if (($cnum ne '') && ($cdom ne '')) {
           my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
           if ($chome ne 'no_host') {
               my %coursehash = &Apache::lonnet::coursedescription($cdom.'_'.$cnum);
               my $start = $coursehash{'default_enrollment_start_date'};
               my $end = $coursehash{'default_enrollment_end_date'};
               $enrollresult = &LONCAPA::ltiutils::enrolluser($udom,$uname,$role,$cdom,$cnum,$sec,
                                                              $start,$end,1);
           }
       }
       return $enrollresult;
   }
   
   sub lti_reqcrs {
       my ($r,$cdom,$form,$uname,$udom) = @_;
       my (%can_request,%request_domains);
       &Apache::lonnet::check_can_request($cdom,\%can_request,\%request_domains,$uname,$udom);
       if ($can_request{'lti'}) {
           my %domconfig = &Apache::lonnet::get_dom('configuration',['requestcourses'],$cdom);
           my %domdefs = &Apache::lonnet::get_domain_defaults($cdom);
           &Apache::lonrequestcourse::print_textbook_form($r,$cdom,[$cdom],\%domdefs,
                                                          $domconfig{'requestcourses'},
                                                          \%can_request,'lti',$form);
       } else {
           $r->print(
                 &Apache::loncommon::start_page('Invalid LTI call',undef,{'only_body' => 1}).
                 &mt('Invalid LTI call').
                 &Apache::loncommon::end_page()
           );
       }
   }
   
   sub lti_session {
       my ($r,$itemid,$uname,$udom,$uhome,$lonhost,$role,$mapurl,$tail,$symb,$cdom,$cnum,
           $params,$ltiroles,$ltihash,$lcroles,$reqcrs,$sourcecrs,$selfenrollrole) = @_;
       return unless ((ref($params) eq 'HASH') && (ref($ltiroles) eq 'ARRAY') &&
                      (ref($ltihash) eq 'HASH') && (ref($lcroles) eq 'ARRAY'));
   #
   # Check if user should be hosted here or switched to another server.
   #
     $r->user($uname);      $r->user($uname);
       if ($cnum) {
           if ($role) {
               &Apache::lonnet::logthis(" LTI authorized user ($itemid): $uname:$udom, role: $role, course: $cdom\_$cnum");
           } elsif ($selfenrollrole =~ m{^(\w+)\./$cdom/$cnum}) {
               &Apache::lonnet::logthis(" LTI authorized user ($itemid): $uname:$udom, desired role: $1 course: $cdom\_$cnum");
           }
       } else {
           &Apache::lonnet::logthis(" LTI authorized user ($itemid): $uname:$udom, course dom: $cdom");
       }
     my ($is_balancer,$otherserver,$hosthere);      my ($is_balancer,$otherserver,$hosthere);
     ($is_balancer,$otherserver) =      ($is_balancer,$otherserver) =
         &Apache::lonnet::check_loadbalancing($uname,$udom,'login');          &Apache::lonnet::check_loadbalancing($uname,$udom,'login');
Line 522  sub handler { Line 754  sub handler {
         &Apache::lonauth::success($r,$uname,$udom,$uhome,'noredirect');          &Apache::lonauth::success($r,$uname,$udom,$uhome,'noredirect');
         if ($symb) {          if ($symb) {
             $env{'form.symb'} = $symb;              $env{'form.symb'} = $symb;
               $env{'request.lti.uri'} = $tail;
           } else {
               if ($mapurl) {
                   $env{'form.origurl'} = $mapurl;
                   $env{'request.lti.uri'} = $mapurl;
               } elsif ($tail =~ m{^\Q/tiny/$cdom/\E\w+$}) {
                   $env{'form.origurl'} = $tail;
                   $env{'request.lti.uri'} = $tail;
               } elsif ($tail eq "/$cdom/$cnum") {
                   $env{'form.origurl'} = '/adm/navmaps';
                   $env{'request.lti.uri'} = $tail;
               } else {
                   unless ($tail eq '/adm/roles') {
                       $env{'form.origurl'} = '/adm/navmaps';
                   }
               }
         }          }
         if ($role) {          if ($role) {
             $env{'form.role'} = $role;              $env{'form.role'} = $role;
         }          }
         if ($lti{$itemid}{'passback'}) {          if (($lcroles->[0] eq 'cc') && ($reqcrs)) {
               $env{'request.lti.reqcrs'} = 1;
               $env{'request.lti.reqrole'} = 'cc';
               $env{'request.lti.sourcecrs'} = $sourcecrs;
           }
           if ($selfenrollrole) {
               $env{'request.lti.selfenroll'} = $selfenrollrole;
               $env{'request.lti.sourcecrs'} = $sourcecrs;
           }
           if ($ltihash->{'passback'}) {
             if ($params->{'lis_result_sourcedid'}) {              if ($params->{'lis_result_sourcedid'}) {
                 $env{'request.lti.passbackid'} = $params->{'lis_result_sourcedid'};                  $env{'request.lti.passbackid'} = $params->{'lis_result_sourcedid'};
             }              }
Line 534  sub handler { Line 791  sub handler {
                 $env{'request.lti.passbackurl'} = $params->{'lis_outcome_service_url'};                  $env{'request.lti.passbackurl'} = $params->{'lis_outcome_service_url'};
             }              }
         }          }
         if (($lti{$itemid}{'roster'}) && (grep(/^Instructor$/,@ltiroles))) {          if (($ltihash->{'roster'}) && (grep(/^Instructor$/,@{$ltiroles}))) {
             if ($params->{'ext_ims_lis_memberships_id'}) {              if ($params->{'ext_ims_lis_memberships_id'}) {
                 $env{'request.lti.rosterid'} = $params->{'ext_ims_lis_memberships_id'};                   $env{'request.lti.rosterid'} = $params->{'ext_ims_lis_memberships_id'};
             }              }
             if ($params->{'ext_ims_lis_memberships_url'}) {              if ($params->{'ext_ims_lis_memberships_url'}) {
                 $env{'request.lti.rosterurl'} = $params->{'ext_ims_lis_memberships_url'};                  $env{'request.lti.rosterurl'} = $params->{'ext_ims_lis_memberships_url'};
             }              }
         }          }
         $env{'request.lti.login'} = 1;          $env{'request.lti.login'} = $itemid;
           if ($params->{'launch_presentation_document_target'}) {
               $env{'request.lti.target'} = $params->{'launch_presentation_document_target'};
           }
         foreach my $key (%{$params}) {          foreach my $key (%{$params}) {
             delete($env{'form.'.$key});              delete($env{'form.'.$key});
         }          }
Line 563  sub handler { Line 823  sub handler {
                   'domain'    => $udom,                    'domain'    => $udom,
                   'username'  => $uname,                    'username'  => $uname,
                   'server'    => $lonhost,                    'server'    => $lonhost,
                   'lti.login' => 1,                    'lti.login' => $itemid,
                     'lti.uri'   => $tail,
                  );                   );
         if ($role) {          if ($role) {
             $info{'role'} = $role;              $info{'role'} = $role;
         }          }
         if ($symb) {          if ($symb) {
             $info{'symb'} = $symb;               $info{'symb'} = $symb;
         }          }
         if ($lti{$itemid}{'passback'}) {          if (($lcroles->[0] eq 'cc') && ($reqcrs)) {
               $info{'lti.reqcrs'} = 1;
               $info{'lti.reqrole'} = 'cc';
               $info{'lti.sourcecrs'} = $sourcecrs;
           }
           if ($selfenrollrole) {
               $info{'lti.selfenrollrole'} = $selfenrollrole;
           }
           if ($ltihash->{'passback'}) {
             if ($params->{'lis_result_sourcedid'}) {              if ($params->{'lis_result_sourcedid'}) {
                 $info{'lti.passbackid'} = $params->{'lis_result_sourcedid'}                  $info{'lti.passbackid'} = $params->{'lis_result_sourcedid'}
             }              }
Line 579  sub handler { Line 848  sub handler {
                 $info{'lti.passbackurl'} = $params->{'lis_outcome_service_url'}                  $info{'lti.passbackurl'} = $params->{'lis_outcome_service_url'}
             }              }
         }          }
         if (($lti{$itemid}{'roster'}) && (grep(/^Instructor$/,@ltiroles))) {          if (($ltihash->{'roster'}) && (grep(/^Instructor$/,@{$ltiroles}))) {
             if ($params->{'ext_ims_lis_memberships_id'}) {              if ($params->{'ext_ims_lis_memberships_id'}) {
                 $info{'lti.rosterid'} = $params->{'ext_ims_lis_memberships_id'};                  $info{'lti.rosterid'} = $params->{'ext_ims_lis_memberships_id'};
             }              }
Line 587  sub handler { Line 856  sub handler {
                 $info{'lti.rosterurl'} = $params->{'ext_ims_lis_memberships_url'};                  $info{'lti.rosterurl'} = $params->{'ext_ims_lis_memberships_url'};
             }              }
         }          }
           if ($params->{'launch_presentation_document_target'}) {
               $info{'lti.target'} = $params->{'launch_presentation_document_target'};
           }
   
         unless ($info{'symb'}) {          unless ($info{'symb'}) {
             if ($mapurl) {              if ($mapurl) {
                 $info{'origurl'} = $mapurl;                  $info{'origurl'} = $mapurl;
                 if ($mapurl =~ m{/default_\d+\.sequence$}) {              } elsif ($tail =~ m{^\Q/tiny/$cdom/\E\w+$}) {
                     $info{'origurl'} .=  (($mapurl =~/\?/)?'&':'?').'navmap=1';                  $info{'origurl'} = $tail;
                 }  
             } else {              } else {
                 unless ($tail eq '/adm/roles') {                  unless ($tail eq '/adm/roles') {
                     $info{'origurl'} = '/adm/navmaps';                      $info{'origurl'} = '/adm/navmaps';
Line 607  sub handler { Line 879  sub handler {
         $r->internal_redirect('/adm/migrateuser');          $r->internal_redirect('/adm/migrateuser');
         $r->set_handlers('PerlHandler'=> undef);          $r->set_handlers('PerlHandler'=> undef);
     }      }
     return OK;      return;
 }  }
   
 sub invalid_request {  sub invalid_request {
Line 619  sub invalid_request { Line 891  sub invalid_request {
     }      }
     &Apache::lonlocal::get_language_handle($r);      &Apache::lonlocal::get_language_handle($r);
     $r->print(      $r->print(
         &Apache::loncommon::start_page('Invalid LTI call').          &Apache::loncommon::start_page('Invalid LTI call','',{ 'only_body' => 1,}).
         &mt('Invalid LTI call [_1]',$num).          &mt('Invalid LTI call [_1]',$num).
         &Apache::loncommon::end_page());          &Apache::loncommon::end_page());
     return;      return;
Removed from v.1.2  
changed lines
  Added in v.1.17

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.