File:  [LON-CAPA] / loncom / lti / ltiauth.pm
Revision 1.40: download - view: text, annotated - select for diffs
Tue Jul 12 22:55:46 2022 UTC (23 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD
- On a balancer node, if LON-CAPA is an LTI Provider or if deep link access
  with LTI mediated link protection is in use, check for balancer cookie
  after credentials in LTI payload validated.

    1: # The LearningOnline Network
    2: # Basic LTI Authentication Module
    3: #
    4: # $Id: ltiauth.pm,v 1.40 2022/07/12 22:55:46 raeburn Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: 
   29: package Apache::ltiauth;
   30: 
   31: use strict;
   32: use LONCAPA qw(:DEFAULT :match);
   33: use Encode;
   34: use Apache::Constants qw(:common :http :remotehost);
   35: use Apache::lonlocal;
   36: use Apache::lonnet;
   37: use Apache::loncommon;
   38: use Apache::lonacc;
   39: use Apache::lonrequestcourse;
   40: use LONCAPA::ltiutils;
   41: 
   42: sub handler {
   43:     my $r = shift;
   44:     my $requri = $r->uri;
   45:     my $hostname = $r->hostname;
   46: #
   47: # Check for existing session, and temporarily delete any form items
   48: # in %env, if session exists
   49: #
   50:     my %savedform;
   51:     my $handle = &Apache::lonnet::check_for_valid_session($r);
   52:     if ($handle ne '') {
   53:         foreach my $key (sort(keys(%env))) {
   54:             if ($key =~ /^form\.(.+)$/) {
   55:                 $savedform{$1} = $env{$key};
   56:                 delete($env{$key});
   57:             }
   58:         }
   59:     }
   60: #
   61: # Retrieve data POSTed by LTI launch
   62: #
   63:     &Apache::lonacc::get_posted_cgi($r);
   64:     my $params = {};
   65:     foreach my $key (sort(keys(%env))) {
   66:         if ($key =~ /^form\.(.+)$/) {
   67:             $params->{$1} = &Encode::decode('UTF-8',$env{$key});
   68:         }
   69:     }
   70: #
   71: # Check for existing session, and restore temporarily
   72: # deleted form items to %env, if session exists.
   73: #
   74:     if ($handle ne '') {
   75:         if (keys(%savedform)) {
   76:             foreach my $key (sort(keys(%savedform))) {
   77:                 $env{'form.'.$key} = $savedform{$key};
   78:             }
   79:         }
   80:     }
   81: 
   82:     unless (keys(%{$params})) {
   83:         &invalid_request($r,'No parameters included in launch request');
   84:         return OK;
   85:     }
   86: 
   87:     unless ($params->{'oauth_consumer_key'} &&
   88:             $params->{'oauth_nonce'} &&
   89:             $params->{'oauth_timestamp'} &&
   90:             $params->{'oauth_version'} &&
   91:             $params->{'oauth_signature'} &&
   92:             $params->{'oauth_signature_method'}) {
   93:         &invalid_request($r,'One or more required parameters missing from launch request');
   94:         return OK;
   95:     }
   96: 
   97: #
   98: # Retrieve "internet domains" for all this institution's LON-CAPA
   99: # nodes.
  100: #
  101:     my @intdoms;
  102:     my $lonhost = $r->dir_config('lonHostID');
  103:     my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
  104:     if (ref($internet_names) eq 'ARRAY') {
  105:         @intdoms = @{$internet_names};
  106:     }
  107: #
  108: # Determine course's domain in LON-CAPA
  109: # for basic launch using key and secret managed
  110: # in LON-CAPA course (i.e., uri begins /adm/launch)
  111: #
  112: 
  113:    my ($cdom,$cnum);
  114: 
  115: # Note: "internet domain" for course's domain must be one of the
  116: # internet domains for the institution's LON-CAPA servers.
  117: #
  118:     if ($requri =~ m{^/adm/launch(|/.*)$}) {
  119:         my $tail = $1;
  120:         if ($tail =~ m{^/tiny/$match_domain/\w+$}) {
  121:             my ($urlcdom,$urlcnum) = &course_from_tinyurl($tail);
  122:             if (($urlcdom ne '') && ($urlcnum ne '')) {
  123:                 $cdom = $urlcdom;
  124:                 $cnum = $urlcnum;
  125:                 my $primary_id = &Apache::lonnet::domain($cdom,'primary');
  126:                 if ($primary_id ne '') {
  127:                     my $intdom = &Apache::lonnet::internet_dom($primary_id);
  128:                     if (($intdom ne '') && (grep(/^\Q$intdom\E$/,@intdoms))) {
  129: #
  130: # Verify the signed request using the secret for LTI link
  131: # protectors for which the key in the POSTed data matches
  132: # keys in the course configuration.
  133: #
  134: # Request is invalid if the signed request could not be verified
  135: # for the key and secret from LON-CAPA course configuration for
  136: # LTI link protectors or from LON-CAPA configuration for the
  137: # course's domain if there are LTI Providers which may be used.
  138: #
  139: # Determine if nonce in POSTed data has expired.
  140: # If unexpired, confirm it has not already been used.
  141: #
  142: # Retrieve information for LTI link protectors in course
  143: # where url was /adm/launch/tiny/$cdom/$uniqueid
  144: #
  145: 
  146:                         my ($itemid,$ltitype,%crslti,%lti_in_use,$ltiuser);
  147:                         $itemid = &get_lti_itemid($requri,$hostname,$params,$cdom,$cnum,'linkprot');
  148:                         if ($itemid) {
  149:                             %crslti = &Apache::lonnet::get_course_lti($cnum,$cdom);
  150:                         }
  151:                         if (($itemid) && (ref($crslti{$itemid}) eq 'HASH')) {
  152:                             $ltitype = 'c';
  153:                             if (&LONCAPA::ltiutils::check_nonce($params->{'oauth_nonce'},$params->{'oauth_timestamp'},
  154:                                                                 $crslti{$itemid}{'lifetime'},$cdom,$r->dir_config('lonLTIDir'))) {
  155:                                 %lti_in_use = %{$crslti{$itemid}};
  156:                             } else {
  157:                                 &invalid_request($r,'Time limit exceeded for launch request credentials');
  158:                                 return OK;
  159:                             }
  160:                         } else {
  161:                             $itemid = &get_lti_itemid($requri,$hostname,$params,$cdom,'','linkprot');
  162:                             my %lti;
  163:                             if ($itemid) {
  164:                                 %lti = &Apache::lonnet::get_domain_lti($cdom,'linkprot');
  165:                             }
  166:                             if (($itemid) && (ref($lti{$itemid}) eq 'HASH')) {
  167:                                 $ltitype = 'd';
  168:                                 if (&LONCAPA::ltiutils::check_nonce($params->{'oauth_nonce'},$params->{'oauth_timestamp'},
  169:                                                                         $lti{$itemid}{'lifetime'},$cdom,
  170:                                                                         $r->dir_config('lonLTIDir'))) {
  171:                                     %lti_in_use = %{$lti{$itemid}};
  172:                                 } else {
  173:                                     &invalid_request($r,'Time limit exceeded for launch request credentials');
  174:                                     return OK;
  175:                                 }
  176:                             }
  177:                         }
  178:                         my $exiturl;
  179:                         if (($itemid) && ($lti_in_use{'returnurl'} ne '')) {
  180:                             if (exists($params->{$lti_in_use{'returnurl'}})) {
  181:                                 $exiturl = $params->{$lti_in_use{'returnurl'}};
  182:                             } elsif (exists($params->{'custom_'.$lti_in_use{'returnurl'}})) {
  183:                                 $exiturl = $params->{'custom_'.$lti_in_use{'returnurl'}};
  184:                             }
  185:                         }
  186:                         if (($itemid) && ($lti_in_use{'requser'})) {
  187:                             my %courseinfo = &Apache::lonnet::coursedescription($cdom.'_'.$cnum);
  188:                             my $ltiauth;
  189:                             if (exists($courseinfo{'internal.ltiauth'})) {
  190:                                 $ltiauth = $courseinfo{'internal.ltiauth'};
  191:                             } else {
  192:                                 my %domdefs = &Apache::lonnet::get_domain_defaults($cdom);
  193:                                 $ltiauth = $domdefs{'crsltiauth'};
  194:                             }
  195:                             if ($ltiauth) {
  196:                                 my $possuname;
  197:                                 my $mapuser = $lti_in_use{'mapuser'};
  198:                                 if ($mapuser eq 'sourcedid') {
  199:                                     if ($params->{'lis_person_sourcedid'} =~ /^$match_username$/) {
  200:                                         $possuname = $params->{'lis_person_sourcedid'};
  201:                                     }
  202:                                 } elsif ($mapuser eq 'email') {
  203:                                     if ($params->{'lis_person_contact_email_primary'} =~ /^$match_username$/) {
  204:                                         $possuname = $params->{'lis_person_contact_email_primary'};
  205:                                     }
  206:                                 } elsif (exists($params->{$mapuser})) {
  207:                                     if ($params->{$mapuser} =~ /^$match_username$/) {
  208:                                         $possuname = $params->{$mapuser};
  209:                                     }
  210:                                 }
  211:                                 if ($possuname ne '') {
  212:                                     my $uhome = &Apache::lonnet::homeserver($possuname,$cdom);
  213:                                     unless ($uhome eq 'no_host') {
  214:                                         my $uname = $possuname;
  215:                                         my ($is_student,$is_nonstudent);
  216:                                         my %course_roles =
  217:                                             &Apache::lonnet::get_my_roles($uname,$cdom,,'userroles',['active'],
  218:                                                                           ['cc','co','in','ta','ep','ad','st','cr'],
  219:                                                                           [$cdom]);
  220:                                         foreach my $key (keys(%course_roles)) {
  221:                                             my ($trest,$tdomain,$trole,$sec) = split(/:/,$key);
  222:                                             if (($trest eq $cnum) && ($tdomain eq $cdom)) {
  223:                                                 if ($trole eq 'st') {
  224:                                                     $is_student = 1;
  225:                                                 } else {
  226:                                                     $is_nonstudent = 1;
  227:                                                     last;
  228:                                                 }
  229:                                             }
  230:                                         }
  231:                                         if (($is_student) && (!$is_nonstudent)) {
  232:                                             unless (&Apache::lonnet::is_advanced_user($uname,$cdom)) {
  233:                                                 foreach my $key (%{$params}) {
  234:                                                     delete($env{'form.'.$key});
  235:                                                 }
  236:                                                 &linkprot_session($r,$uname,$cnum,$cdom,$uhome,$itemid,$ltitype,$tail,$lonhost,$exiturl);
  237:                                                 return OK;
  238:                                             }
  239:                                         }
  240:                                         $ltiuser = $uname.':'.$cdom;
  241:                                     }
  242:                                 }
  243:                                 if ($lti_in_use{'notstudent'} eq 'reject') {
  244:                                     &invalid_request($r,'Information for valid user missing from launch request');
  245:                                     return OK;
  246:                                 }
  247:                             }
  248:                         }
  249:                         if ($itemid) {
  250:                             foreach my $key (%{$params}) {
  251:                                 delete($env{'form.'.$key});
  252:                             }
  253:                             my %info = (
  254:                                           'linkprot' => $itemid.$ltitype.':'.$tail,
  255:                                        );
  256:                             if ($ltiuser ne '') {
  257:                                 $info{'linkprotuser'} = $ltiuser;
  258:                             }
  259:                             if ($exiturl ne '') {
  260:                                 $info{'linkprotexit'} = $exiturl; 
  261:                             }
  262:                             my $ltoken = &Apache::lonnet::tmpput(\%info,$lonhost,'link');
  263:                             if (($ltoken eq 'con_lost') || ($ltoken eq 'refused') || ($ltoken =~ /^error:/) ||
  264:                                 ($ltoken eq 'unknown_cmd') || ($ltoken eq 'no_such_host') ||
  265:                                 ($ltoken eq '')) {
  266:                                 &invalid_request($r,'Failed to store information from launch request');
  267:                             } else {
  268:                                 $r->internal_redirect($tail.'?ltoken='.$ltoken);
  269:                                 $r->set_handlers('PerlHandler'=> undef);
  270:                             }
  271:                         } else {
  272:                             &invalid_request($r,'Launch request could not be validated');
  273:                         }
  274:                     } else {
  275:                         &invalid_request($r,'Launch unavailable on this LON-CAPA server');
  276:                     }
  277:                 } else {
  278:                     &invalid_request($r,'Launch unavailable for this domain');
  279:                 }
  280:             } else {
  281:                 &invalid_request($r,'Invalid launch URL');
  282:             }
  283:         } else {
  284:             &invalid_request($r,'Invalid launch URL');
  285:         }
  286:         return OK;
  287:     }
  288: 
  289:     my ($udom,$uname,$uhome,$symb,$mapurl);
  290: 
  291: #
  292: # For user who launched LTI in Consumer, determine user's domain in 
  293: # LON-CAPA.
  294: #
  295: # Order is:
  296: #
  297: # (a) from custom_userdomain item in POSTed data
  298: # (b) from lis_person_sourcedid in POSTed data
  299: # (c) from default "log-in" domain for node
  300: #     (can support multidomain servers, where specific domain is 
  301: #      first part of hostname).
  302: #
  303: # Note: "internet domain" for user's domain must be one of the
  304: # "internet domain(s)" for the institution's LON-CAPA servers.
  305: #
  306:     if (exists($params->{'custom_userdomain'})) {
  307:         if ($params->{'custom_userdomain'} =~ /^$match_domain$/) {
  308:             my $uprimary_id = &Apache::lonnet::domain($params->{'custom_userdomain'},'primary');
  309:             if ($uprimary_id ne '') {
  310:                 my $uintdom = &Apache::lonnet::internet_dom($uprimary_id);
  311:                 if (($uintdom ne '') && (grep(/^\Q$uintdom\E$/,@intdoms))) {
  312:                     $udom = $params->{'custom_userdomain'};
  313:                 }
  314:             }
  315:         }
  316:     }
  317:     my $defdom = &Apache::lonnet::default_login_domain();
  318:     my ($domain,$possuname,$possudom,$possmapuser);
  319:     if ($env{'form.lis_person_sourcedid'} =~ /^($match_username)\:($match_domain)$/) {
  320:         ($possuname,$possudom) = ($1,$2);
  321:         if ($udom eq '') {
  322:             my $uintdom = &Apache::lonnet::domain($possudom,'primary');
  323:             if (($uintdom ne '') && (grep(/^\Q$uintdom\E$/,@intdoms))) {
  324:                 $udom = $possudom;
  325:                 $possmapuser = 'lis_person_sourcedid';
  326:             } else {
  327:                 $udom = $defdom;
  328:             }
  329:         } elsif ($udom eq $possudom) {
  330:             $possmapuser = 'lis_person_sourcedid';
  331:         }
  332:     }
  333:     unless ($possuname) {
  334:         if ($env{'form.lis_person_sourcedid'} =~ /^$match_username$/) {
  335:             $possuname = $env{'form.lis_person_sourcedid'};
  336:             $possmapuser = 'lis_person_sourcedid';
  337:         } elsif ($env{'form.lis_person_contact_email_primary'} =~ /^$match_username$/) {
  338:             $possuname = $env{'form.lis_person_contact_email_primary'};
  339:             $possmapuser = 'lis_person_contact_email_primary';
  340:         }
  341:         unless ($udom) {
  342:             $udom = $defdom;
  343:         }
  344:     }
  345: 
  346: #
  347: # Determine course's domain in LON-CAPA
  348: #
  349: # Order is:
  350: #
  351: # (a) from custom_coursedomain item in POSTed data
  352: # (b) from tail of requested URL (after /adm/lti/) if it has format of a symb  
  353: # (c) from tail of requested URL (after /adm/lti) if it has format of a map 
  354: # (d) from tail of requested URL (after /adm/lti) if it has format /domain/courseID
  355: # (e) from tail of requested URL (after /adm/lti) if it has format /tiny/domain/\w+
  356: #     i.e., a shortened URL (see bug #6400).
  357: # (f) same as user's domain 
  358: #
  359: # Request invalid if custom_coursedomain is defined and is inconsistent with
  360: # domain contained in requested URL.
  361: #
  362: # Note: "internet domain" for course's domain must be one of the
  363: # internet domains for the institution's LON-CAPA servers.
  364: #
  365: 
  366:     if (exists($params->{'custom_coursedomain'})) {
  367:         if ($params->{'custom_coursedomain'} =~ /^$match_domain$/) {
  368:             my $cprimary_id = &Apache::lonnet::domain($params->{'custom_coursedomain'},'primary');
  369:             if ($cprimary_id ne '') {
  370:                 my $cintdom = &Apache::lonnet::internet_dom($cprimary_id);
  371:                 if (($cintdom ne '') && (grep(/^\Q$cintdom\E$/,@intdoms))) {
  372:                     $cdom = $params->{'custom_coursedomain'};
  373:                 }
  374:             }
  375:         }
  376:     }
  377: 
  378:     my ($tail) = ($requri =~ m{^/adm/lti(|/.*)$});
  379:     my $urlcnum;
  380:     if ($tail ne '') {
  381:         my $urlcdom;
  382:         if ($tail =~ m{^/uploaded/($match_domain)/($match_courseid)/(?:default|supplemental)(?:|_\d+)\.(?:sequence|page)(|___\d+___.+)$}) {
  383:             ($urlcdom,$urlcnum,my $rest) = ($1,$2,$3);
  384:             if (($cdom ne '') && ($cdom ne $urlcdom)) {
  385:                 &invalid_request($r,'Incorrect domain in requested URL');
  386:                 return OK;
  387:             }
  388:             if ($rest eq '') {
  389:                 $mapurl = $tail;
  390:             } else {
  391:                 $symb = $tail;
  392:                 $symb =~ s{^/}{};
  393:             }
  394:         } elsif ($tail =~ m{^/res/(?:$match_domain)/(?:$match_username)/.+\.(?:sequence|page)(|___\d+___.+)$}) {
  395:             if ($1 eq '') {
  396:                 $mapurl = $tail;
  397:             } else {
  398:                 $symb = $tail;
  399:                 $symb =~ s{^/res/}{};
  400:             }
  401:         } elsif ($tail =~ m{^/($match_domain)/($match_courseid)$}) {
  402:             ($urlcdom,$urlcnum) = ($1,$2);
  403:             if (($cdom ne '') && ($cdom ne $urlcdom)) {
  404:                 &invalid_request($r,'Incorrect domain in requested URL');
  405:                 return OK;
  406:             }
  407:         } elsif ($tail =~ m{^/tiny/($match_domain)/(\w+)$}) {
  408:             ($urlcdom,$urlcnum) = &course_from_tinyurl($tail);
  409:             if (($urlcdom eq '') || ($urlcnum eq '')) {
  410:                 &invalid_request($r,'Invalid URL shortcut');
  411:                 return OK;
  412:             }
  413:         }
  414:         if (($cdom eq '') && ($urlcdom ne '')) { 
  415:             my $cprimary_id = &Apache::lonnet::domain($urlcdom,'primary');
  416:             if ($cprimary_id ne '') {
  417:                 my $cintdom = &Apache::lonnet::internet_dom($cprimary_id);
  418:                 if (($cintdom ne '') && (grep(/^\Q$cintdom\E$/,@intdoms))) {
  419:                     $cdom = $urlcdom;
  420:                 }
  421:             } else {
  422:                 $urlcnum = '';
  423:             }
  424:         }
  425:     }
  426:     if ($cdom eq '') {
  427:         if ($udom ne '') {
  428:             $cdom = $udom;
  429:         } else {
  430:             $cdom = $defdom;
  431:         }
  432:     }
  433: 
  434: #
  435: # Retrieve information for LTI Consumers in course's domain
  436: # defined in domain configuration for LTI.
  437: #
  438: # Verify the signed request using the secret for those
  439: # Consumers for which the key in the POSTed data matches
  440: # keys in the course configuration or the domain configuration
  441: # for LTI.
  442: #
  443: 
  444:     my %lti;
  445:     my $itemid = &get_lti_itemid($requri,$hostname,$params,$cdom);
  446:     if ($itemid) {
  447:         %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
  448:     }
  449: 
  450: #
  451: # Request is invalid if the signed request could not be verified
  452: # for the Consumer key and Consumer secret from the domain
  453: # configuration in LON-CAPA for that LTI Consumer.
  454: #
  455:     unless (($itemid) && (ref($lti{$itemid}) eq 'HASH')) {
  456:         &invalid_request($r,'Launch request could not be validated');
  457:         return OK;
  458:     }
  459: 
  460: #
  461: # Determine if nonce in POSTed data has expired.
  462: # If unexpired, confirm it has not already been used.
  463: #
  464:     unless (&LONCAPA::ltiutils::check_nonce($params->{'oauth_nonce'},$params->{'oauth_timestamp'},
  465:                                             $lti{$itemid}{'lifetime'},$cdom,$r->dir_config('lonLTIDir'))) {
  466:         &invalid_request($r,'Time limit exceeded for launch request credentials');
  467:         return OK;
  468:     }
  469: 
  470: #
  471: # Determine if a username is required from the domain
  472: # configuration for the specific LTI Consumer
  473: #
  474: 
  475:     if (!$lti{$itemid}{'requser'}) {
  476:         if ($tail =~ m{^/tiny/($match_domain)/(\w+)$}) {
  477:             my $ltitype = 'd';
  478:             foreach my $key (%{$params}) {
  479:                 delete($env{'form.'.$key});
  480:             }
  481:             my $ltoken = &Apache::lonnet::tmpput({'linkprot' => $itemid.$ltitype.':'.$tail},
  482:                                                    $lonhost);
  483:             if ($ltoken) {
  484:                 $r->internal_redirect($tail.'?ltoken='.$ltoken);
  485:                 $r->set_handlers('PerlHandler'=> undef);
  486:             } else {
  487:                 &invalid_request($r,'Failed to store information from launch request');
  488:             }
  489:         } else {
  490:             &invalid_request($r,'Launch URL invalid for matched launch credentials');
  491:         }
  492:         return OK;
  493:     }
  494: 
  495: #
  496: # Determine if source of username matches requirement from the 
  497: # domain configuration for the specific LTI Consumer.
  498: # 
  499: 
  500:     if ($lti{$itemid}{'mapuser'} eq $possmapuser) {
  501:         $uname = $possuname;
  502:     } elsif ($lti{$itemid}{'mapuser'} eq 'lis_person_sourcedid') {
  503:         if ($params->{'lis_person_sourcedid'} =~ /^$match_username$/) {
  504:             $uname = $possuname;
  505:         }
  506:     } elsif ($lti{$itemid}{'mapuser'} eq 'lis_person_contact_email_primary') {
  507:         if ($params->{'lis_person_contact_email_primary'} =~ /^$match_username$/) {
  508:             $uname = $params->{'lis_person_contact_email_primary'};
  509:         }
  510:     } elsif (exists($params->{$lti{$itemid}{'mapuser'}})) {
  511:         if ($params->{$lti{$itemid}{'mapuser'}} =~ /^$match_username$/) {
  512:             $uname = $params->{$lti{$itemid}{'mapuser'}};
  513:         }
  514:     }
  515: 
  516: #
  517: # Determine the courseID of the LON-CAPA course to which the
  518: # launch of LON-CAPA should provide access.
  519: #
  520: # Order is:
  521: #
  522: # (a) from course mapping (if the link between Consumer "course" and 
  523: # Provider "course" has been established previously).
  524: # (b) from tail of requested URL (after /adm/lti/) if it has format of a symb
  525: # (c) from tail of requested URL (after /adm/lti) if it has format of a map
  526: # (d) from tail of requested URL (after /adm/lti) if it has format /domain/courseID
  527: # (e) from tail of requested URL (after /adm/lti) if it has format /tiny/domain/\w+
  528: #     i.e., a shortened URL (see bug #6400).
  529: #
  530: # If Consumer course included in POSTed data points as a target course which
  531: # has a format which matches a LON-CAPA courseID, but the course does not
  532: # exist, the request is invalid.
  533: # 
  534: 
  535:     my ($sourcecrs,%consumers);
  536:     if ($lti{$itemid}{'mapcrs'} eq 'course_offering_sourcedid') {
  537:         $sourcecrs = $params->{'course_offering_sourcedid'};
  538:     } elsif ($lti{$itemid}{'mapcrs'} eq 'context_id') {
  539:         $sourcecrs = $params->{'context_id'};
  540:     } elsif ($lti{$itemid}{'mapcrs'} ne '') {
  541:         $sourcecrs = $params->{$lti{$itemid}{'mapcrs'}};
  542:     }
  543: 
  544:     my $posscnum;
  545:     if ($sourcecrs ne '') {
  546:         %consumers = &Apache::lonnet::get_dom('lticonsumers',[$sourcecrs],$cdom);
  547:         if (exists($consumers{$sourcecrs})) {
  548:             if ($consumers{$sourcecrs} =~ /^\Q$itemid:\E($match_courseid)$/) {
  549:                 my $storedcnum = $1;
  550:                 my $crshome = &Apache::lonnet::homeserver($storedcnum,$cdom);
  551:                 if ($crshome =~ /(con_lost|no_host|no_such_host)/) {
  552:                     &invalid_request($r,'Invalid courseID included in launch data');
  553:                     return OK;
  554:                 } else {
  555:                     $posscnum = $storedcnum;
  556:                 }
  557:             }
  558:         }
  559:     }
  560: 
  561:     if ($urlcnum ne '') {
  562:         if ($posscnum ne '') {
  563:             if ($posscnum ne $urlcnum) {
  564:                 &invalid_request($r,'Course ID included in launch data incompatible with URL');
  565:                 return OK;
  566:             } else {
  567:                 $cnum = $posscnum;
  568:             }
  569:         } else {
  570:             my $crshome = &Apache::lonnet::homeserver($urlcnum,$cdom);
  571:             if ($crshome =~ /(con_lost|no_host|no_such_host)/) {
  572:                 &invalid_request($r,'Valid course ID could not be extracted from requested URL');
  573:                 return OK;
  574:             } else {
  575:                 $cnum = $urlcnum;
  576:             }
  577:         }
  578:     } elsif ($posscnum ne '') {
  579:         $cnum = $posscnum;
  580:     }
  581: 
  582: #
  583: # Get LON-CAPA role(s) to use from role-mapping of Consumer roles
  584: # defined in domain configuration for the appropriate LTI
  585: # Consumer.
  586: #
  587: # If multiple LON-CAPA roles are indicated for the current user,
  588: # ordering (from first to last) is: cc/co, in, ta, ep, st.
  589: #
  590: 
  591:     my (@ltiroles,@lcroles);
  592:     my @lcroleorder = ('cc','in','ta','ep','st');
  593:     my ($lcrolesref,$ltirolesref) = 
  594:         &LONCAPA::ltiutils::get_lc_roles($params->{'roles'},
  595:                                          \@lcroleorder,
  596:                                          $lti{$itemid}{maproles});
  597:     if (ref($lcrolesref) eq 'ARRAY') {
  598:         @lcroles = @{$lcrolesref};
  599:     }
  600:     if (ref($ltirolesref) eq 'ARRAY') {
  601:         @ltiroles = @{$ltirolesref};
  602:     }
  603: 
  604: #
  605: # If no LON-CAPA username  -- is user allowed to create one?
  606: #
  607: 
  608:     my $selfcreate;
  609:     if (($uname ne '') && ($udom ne '')) {
  610:         $uhome = &Apache::lonnet::homeserver($uname,$udom);
  611:         if ($uhome =~ /(con_lost|no_host|no_such_host)/) {
  612:             &Apache::lonnet::logthis(" LTI authorized unknown user $uname:$udom ");
  613:             if (ref($lti{$itemid}{'makeuser'}) eq 'ARRAY') {
  614:                 if (@{$lti{$itemid}{'makeuser'}} > 0) {
  615:                     foreach my $ltirole (@ltiroles) {
  616:                         if (grep(/^\Q$ltirole\E$/,@{$lti{$itemid}{'makeuser'}})) {
  617:                             $selfcreate = 1;
  618:                             last;
  619:                         }
  620:                     }
  621:                 }
  622:             }
  623:             if ($selfcreate) {
  624:                 my (%rulematch,%inst_results,%curr_rules,%got_rules,%alerts);
  625:                 my $domdesc = &Apache::lonnet::domain($udom,'description');
  626:                 my %data = (
  627:                     'permanentemail' => $env{'form.lis_person_contact_email_primary'},
  628:                     'firstname'      => $env{'form.lis_person_name_given'},
  629:                     'lastname'       => $env{'form.lis_person_name_family'},
  630:                     'fullname'       => $env{'form.lis_person_name_full'},
  631:                 );
  632:                 my $result =
  633:                     &LONCAPA::ltiutils::create_user($lti{$itemid},$uname,$udom,
  634:                                                     $domdesc,\%data,\%alerts,\%rulematch,
  635:                                                     \%inst_results,\%curr_rules,%got_rules);
  636:                 if ($result eq 'notallowed') {
  637:                     &invalid_request($r,'Account creation not permitted for this user');
  638:                 } elsif ($result eq 'ok') {
  639:                     if (($ltiroles[0] eq 'Instructor') && ($lcroles[0] eq 'cc') && ($lti{$itemid}{'mapcrs'}) &&
  640:                         ($lti{$itemid}{'makecrs'})) {
  641:                         unless (&Apache::lonnet::usertools_access($uname,$udom,'lti','reload','requestcourses')) {
  642:                             &Apache::lonnet::put('environment',{ 'requestcourses.lti' => 'autolimit=', },$udom,$uname);
  643:                         }
  644:                     }
  645:                 } else {
  646:                     &invalid_request($r,'An error occurred during account creation');
  647:                     return OK;
  648:                 }
  649:             } else {
  650:                 &invalid_request($r,'Account creation not permitted');
  651:                 return OK;
  652:             }
  653:         }
  654:     } else {
  655:         &invalid_request($r,'Could not determine username and/or domain for user');
  656:         return OK;
  657:     }
  658: 
  659: #
  660: # If no LON-CAPA course available, check if domain's configuration
  661: # for the specific LTI Consumer allows a new course to be created 
  662: # (requires role in Consumer to be: Instructor and Instructor to map to CC)
  663: #
  664: 
  665:     my $reqcrs;
  666:     if ($cnum eq '') {
  667:         if ($lti{$itemid}{'crsinc'}) {
  668:             if ((@ltiroles) && ($lti{$itemid}{'mapcrs'}) &&
  669:                 ($ltiroles[0] eq 'Instructor') && ($lcroles[0] eq 'cc') && ($lti{$itemid}{'makecrs'})) {
  670:                 my (%can_request,%request_domains);
  671:                 &Apache::lonnet::check_can_request($cdom,\%can_request,\%request_domains,$uname,$udom);
  672:                 if ($can_request{'lti'}) {
  673:                     $reqcrs = 1;
  674:                     &lti_session($r,$itemid,$uname,$udom,$uhome,$lonhost,undef,$mapurl,$tail,
  675:                                  $symb,$cdom,$cnum,$params,\@ltiroles,$lti{$itemid},\@lcroles,
  676:                                  $reqcrs,$sourcecrs);
  677:                 } else {
  678:                     &invalid_request($r,'No LON-CAPA course available, and creation is not permitted for this user');
  679:                 }
  680:             } else {
  681:                 &invalid_request($r,'No LON-CAPA course available, and creation is not permitted');
  682:             }
  683:         } else {
  684:             &lti_session($r,$itemid,$uname,$udom,$uhome,$lonhost,undef,$mapurl,$tail,
  685:                          $symb,$cdom,$cnum,$params,\@ltiroles,$lti{$itemid},\@lcroles,
  686:                          $reqcrs,$sourcecrs);
  687:         }
  688:         return OK;
  689:     }
  690: 
  691: #
  692: # If LON-CAPA course is a Community, and LON-CAPA role
  693: # indicated is cc, change role indicated to co.
  694: #
  695: 
  696:     my %crsenv;
  697:     if ($lcroles[0] eq 'cc') {
  698:         if (($cdom ne '') && ($cnum ne '')) {
  699:             %crsenv = &Apache::lonnet::coursedescription($cdom.'_'.$cnum,{ 'one_time' => 1,});
  700:             if ($crsenv{'type'} eq 'Community') {
  701:                 $lcroles[0] = 'co';
  702:             }
  703:         }
  704:     }
  705: 
  706: #
  707: # Determine if user has a LON-CAPA role in the mapped LON-CAPA course.
  708: # If multiple LON-CAPA roles are available for the user's assigned LTI roles,
  709: # choose the first available LON-CAPA role in the order: cc/co, in, ta, ep, st
  710: #
  711: 
  712:     my ($role,$usec,$withsec);
  713:     unless ((($lcroles[0] eq 'cc') || ($lcroles[0] eq 'co')) && (@lcroles == 1)) {
  714:         if ($lti{$itemid}{'section'} ne '') {
  715:             if ($lti{$itemid}{'section'} eq 'course_section_sourcedid') {
  716:                 if ($env{'form.course_section_sourcedid'} !~ /\W/) {
  717:                     $usec = $env{'form.course_section_sourcedid'};
  718:                 }
  719:             } elsif ($env{'form.'.$lti{$itemid}{'section'}} !~ /\W/) {
  720:                 $usec = $env{'form.'.$lti{$itemid}{'section'}};
  721:             }
  722:         }
  723:         if ($usec ne '') {
  724:             $withsec = 1;
  725:         }
  726:     }
  727: 
  728:     if (@lcroles) {
  729:         my %crsroles = &Apache::lonnet::get_my_roles($uname,$udom,'userroles',undef,\@lcroles,
  730:                                                      [$cdom],$withsec);
  731:         foreach my $reqrole (@lcroles) {
  732:             if ($withsec) {
  733:                 my $incsec;
  734:                 if (($reqrole eq 'cc') || ($reqrole eq 'co')) {
  735:                     $incsec = '';
  736:                 } else {
  737:                     $incsec = $usec;
  738:                 }
  739:                 if (exists($crsroles{$cnum.':'.$cdom.':'.$reqrole.':'.$incsec})) {
  740:                     $role = $reqrole.'./'.$cdom.'/'.$cnum;
  741:                     if ($incsec ne '') {
  742:                         $role .= '/'.$usec;
  743:                     }
  744:                     last;
  745:                 }
  746:             } else {
  747:                 if (exists($crsroles{$cnum.':'.$cdom.':'.$reqrole})) {
  748:                     $role = $reqrole.'./'.$cdom.'/'.$cnum;
  749:                     last;
  750:                 }
  751:             }
  752:         }
  753:     }
  754: 
  755: #
  756: # Determine if user can selfenroll
  757: #
  758: 
  759:     my ($reqrole,$selfenrollrole);
  760:     if ($role eq '') {
  761:         if ((@ltiroles) && (ref($lti{$itemid}{'selfenroll'}) eq 'ARRAY')) {
  762:             foreach my $ltirole (@ltiroles) {
  763:                 if (grep(/^\Q$ltirole\E$/,@{$lti{$itemid}{'selfenroll'}})) {
  764:                     if (ref($lti{$itemid}{maproles}) eq 'HASH') {
  765:                         $reqrole = $lti{$itemid}{maproles}{$ltirole};
  766:                         last;
  767:                     }
  768:                 }
  769:             }
  770:         }
  771:         if ($reqrole eq '') {
  772:             &invalid_request($r,'No matching role available in LON-CAPA course, and not permitted to self-enroll');
  773:             return OK;
  774:         } else {
  775:             unless (%crsenv) {
  776:                 %crsenv = &Apache::lonnet::coursedescription($cdom.'_'.$cnum);
  777:             }
  778:             my $default_enrollment_start_date = $crsenv{'default_enrollment_start_date'};
  779:             my $default_enrollment_end_date   = $crsenv{'default_enrollment_end_date'};
  780:             my $now = time;
  781:             if ($default_enrollment_end_date && $default_enrollment_end_date <= $now) {
  782:                 &invalid_request($r,'No active role available in LON-CAPA course, and past end date for self-enrollment');
  783:                 return OK;
  784:             } elsif ($default_enrollment_start_date && $default_enrollment_start_date >$now) {
  785:                 &invalid_request($r,'No active role available in LON-CAPA course, and brefor start date for self-enrollment');
  786:                 return OK;
  787:             } else {
  788:                 $selfenrollrole = $reqrole.'./'.$cdom.'/'.$cnum;
  789:                 if (($withsec) && ($reqrole ne 'cc') && ($reqrole ne 'co')) {
  790:                     if ($usec ne '') {
  791:                         $selfenrollrole .= '/'.$usec;
  792:                     }
  793:                 }
  794:             }
  795:         }
  796:     }
  797: 
  798: #
  799: # Retrieve course type of LON-CAPA course to check if mapping from a Consumer
  800: # course identifier permitted for this type of course (one of: official,
  801: # unofficial, community, textbook, placement or lti.
  802: #
  803: 
  804:     unless (%crsenv) {
  805:         %crsenv = &Apache::lonnet::coursedescription($cdom.'_'.$cnum);
  806:     }
  807:     my $crstype = lc($crsenv{'type'});
  808:     if ($crstype eq '') {
  809:         $crstype = 'course';
  810:     }
  811:     if ($crstype eq 'course') {
  812:         if ($crsenv{'internal.coursecode'}) {
  813:             $crstype = 'official';
  814:         } elsif ($crsenv{'internal.textbook'}) {
  815:             $crstype = 'textbook';
  816:         } elsif ($crsenv{'internal.lti'}) {
  817:             $crstype = 'lti';
  818:         } else {
  819:             $crstype = 'unofficial';
  820:         }
  821:     }
  822: 
  823: #
  824: # Store consumer-to-LON-CAPA course mapping if permitted
  825: #
  826: 
  827:     if (($lti{$itemid}{'storecrs'}) && ($sourcecrs ne '') && 
  828:         ($consumers{$sourcecrs} eq '') && ($cnum ne '')) {
  829:         if (ref($lti{$itemid}{'mapcrstype'}) eq 'ARRAY') {
  830:             if (grep(/^$crstype$/,@{$lti{$itemid}{'mapcrstype'}})) {
  831:                 &Apache::lonnet::put_dom('lticonsumers',{ $sourcecrs => $itemid.':'.$cnum },$cdom);
  832:             }
  833:         }
  834:     }
  835: 
  836: #
  837: # Start user session
  838: #
  839: 
  840:     &lti_session($r,$itemid,$uname,$udom,$uhome,$lonhost,$role,$mapurl,$tail,$symb,
  841:                  $cdom,$cnum,$params,\@ltiroles,$lti{$itemid},\@lcroles,undef,$sourcecrs,
  842:                  $selfenrollrole);
  843:     return OK;
  844: }
  845: 
  846: sub get_lti_itemid {
  847:     my ($requri,$hostname,$params,$cdom,$cnum,$context) = @_;
  848:     return unless (ref($params) eq 'HASH');
  849:     my $protocol = 'http';
  850:     if ($ENV{'SERVER_PORT'} == 443) {
  851:         $protocol = 'https';
  852:     }
  853:     my $url = $protocol.'://'.$hostname.$requri;
  854:     my $method = $env{'request.method'};
  855:     if ($cnum ne '') {
  856:         return &Apache::lonnet::courselti_itemid($cnum,$cdom,$url,$method,$params,$context);
  857:     } else {
  858:         return &Apache::lonnet::domainlti_itemid($cdom,$url,$method,$params,$context);
  859:     }
  860: }
  861: 
  862: sub lti_enroll {
  863:     my ($uname,$udom,$selfenrollrole) = @_;
  864:     my $enrollresult;
  865:     my ($role,$cdom,$cnum,$sec) =
  866:            ($selfenrollrole =~ m{^(\w+)\./($match_domain)/($match_courseid)(?:|/(\w*))$});
  867:     if (($cnum ne '') && ($cdom ne '')) {
  868:         my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
  869:         if ($chome ne 'no_host') {
  870:             my %coursehash = &Apache::lonnet::coursedescription($cdom.'_'.$cnum);
  871:             my $start = $coursehash{'default_enrollment_start_date'};
  872:             my $end = $coursehash{'default_enrollment_end_date'};
  873:             $enrollresult = &LONCAPA::ltiutils::enrolluser($udom,$uname,$role,$cdom,$cnum,$sec,
  874:                                                            $start,$end,1);
  875:         }
  876:     }
  877:     return $enrollresult;
  878: }
  879: 
  880: sub lti_reqcrs {
  881:     my ($r,$cdom,$form,$uname,$udom) = @_;
  882:     my (%can_request,%request_domains);
  883:     &Apache::lonnet::check_can_request($cdom,\%can_request,\%request_domains,$uname,$udom);
  884:     if ($can_request{'lti'}) {
  885:         my %domconfig = &Apache::lonnet::get_dom('configuration',['requestcourses'],$cdom);
  886:         my %domdefs = &Apache::lonnet::get_domain_defaults($cdom);
  887:         &Apache::lonrequestcourse::print_textbook_form($r,$cdom,[$cdom],\%domdefs,
  888:                                                        $domconfig{'requestcourses'},
  889:                                                        \%can_request,'lti',$form);
  890:     } else {
  891:         $r->print(
  892:               &Apache::loncommon::start_page('Invalid LTI call',undef,{'only_body' => 1}).
  893:               &mt('Invalid LTI call').
  894:               &Apache::loncommon::end_page()
  895:         );
  896:     }
  897: }
  898: 
  899: sub lti_session {
  900:     my ($r,$itemid,$uname,$udom,$uhome,$lonhost,$role,$mapurl,$tail,$symb,$cdom,$cnum,
  901:         $params,$ltiroles,$ltihash,$lcroles,$reqcrs,$sourcecrs,$selfenrollrole) = @_;
  902:     return unless ((ref($params) eq 'HASH') && (ref($ltiroles) eq 'ARRAY') &&
  903:                    (ref($ltihash) eq 'HASH') && (ref($lcroles) eq 'ARRAY'));
  904: #
  905: # Check if user should be hosted here or switched to another server.
  906: #
  907:     $r->user($uname);
  908:     if ($cnum) {
  909:         if ($role) {
  910:             &Apache::lonnet::logthis(" LTI authorized user ($itemid): $uname:$udom, role: $role, course: $cdom\_$cnum");
  911:         } elsif ($selfenrollrole =~ m{^(\w+)\./$cdom/$cnum}) {
  912:             &Apache::lonnet::logthis(" LTI authorized user ($itemid): $uname:$udom, desired role: $1 course: $cdom\_$cnum");
  913:         }
  914:     } else {
  915:         &Apache::lonnet::logthis(" LTI authorized user ($itemid): $uname:$udom, course dom: $cdom");
  916:     }
  917:     my ($is_balancer,$otherserver,$hosthere) = &check_balancer($r,$uname,$udom);
  918:     my $protocol = 'http';
  919:     if ($ENV{'SERVER_PORT'} == 443) {
  920:         $protocol = 'https';
  921:     }
  922:     if (($is_balancer) && (!$hosthere)) {
  923:         # login but immediately go to switch server.
  924:         &Apache::lonauth::success($r,$uname,$udom,$uhome,'noredirect');
  925:         if (($ltihash->{'callback'}) && ($params->{$ltihash->{'callback'}})) {
  926:             &LONCAPA::ltiutils::setup_logout_callback($uname,$udom,$otherserver,
  927:                                                       $ltihash->{'key'},
  928:                                                       $ltihash->{'secret'},
  929:                                                       $params->{$ltihash->{'callback'}},
  930:                                                       $r->dir_config('ltiIDsDir'),
  931:                                                       $protocol,$r->hostname);
  932:         }
  933:         if ($symb) {
  934:             $env{'form.symb'} = $symb;
  935:             $env{'request.lti.uri'} = $tail;
  936:         } else {
  937:             if ($mapurl) {
  938:                 $env{'form.origurl'} = $mapurl;
  939:                 $env{'request.lti.uri'} = $mapurl;
  940:             } elsif ($tail =~ m{^\Q/tiny/$cdom/\E\w+$}) {
  941:                 $env{'form.origurl'} = $tail;
  942:                 $env{'request.lti.uri'} = $tail;
  943:             } elsif ($tail eq "/$cdom/$cnum") {
  944:                 $env{'form.origurl'} = '/adm/navmaps';
  945:                 $env{'request.lti.uri'} = $tail;
  946:             } else {
  947:                 unless ($tail eq '/adm/roles') {
  948:                     if ($cnum) {
  949:                         $env{'form.origurl'} = '/adm/navmaps';
  950:                     }
  951:                 }
  952:             }
  953:         }
  954:         if ($role) {
  955:             $env{'form.role'} = $role;
  956:         }
  957:         if (($lcroles->[0] eq 'cc') && ($reqcrs)) {
  958:             $env{'request.lti.reqcrs'} = 1;
  959:             $env{'request.lti.reqrole'} = 'cc';
  960:             $env{'request.lti.sourcecrs'} = $sourcecrs;
  961:         }
  962:         if ($selfenrollrole) {
  963:             $env{'request.lti.selfenrollrole'} = $selfenrollrole;
  964:             $env{'request.lti.sourcecrs'} = $sourcecrs;
  965:         }
  966:         if ($ltihash->{'passback'}) {
  967:             if ($params->{'lis_result_sourcedid'}) {
  968:                 $env{'request.lti.passbackid'} = $params->{'lis_result_sourcedid'};
  969:             }
  970:             if ($params->{'lis_outcome_service_url'}) {
  971:                 $env{'request.lti.passbackurl'} = $params->{'lis_outcome_service_url'};
  972:             }
  973:         }
  974:         if (($ltihash->{'roster'}) && (grep(/^Instructor$/,@{$ltiroles}))) {
  975:             if ($params->{'ext_ims_lis_memberships_id'}) {
  976:                 $env{'request.lti.rosterid'} = $params->{'ext_ims_lis_memberships_id'};
  977:             }
  978:             if ($params->{'ext_ims_lis_memberships_url'}) {
  979:                 $env{'request.lti.rosterurl'} = $params->{'ext_ims_lis_memberships_url'};
  980:             }
  981:         }
  982:         $env{'request.lti.login'} = $itemid;
  983:         if ($params->{'launch_presentation_document_target'}) {
  984:             $env{'request.lti.target'} = $params->{'launch_presentation_document_target'};
  985:         }
  986:         foreach my $key (keys(%{$params})) {
  987:             delete($env{'form.'.$key});
  988:         }
  989:         my $redirecturl = '/adm/switchserver';
  990:         if ($otherserver ne '') {
  991:             $redirecturl .= '?otherserver='.$otherserver;
  992:         }
  993:         $r->internal_redirect($redirecturl);
  994:         $r->set_handlers('PerlHandler'=> undef);
  995:     } else {
  996:         # need to login them in, so generate the data migrate expects to do login
  997:         foreach my $key (keys(%{$params})) {
  998:             delete($env{'form.'.$key});
  999:         }
 1000:         if (($ltihash->{'callback'}) && ($params->{$ltihash->{'callback'}})) {
 1001:             &LONCAPA::ltiutils::setup_logout_callback($uname,$udom,$lonhost,
 1002:                                                       $ltihash->{'key'},
 1003:                                                       $ltihash->{'secret'},
 1004:                                                       $params->{$ltihash->{'callback'}},
 1005:                                                       $r->dir_config('ltiIDsDir'),
 1006:                                                       $protocol,$r->hostname);
 1007:         }
 1008:         my $ip = &Apache::lonnet::get_requestor_ip($r,REMOTE_NOLOOKUP);
 1009:         my %info=('ip'        => $ip,
 1010:                   'domain'    => $udom,
 1011:                   'username'  => $uname,
 1012:                   'server'    => $lonhost,
 1013:                   'lti.login' => $itemid,
 1014:                   'lti.uri'   => $tail,
 1015:                  );
 1016:         if ($role) {
 1017:             $info{'role'} = $role;
 1018:         }
 1019:         if ($symb) {
 1020:             $info{'symb'} = $symb;
 1021:         }
 1022:         if (($lcroles->[0] eq 'cc') && ($reqcrs)) {
 1023:             $info{'lti.reqcrs'} = 1;
 1024:             $info{'lti.reqrole'} = 'cc';
 1025:             $info{'lti.sourcecrs'} = $sourcecrs;
 1026:         }
 1027:         if ($selfenrollrole) {
 1028:             $info{'lti.selfenrollrole'} = $selfenrollrole;
 1029:         }
 1030:         if ($ltihash->{'passback'}) {
 1031:             if ($params->{'lis_result_sourcedid'}) {
 1032:                 $info{'lti.passbackid'} = $params->{'lis_result_sourcedid'}
 1033:             }
 1034:             if ($params->{'lis_outcome_service_url'}) {
 1035:                 $info{'lti.passbackurl'} = $params->{'lis_outcome_service_url'}
 1036:             }
 1037:         }
 1038:         if (($ltihash->{'roster'}) && (grep(/^Instructor$/,@{$ltiroles}))) {
 1039:             if ($params->{'ext_ims_lis_memberships_id'}) {
 1040:                 $info{'lti.rosterid'} = $params->{'ext_ims_lis_memberships_id'};
 1041:             }
 1042:             if ($params->{'ext_ims_lis_memberships_url'}) {
 1043:                 $info{'lti.rosterurl'} = $params->{'ext_ims_lis_memberships_url'};
 1044:             }
 1045:         }
 1046:         if ($params->{'launch_presentation_document_target'}) {
 1047:             $info{'lti.target'} = $params->{'launch_presentation_document_target'};
 1048:         }
 1049: 
 1050:         unless ($info{'symb'}) {
 1051:             if ($mapurl) {
 1052:                 $info{'origurl'} = $mapurl;
 1053:             } elsif ($tail =~ m{^\Q/tiny/$cdom/\E\w+$}) {
 1054:                 $info{'origurl'} = $tail;
 1055:             } else {
 1056:                 unless ($tail eq '/adm/roles') {
 1057:                     if ($cnum) {
 1058:                         $info{'origurl'} = '/adm/navmaps';
 1059:                     }
 1060:                 }
 1061:             }
 1062:         }
 1063:         if (($is_balancer) && ($hosthere)) {
 1064:             $info{'noloadbalance'} = $hosthere;
 1065:         }
 1066:         my $token = &Apache::lonnet::tmpput(\%info,$lonhost);
 1067:         $env{'form.token'} = $token;
 1068:         $r->internal_redirect('/adm/migrateuser');
 1069:         $r->set_handlers('PerlHandler'=> undef);
 1070:     }
 1071:     return;
 1072: }
 1073: 
 1074: sub linkprot_session {
 1075:     my ($r,$uname,$cnum,$cdom,$uhome,$itemid,$ltitype,$dest,$lonhost,$exiturl) = @_;
 1076:     $r->user($uname);
 1077:     if ($ltitype eq 'c') {
 1078:         &Apache::lonnet::logthis("Course Link Protector ($itemid) authorized student: $uname:$cdom, course: $cdom\_$cnum");
 1079:     } elsif ($ltitype eq 'd') {
 1080:         &Apache::lonnet::logthis("Domain LTI for link protection ($itemid) authorized student: $uname:$cdom, course: $cdom\_$cnum");
 1081:     }
 1082:     my ($is_balancer,$otherserver,$hosthere) = &check_balancer($r,$uname,$cdom);
 1083:     if (($is_balancer) && (!$hosthere)) {
 1084:         # login but immediately go to switch server
 1085:         &Apache::lonauth::success($r,$uname,$cdom,$uhome,'noredirect');
 1086:         $env{'form.origurl'} = $dest;
 1087:         $env{'request.linkprot'} = $itemid.$ltitype.':'.$dest;
 1088:         $env{'request.linkprotuser'} = $uname.':'.$cdom;
 1089:         $env{'request.deeplink.login'} = $dest;
 1090:         if ($exiturl ne '') {
 1091:             $env{'request.linkprotexit'} = $exiturl;
 1092:         }
 1093:         my $redirecturl = '/adm/switchserver';
 1094:         if ($otherserver ne '') {
 1095:             $redirecturl .= '?otherserver='.$otherserver;
 1096:         }
 1097:         $r->internal_redirect($redirecturl);
 1098:         $r->set_handlers('PerlHandler'=> undef);
 1099:     } else {
 1100:         # need to login them in, so generate the data migrate expects to do login
 1101:         my $ip = &Apache::lonnet::get_requestor_ip($r,REMOTE_NOLOOKUP);
 1102:         my %info=('ip'             => $ip,
 1103:                   'domain'         => $cdom,
 1104:                   'username'       => $uname,
 1105:                   'server'         => $lonhost,
 1106:                   'linkprot'       => $itemid.$ltitype.':'.$dest,
 1107:                   'linkprotuser'   => $uname.':'.$cdom,
 1108:                   'home'           => $uhome,
 1109:                   'origurl'        => $dest,
 1110:                   'deeplink.login' => $dest,
 1111:                  );
 1112:         if ($exiturl ne '') {
 1113:             $info{'linkprotexit'} = $exiturl; 
 1114:         }
 1115:         my $token = &Apache::lonnet::tmpput(\%info,$lonhost);
 1116:         $env{'form.token'} = $token;
 1117:         $r->internal_redirect('/adm/migrateuser');
 1118:         $r->set_handlers('PerlHandler'=> undef);
 1119:     }
 1120:     return;
 1121: }
 1122: 
 1123: sub check_balancer {
 1124:     my ($r,$uname,$udom) = @_;
 1125:     my ($is_balancer,$otherserver,$hosthere);
 1126:     ($is_balancer,$otherserver) =
 1127:         &Apache::lonnet::check_loadbalancing($uname,$udom,'login');
 1128:     if ($is_balancer) {
 1129:         # Check if browser sent a LON-CAPA load balancer cookie (and this is a balancer)
 1130:         my ($found_server,$balancer_cookie) = &Apache::lonnet::check_for_balancer_cookie($r);
 1131:         if (($found_server) && ($balancer_cookie =~ /^\Q$udom\E_\Q$uname\E_/)) {
 1132:             $otherserver = $found_server;
 1133:         }
 1134:         if ($otherserver eq '') {
 1135:             my $lowest_load;
 1136:             ($otherserver,undef,undef,undef,$lowest_load) = &Apache::lonnet::choose_server($udom);
 1137:             if ($lowest_load > 100) {
 1138:                 $otherserver = &Apache::lonnet::spareserver($r,$lowest_load,$lowest_load,1,$udom);
 1139:             }
 1140:         }
 1141:         if ($otherserver ne '') {
 1142:             my @hosts = &Apache::lonnet::current_machine_ids();
 1143:             if (grep(/^\Q$otherserver\E$/,@hosts)) {
 1144:                 $hosthere = $otherserver;
 1145:             }
 1146:         }
 1147:     }
 1148:     return ($is_balancer,$otherserver,$hosthere);
 1149: }
 1150: 
 1151: sub invalid_request {
 1152:     my ($r,$msg) = @_;
 1153:     &Apache::loncommon::content_type($r,'text/html');
 1154:     $r->send_http_header;
 1155:     if ($r->header_only) {
 1156:         return;
 1157:     }
 1158:     &Apache::lonlocal::get_language_handle($r);
 1159:     $r->print(
 1160:         &Apache::loncommon::start_page('Invalid LTI call','',{ 'only_body' => 1,}).
 1161:         '<h3>'.&mt('Invalid LTI launch request').'</h3>'.
 1162:         '<p class="LC_warning">'.
 1163:         &mt('Launch of LON-CAPA is unavailable from the "external tool" link you had followed in another web application.').
 1164:         ' '.&mt('Launch failed for the following reason:').
 1165:         '</p>'.
 1166:         '<p class="LC_error">'.$msg.'</p>'.
 1167:         &Apache::loncommon::end_page());
 1168:     return;
 1169: }
 1170: 
 1171: sub course_from_tinyurl {
 1172:     my ($tail) = @_;
 1173:     my ($urlcdom,$urlcnum);
 1174:     if ($tail =~ m{^/tiny/($match_domain)/(\w+)$}) {
 1175:         ($urlcdom,my $key) = ($1,$2);
 1176:         my $tinyurl;
 1177:         my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$urlcdom."\0".$key);
 1178:         if (defined($cached)) {
 1179:             $tinyurl = $result;
 1180:         } else {
 1181:             my $configuname = &Apache::lonnet::get_domainconfiguser($urlcdom);
 1182:             my %currtiny = &Apache::lonnet::get('tiny',[$key],$urlcdom,$configuname);
 1183:             if ($currtiny{$key} ne '') {
 1184:                 $tinyurl = $currtiny{$key};
 1185:                 &Apache::lonnet::do_cache_new('tiny',$urlcdom."\0".$key,$currtiny{$key},600);
 1186:             }
 1187:         }
 1188:         if ($tinyurl ne '') {
 1189:             $urlcnum = (split(/\&/,$tinyurl))[0];
 1190:         }
 1191:     }
 1192:     return ($urlcdom,$urlcnum);
 1193: }
 1194: 
 1195: 1;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>