File:  [LON-CAPA] / loncom / lti / ltiauth.pm
Revision 1.27: download - view: text, annotated - select for diffs
Wed Nov 24 04:25:03 2021 UTC (2 years, 6 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD
- Bug 6754
  - Storing mapping of Consumer course identifier to LON-CAPA courseID
    honors rules for allowable course types, and also general Y/N option for
    any type.
  - When a course is created due to launch from LTI Consumer, course's
    environment.db contains internal.lti set to 1, and extended course type
    is identified as "lti".

    1: # The LearningOnline Network
    2: # Basic LTI Authentication Module
    3: #
    4: # $Id: ltiauth.pm,v 1.27 2021/11/24 04:25:03 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 Apache::Constants qw(:common :http);
   34: use Net::OAuth;
   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} = $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,1);
   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,2);
   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: # Retrieve information for LTI link protectors in course
  131: # where url was /adm/launch/tiny/$cdom/$uniqueid
  132: #
  133:                         my (%crslti,%crslti_by_key,$itemid,$ltitype);
  134:                         %crslti = &Apache::lonnet::get_course_lti($cnum,$cdom,'provider');
  135:                         if (keys(%crslti)) {
  136:                             foreach my $id (keys(%crslti)) {
  137:                                 if (ref($crslti{$id}) eq 'HASH') {
  138:                                     my $key = $crslti{$id}{'key'};
  139:                                     push(@{$crslti_by_key{$key}},$id);
  140:                                 }
  141:                             }
  142:                         }
  143: #
  144: # Verify the signed request using the secret for LTI link
  145: # protectors for which the key in the POSTed data matches
  146: # keys in the course configuration.
  147: #
  148: # Request is invalid if the signed request could not be verified
  149: # for the key and secret from LON-CAPA course configuration for
  150: # LTI link protectors or from LON-CAPA configuration for the
  151: # course's domain if there are LTI Providers which may be used.
  152: #
  153: # Determine if nonce in POSTed data has expired.
  154: # If unexpired, confirm it has not already been used.
  155: #
  156:                         if (keys(%crslti)) {
  157:                             $itemid = &get_lti_itemid($requri,$hostname,$params,\%crslti,\%crslti_by_key);
  158:                         }
  159:                         if (($itemid) && (ref($crslti{$itemid}) eq 'HASH')) {
  160:                             $ltitype = 'c';
  161:                             unless (&LONCAPA::ltiutils::check_nonce($params->{'oauth_nonce'},$params->{'oauth_timestamp'},
  162:                                                                     $crslti{$itemid}{'lifetime'},$cdom,$r->dir_config('lonLTIDir'))) {
  163:                                 &invalid_request($r,3);
  164:                                 return OK;
  165:                             }
  166:                         } else {
  167:                             my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
  168:                             unless (keys(%lti) > 0) {
  169:                                 &invalid_request($r,4);
  170:                                 return OK;
  171:                             }
  172:                             my (%domlti_by_key,%domlti);
  173:                             foreach my $id (keys(%lti)) {
  174:                                 if (ref($lti{$id}) eq 'HASH') {
  175:                                     my $key = $lti{$id}{'key'};
  176:                                     if (!$lti{$itemid}{'requser'}) {
  177:                                         push(@{$domlti_by_key{$key}},$id);
  178:                                         $domlti{$id} = $lti{$id};
  179:                                     }
  180:                                 }
  181:                             }
  182:                             if (keys(%domlti)) {
  183:                                 $itemid = &get_lti_itemid($requri,$hostname,$params,\%domlti,\%domlti_by_key);
  184:                             }
  185:                             if (($itemid) && (ref($domlti{$itemid}) eq 'HASH')) {
  186:                                 $ltitype = 'd';
  187:                                 unless (&LONCAPA::ltiutils::check_nonce($params->{'oauth_nonce'},$params->{'oauth_timestamp'},
  188:                                                                         $domlti{$itemid}{'lifetime'},$cdom,
  189:                                                                         $r->dir_config('lonLTIDir'))) {
  190:                                     &invalid_request($r,5);
  191:                                     return OK;
  192:                                 }
  193:                             }
  194:                         }
  195:                         if ($itemid) {
  196:                             foreach my $key (%{$params}) {
  197:                                 delete($env{'form.'.$key});
  198:                             }
  199:                             my $ltoken = &Apache::lonnet::tmpput({'linkprot' => $itemid.$ltitype.':'.$tail},
  200:                                                                  $lonhost,'link');
  201:                             if ($ltoken) {
  202:                                 $r->internal_redirect($tail.'?ltoken='.$ltoken);
  203:                                 $r->set_handlers('PerlHandler'=> undef);
  204:                             } else {
  205:                                 &invalid_request($r,6);
  206:                             }
  207:                         } else {
  208:                             &invalid_request($r,7);
  209:                         }
  210:                     } else {
  211:                         &invalid_request($r,8);
  212:                     }
  213:                 } else {
  214:                     &invalid_request($r,9);
  215:                 }
  216:             } else {
  217:                 &invalid_request($r,10);
  218:             }
  219:         } else {
  220:             &invalid_request($r,11);
  221:         }
  222:         return OK;
  223:     }
  224: 
  225:     my ($udom,$uname,$uhome,$symb,$mapurl);
  226: 
  227: #
  228: # For user who launched LTI in Consumer, determine user's domain in 
  229: # LON-CAPA.
  230: #
  231: # Order is:
  232: #
  233: # (a) from custom_userdomain item in POSTed data
  234: # (b) from lis_person_sourcedid in POSTed data
  235: # (c) from default "log-in" domain for node
  236: #     (can support multidomain servers, where specific domain is 
  237: #      first part of hostname).
  238: #
  239: # Note: "internet domain" for user's domain must be one of the
  240: # "internet domain(s)" for the institution's LON-CAPA servers.
  241: #
  242:     if (exists($params->{'custom_userdomain'})) {
  243:         if ($params->{'custom_userdomain'} =~ /^$match_domain$/) {
  244:             my $uprimary_id = &Apache::lonnet::domain($params->{'custom_userdomain'},'primary');
  245:             if ($uprimary_id ne '') {
  246:                 my $uintdom = &Apache::lonnet::internet_dom($uprimary_id);
  247:                 if (($uintdom ne '') && (grep(/^\Q$uintdom\E$/,@intdoms))) {
  248:                     $udom = $params->{'custom_userdomain'};
  249:                 }
  250:             }
  251:         }
  252:     }
  253:     my $defdom = &Apache::lonnet::default_login_domain();
  254:     my ($domain,$possuname,$possudom,$possmapuser);
  255:     if ($env{'form.lis_person_sourcedid'} =~ /^($match_username)\:($match_domain)$/) {
  256:         ($possuname,$possudom) = ($1,$2);
  257:         if ($udom eq '') {
  258:             my $uintdom = &Apache::lonnet::domain($possudom,'primary');
  259:             if (($uintdom ne '') && (grep(/^\Q$uintdom\E$/,@intdoms))) {
  260:                 $udom = $possudom;
  261:                 $possmapuser = 'lis_person_sourcedid';
  262:             } else {
  263:                 $udom = $defdom;
  264:             }
  265:         } elsif ($udom eq $possudom) {
  266:             $possmapuser = 'lis_person_sourcedid';
  267:         }
  268:     }
  269:     unless ($possuname) {
  270:         if ($env{'form.lis_person_sourcedid'} =~ /^$match_username$/) {
  271:             $possuname = $env{'form.lis_person_sourcedid'};
  272:             $possmapuser = 'lis_person_sourcedid';
  273:         } elsif ($env{'form.lis_person_contact_email_primary'} =~ /^$match_username$/) {
  274:             $possuname = $env{'form.lis_person_contact_email_primary'};
  275:             $possmapuser = 'lis_person_contact_email_primary';
  276:         }
  277:         unless ($udom) {
  278:             $udom = $defdom;
  279:         }
  280:     }
  281: 
  282: #
  283: # Determine course's domain in LON-CAPA
  284: #
  285: # Order is:
  286: #
  287: # (a) from custom_coursedomain item in POSTed data
  288: # (b) from tail of requested URL (after /adm/lti/) if it has format of a symb  
  289: # (c) from tail of requested URL (after /adm/lti) if it has format of a map 
  290: # (d) from tail of requested URL (after /adm/lti) if it has format /domain/courseID
  291: # (e) from tail of requested URL (after /adm/lti) if it has format /tiny/domain/\w+
  292: #     i.e., a shortened URL (see bug #6400).
  293: # (f) same as user's domain 
  294: #
  295: # Request invalid if custom_coursedomain is defined and is inconsistent with
  296: # domain contained in requested URL.
  297: #
  298: # Note: "internet domain" for course's domain must be one of the
  299: # internet domains for the institution's LON-CAPA servers.
  300: #
  301: 
  302:     if (exists($params->{'custom_coursedomain'})) {
  303:         if ($params->{'custom_coursedomain'} =~ /^$match_domain$/) {
  304:             my $cprimary_id = &Apache::lonnet::domain($params->{'custom_coursedomain'},'primary');
  305:             if ($cprimary_id ne '') {
  306:                 my $cintdom = &Apache::lonnet::internet_dom($cprimary_id);
  307:                 if (($cintdom ne '') && (grep(/^\Q$cintdom\E$/,@intdoms))) {
  308:                     $cdom = $params->{'custom_coursedomain'};
  309:                 }
  310:             }
  311:         }
  312:     }
  313: 
  314:     my ($tail) = ($requri =~ m{^/adm/lti(|/.*)$});
  315:     my $urlcnum;
  316:     if ($tail ne '') {
  317:         my $urlcdom;
  318:         if ($tail =~ m{^/uploaded/($match_domain)/($match_courseid)/(?:default|supplemental)(?:|_\d+)\.(?:sequence|page)(|___\d+___.+)$}) {
  319:             ($urlcdom,$urlcnum,my $rest) = ($1,$2,$3);
  320:             if (($cdom ne '') && ($cdom ne $urlcdom)) {
  321:                 &invalid_request($r,12);
  322:                 return OK;
  323:             }
  324:             if ($rest eq '') {
  325:                 $mapurl = $tail;
  326:             } else {
  327:                 $symb = $tail;
  328:                 $symb =~ s{^/}{};
  329:             }
  330:         } elsif ($tail =~ m{^/res/(?:$match_domain)/(?:$match_username)/.+\.(?:sequence|page)(|___\d+___.+)$}) {
  331:             if ($1 eq '') {
  332:                 $mapurl = $tail;
  333:             } else {
  334:                 $symb = $tail;
  335:                 $symb =~ s{^/res/}{};
  336:             }
  337:         } elsif ($tail =~ m{^/($match_domain)/($match_courseid)$}) {
  338:             ($urlcdom,$urlcnum) = ($1,$2);
  339:             if (($cdom ne '') && ($cdom ne $urlcdom)) {
  340:                 &invalid_request($r,13);
  341:                 return OK;
  342:             }
  343:         } elsif ($tail =~ m{^/tiny/($match_domain)/(\w+)$}) {
  344:             ($urlcdom,$urlcnum) = &course_from_tinyurl($tail);
  345:             if (($urlcdom eq '') || ($urlcnum eq '')) {
  346:                 &invalid_request($r,14);
  347:                 return OK;
  348:             }
  349:         }
  350:         if (($cdom eq '') && ($urlcdom ne '')) { 
  351:             my $cprimary_id = &Apache::lonnet::domain($urlcdom,'primary');
  352:             if ($cprimary_id ne '') {
  353:                 my $cintdom = &Apache::lonnet::internet_dom($cprimary_id);
  354:                 if (($cintdom ne '') && (grep(/^\Q$cintdom\E$/,@intdoms))) {
  355:                     $cdom = $urlcdom;
  356:                 }
  357:             } else {
  358:                 $urlcnum = '';
  359:             }
  360:         }
  361:     }
  362:     if ($cdom eq '') {
  363:         if ($udom ne '') {
  364:             $cdom = $udom;
  365:         } else {
  366:             $cdom = $defdom;
  367:         }
  368:     }
  369: 
  370: #
  371: # Retrieve information for LTI Consumers in course's domain
  372: # and populate hash --  %lti_by_key -- for which keys
  373: # are those defined in domain configuration for LTI.
  374: #
  375:  
  376:     my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
  377:     unless (keys(%lti) > 0) {
  378:         &invalid_request($r,15);
  379:         return OK;
  380:     }
  381:     my %lti_by_key;
  382:     if (keys(%lti)) {
  383:         foreach my $id (keys(%lti)) {
  384:             if (ref($lti{$id}) eq 'HASH') {
  385:                 my $key = $lti{$id}{'key'};
  386:                 push(@{$lti_by_key{$key}},$id);
  387:             }
  388:         }
  389:     }
  390: 
  391: #
  392: # Verify the signed request using the secret for those
  393: # Consumers for which the key in the POSTed data matches 
  394: # keys in the course configuration or the domain configuration
  395: # for LTI.
  396: #
  397: 
  398:     my $itemid = &get_lti_itemid($requri,$hostname,$params,\%lti,\%lti_by_key);
  399: 
  400: #
  401: # Request is invalid if the signed request could not be verified
  402: # for the Consumer key and Consumer secret from the domain
  403: # configuration in LON-CAPA for that LTI Consumer.
  404: #
  405:     unless (($itemid) && (ref($lti{$itemid}) eq 'HASH')) {
  406:         &invalid_request($r,16);
  407:         return OK;
  408:     }
  409: 
  410: #
  411: # Determine if nonce in POSTed data has expired.
  412: # If unexpired, confirm it has not already been used.
  413: #
  414:     unless (&LONCAPA::ltiutils::check_nonce($params->{'oauth_nonce'},$params->{'oauth_timestamp'},
  415:                                             $lti{$itemid}{'lifetime'},$cdom,$r->dir_config('lonLTIDir'))) {
  416:         &invalid_request($r,17);
  417:         return OK;
  418:     }
  419: 
  420: #
  421: # Determine if a username is required from the domain
  422: # configuration for the specific LTI Consumer
  423: #
  424: 
  425:     if (!$lti{$itemid}{'requser'}) {
  426:         if ($tail =~ m{^/tiny/($match_domain)/(\w+)$}) {
  427:             my $ltitype = 'd';
  428:             foreach my $key (%{$params}) {
  429:                 delete($env{'form.'.$key});
  430:             }
  431:             my $ltoken = &Apache::lonnet::tmpput({'linkprot' => $itemid.$ltitype.':'.$tail},
  432:                                                    $lonhost);
  433:             if ($ltoken) {
  434:                 $r->internal_redirect($tail.'?ltoken='.$ltoken);
  435:                 $r->set_handlers('PerlHandler'=> undef);
  436:             } else {
  437:                 &invalid_request($r,18);
  438:             }
  439:         } else {
  440:             &invalid_request($r,19);
  441:         }
  442:         return OK;
  443:     }
  444: 
  445: #
  446: # Determine if source of username matches requirement from the 
  447: # domain configuration for the specific LTI Consumer.
  448: # 
  449: 
  450:     if ($lti{$itemid}{'mapuser'} eq $possmapuser) {
  451:         $uname = $possuname;
  452:     } elsif ($lti{$itemid}{'mapuser'} eq 'lis_person_sourcedid') {
  453:         if ($params->{'lis_person_sourcedid'} =~ /^$match_username$/) {
  454:             $uname = $possuname;
  455:         }
  456:     } elsif ($lti{$itemid}{'mapuser'} eq 'lis_person_contact_email_primary') {
  457:         if ($params->{'lis_person_contact_email_primary'} =~ /^$match_username$/) {
  458:             $uname = $params->{'lis_person_contact_email_primary'};
  459:         }
  460:     } elsif (exists($params->{$lti{$itemid}{'mapuser'}})) {
  461:         if ($params->{$lti{$itemid}{'mapuser'}} =~ /^$match_username$/) {
  462:             $uname = $params->{$lti{$itemid}{'mapuser'}};
  463:         }
  464:     }
  465: 
  466: #
  467: # Determine the courseID of the LON-CAPA course to which the
  468: # launch of LON-CAPA should provide access.
  469: #
  470: # Order is:
  471: #
  472: # (a) from course mapping (if the link between Consumer "course" and 
  473: # Provider "course" has been established previously).
  474: # (b) from tail of requested URL (after /adm/lti/) if it has format of a symb
  475: # (c) from tail of requested URL (after /adm/lti) if it has format of a map
  476: # (d) from tail of requested URL (after /adm/lti) if it has format /domain/courseID
  477: # (e) from tail of requested URL (after /adm/lti) if it has format /tiny/domain/\w+
  478: #     i.e., a shortened URL (see bug #6400).
  479: #
  480: # If Consumer course included in POSTed data points as a target course which
  481: # has a format which matches a LON-CAPA courseID, but the course does not
  482: # exist, the request is invalid.
  483: # 
  484: 
  485:     my ($sourcecrs,%consumers);
  486:     if ($lti{$itemid}{'mapcrs'} eq 'course_offering_sourcedid') {
  487:         $sourcecrs = $params->{'course_offering_sourcedid'};
  488:     } elsif ($lti{$itemid}{'mapcrs'} eq 'context_id') {
  489:         $sourcecrs = $params->{'context_id'};
  490:     } elsif ($lti{$itemid}{'mapcrs'} ne '') {
  491:         $sourcecrs = $params->{$lti{$itemid}{'mapcrs'}};
  492:     }
  493: 
  494:     my $posscnum;
  495:     if ($sourcecrs ne '') {
  496:         %consumers = &Apache::lonnet::get_dom('lticonsumers',[$sourcecrs],$cdom);
  497:         if (exists($consumers{$sourcecrs})) {
  498:             if ($consumers{$sourcecrs} =~ /^$match_courseid$/) {
  499:                 my $crshome = &Apache::lonnet::homeserver($consumers{$sourcecrs},$cdom);
  500:                 if ($crshome =~ /(con_lost|no_host|no_such_host)/) {
  501:                     &invalid_request($r,20);
  502:                     return OK;
  503:                 } else {
  504:                     $posscnum = $consumers{$sourcecrs};
  505:                 }
  506:             }
  507:         }
  508:     }
  509: 
  510:     if ($urlcnum ne '') {
  511:         if ($posscnum ne '') {
  512:             if ($posscnum ne $urlcnum) {
  513:                 &invalid_request($r,21);
  514:                 return OK;
  515:             } else {
  516:                 $cnum = $posscnum;
  517:             }
  518:         } else {
  519:             my $crshome = &Apache::lonnet::homeserver($urlcnum,$cdom);
  520:             if ($crshome =~ /(con_lost|no_host|no_such_host)/) {
  521:                 &invalid_request($r,22);
  522:                 return OK;
  523:             } else {
  524:                 $cnum = $urlcnum;
  525:             }
  526:         }
  527:     } elsif ($posscnum ne '') {
  528:         $cnum = $posscnum;
  529:     }
  530: 
  531: #
  532: # Get LON-CAPA role(s) to use from role-mapping of Consumer roles
  533: # defined in domain configuration for the appropriate LTI
  534: # Consumer.
  535: #
  536: # If multiple LON-CAPA roles are indicated for the current user,
  537: # ordering (from first to last) is: cc/co, in, ta, ep, st.
  538: #
  539: 
  540:     my (@ltiroles,@lcroles);
  541:     my @lcroleorder = ('cc','in','ta','ep','st');
  542:     my ($lcrolesref,$ltirolesref) = 
  543:         &LONCAPA::ltiutils::get_lc_roles($params->{'roles'},
  544:                                          \@lcroleorder,
  545:                                          $lti{$itemid}{maproles});
  546:     if (ref($lcrolesref) eq 'ARRAY') {
  547:         @lcroles = @{$lcrolesref};
  548:     }
  549:     if (ref($ltirolesref) eq 'ARRAY') {
  550:         @ltiroles = @{$ltirolesref};
  551:     }
  552: 
  553: #
  554: # If no LON-CAPA username  -- is user allowed to create one?
  555: #
  556: 
  557:     my $selfcreate;
  558:     if (($uname ne '') && ($udom ne '')) {
  559:         $uhome = &Apache::lonnet::homeserver($uname,$udom);
  560:         if ($uhome =~ /(con_lost|no_host|no_such_host)/) {
  561:             &Apache::lonnet::logthis(" LTI authorized unknown user $uname:$udom ");
  562:             if (ref($lti{$itemid}{'makeuser'}) eq 'ARRAY') {
  563:                 if (@{$lti{$itemid}{'makeuser'}} > 0) {
  564:                     foreach my $ltirole (@ltiroles) {
  565:                         if (grep(/^\Q$ltirole\E$/,@{$lti{$itemid}{'makeuser'}})) {
  566:                             $selfcreate = 1;
  567:                             last;
  568:                         }
  569:                     }
  570:                 }
  571:             }
  572:             if ($selfcreate) {
  573:                 my (%rulematch,%inst_results,%curr_rules,%got_rules,%alerts);
  574:                 my $domdesc = &Apache::lonnet::domain($udom,'description');
  575:                 my %data = (
  576:                     'permanentemail' => $env{'form.lis_person_contact_email_primary'},
  577:                     'firstname'      => $env{'form.lis_person_name_given'},
  578:                     'lastname'       => $env{'form.lis_person_name_family'},
  579:                     'fullname'       => $env{'form.lis_person_name_full'},
  580:                 );
  581:                 my $result =
  582:                     &LONCAPA::ltiutils::create_user($lti{$itemid},$uname,$udom,
  583:                                                     $domdesc,\%data,\%alerts,\%rulematch,
  584:                                                     \%inst_results,\%curr_rules,%got_rules);
  585:                 if ($result eq 'notallowed') {
  586:                     &invalid_request($r,23);
  587:                 } elsif ($result eq 'ok') {
  588:                     if (($ltiroles[0] eq 'Instructor') && ($lcroles[0] eq 'cc') && ($lti{$itemid}{'mapcrs'}) &&
  589:                         ($lti{$itemid}{'makecrs'})) {
  590:                         unless (&Apache::lonnet::usertools_access($uname,$udom,'lti','reload','requestcourses')) {
  591:                             &Apache::lonnet::put('environment',{ 'requestcourses.lti' => 'autolimit=', },$udom,$uname);
  592:                         }
  593:                     }
  594:                 } else {
  595:                     &invalid_request($r,24);
  596:                     return OK;
  597:                 }
  598:             } else {
  599:                 &invalid_request($r,25);
  600:                 return OK;
  601:             }
  602:         }
  603:     } else {
  604:         &invalid_request($r,26);
  605:         return OK;
  606:     }
  607: 
  608: #
  609: # If no LON-CAPA course available, check if domain's configuration
  610: # for the specific LTI Consumer allows a new course to be created 
  611: # (requires role in Consumer to be: Instructor and Instructor to map to CC)
  612: #
  613: 
  614:     my $reqcrs;
  615:     if ($cnum eq '') {
  616:         if ($lti{$itemid}{'crsinc'}) {
  617:             if ((@ltiroles) && ($lti{$itemid}{'mapcrs'}) &&
  618:                 ($ltiroles[0] eq 'Instructor') && ($lcroles[0] eq 'cc') && ($lti{$itemid}{'makecrs'})) {
  619:                 my (%can_request,%request_domains);
  620:                 &Apache::lonnet::check_can_request($cdom,\%can_request,\%request_domains,$uname,$udom);
  621:                 if ($can_request{'lti'}) {
  622:                     $reqcrs = 1;
  623:                     &lti_session($r,$itemid,$uname,$udom,$uhome,$lonhost,undef,$mapurl,$tail,
  624:                                  $symb,$cdom,$cnum,$params,\@ltiroles,$lti{$itemid},\@lcroles,
  625:                                  $reqcrs,$sourcecrs);
  626:                 } else {
  627:                     &invalid_request($r,27);
  628:                 }
  629:             } else {
  630:                 &invalid_request($r,28);
  631:             }
  632:         } else {
  633:             &lti_session($r,$itemid,$uname,$udom,$uhome,$lonhost,undef,$mapurl,$tail,
  634:                          $symb,$cdom,$cnum,$params,\@ltiroles,$lti{$itemid},\@lcroles,
  635:                          $reqcrs,$sourcecrs);
  636:         }
  637:         return OK;
  638:     }
  639: 
  640: #
  641: # If LON-CAPA course is a Community, and LON-CAPA role
  642: # indicated is cc, change role indicated to co.
  643: #
  644: 
  645:     my %crsenv;
  646:     if ($lcroles[0] eq 'cc') {
  647:         if (($cdom ne '') && ($cnum ne '')) {
  648:             %crsenv = &Apache::lonnet::coursedescription($cdom.'_'.$cnum,{ 'one_time' => 1,});
  649:             if ($crsenv{'type'} eq 'Community') {
  650:                 $lcroles[0] = 'co';
  651:             }
  652:         }
  653:     }
  654: 
  655: #
  656: # Determine if user has a LON-CAPA role in the mapped LON-CAPA course.
  657: # If multiple LON-CAPA roles are available for the user's assigned LTI roles,
  658: # choose the first available LON-CAPA role in the order: cc/co, in, ta, ep, st
  659: #
  660: 
  661:     my ($role,$usec,$withsec);
  662:     unless ((($lcroles[0] eq 'cc') || ($lcroles[0] eq 'co')) && (@lcroles == 1)) {
  663:         if ($lti{$itemid}{'section'} ne '') {
  664:             if ($lti{$itemid}{'section'} eq 'course_section_sourcedid') {
  665:                 if ($env{'form.course_section_sourcedid'} !~ /\W/) {
  666:                     $usec = $env{'form.course_section_sourcedid'};
  667:                 }
  668:             } elsif ($env{'form.'.$lti{$itemid}{'section'}} !~ /\W/) {
  669:                 $usec = $env{'form.'.$lti{$itemid}{'section'}};
  670:             }
  671:         }
  672:         if ($usec ne '') {
  673:             $withsec = 1;
  674:         }
  675:     }
  676: 
  677:     if (@lcroles) {
  678:         my %crsroles = &Apache::lonnet::get_my_roles($uname,$udom,'userroles',undef,\@lcroles,
  679:                                                      [$cdom],$withsec);
  680:         foreach my $reqrole (@lcroles) {
  681:             if ($withsec) {
  682:                 my $incsec;
  683:                 if (($reqrole eq 'cc') || ($reqrole eq 'co')) {
  684:                     $incsec = '';
  685:                 } else {
  686:                     $incsec = $usec;
  687:                 }
  688:                 if (exists($crsroles{$cnum.':'.$cdom.':'.$reqrole.':'.$incsec})) {
  689:                     $role = $reqrole.'./'.$cdom.'/'.$cnum;
  690:                     if ($incsec ne '') {
  691:                         $role .= '/'.$usec;
  692:                     }
  693:                     last;
  694:                 }
  695:             } else {
  696:                 if (exists($crsroles{$cnum.':'.$cdom.':'.$reqrole})) {
  697:                     $role = $reqrole.'./'.$cdom.'/'.$cnum;
  698:                     last;
  699:                 }
  700:             }
  701:         }
  702:     }
  703: 
  704: #
  705: # Determine if user can selfenroll
  706: #
  707: 
  708:     my ($reqrole,$selfenrollrole);
  709:     if ($role eq '') {
  710:         if ((@ltiroles) && (ref($lti{$itemid}{'selfenroll'}) eq 'ARRAY')) {
  711:             foreach my $ltirole (@ltiroles) {
  712:                 if (grep(/^\Q$ltirole\E$/,@{$lti{$itemid}{'selfenroll'}})) {
  713:                     if (ref($lti{$itemid}{maproles}) eq 'HASH') {
  714:                         $reqrole = $lti{$itemid}{maproles}{$ltirole};
  715:                         last;
  716:                     }
  717:                 }
  718:             }
  719:         }
  720:         if ($reqrole eq '') {
  721:             &invalid_request($r,29);
  722:             return OK;
  723:         } else {
  724:             unless (%crsenv) {
  725:                 %crsenv = &Apache::lonnet::coursedescription($cdom.'_'.$cnum);
  726:             }
  727:             my $default_enrollment_start_date = $crsenv{'default_enrollment_start_date'};
  728:             my $default_enrollment_end_date   = $crsenv{'default_enrollment_end_date'};
  729:             my $now = time;
  730:             if ($default_enrollment_end_date && $default_enrollment_end_date <= $now) {
  731:                 &invalid_request($r,30);
  732:                 return OK;
  733:             } elsif ($default_enrollment_start_date && $default_enrollment_start_date >$now) {
  734:                 &invalid_request($r,31);
  735:                 return OK;
  736:             } else {
  737:                 $selfenrollrole = $reqrole.'./'.$cdom.'/'.$cnum;
  738:                 if (($withsec) && ($reqrole ne 'cc') && ($reqrole ne 'co')) {
  739:                     if ($usec ne '') {
  740:                         $selfenrollrole .= '/'.$usec;
  741:                     }
  742:                 }
  743:             }
  744:         }
  745:     }
  746: 
  747: #
  748: # Retrieve course type of LON-CAPA course to check if mapping from a Consumer
  749: # course identifier permitted for this type of course (one of: official,
  750: # unofficial, community, textbook, placement or lti.
  751: #
  752: 
  753:     unless (%crsenv) {
  754:         %crsenv = &Apache::lonnet::coursedescription($cdom.'_'.$cnum);
  755:     }
  756:     my $crstype = lc($crsenv{'type'});
  757:     if ($crstype eq '') {
  758:         $crstype = 'course';
  759:     }
  760:     if ($crstype eq 'course') {
  761:         if ($crsenv{'internal.coursecode'}) {
  762:             $crstype = 'official';
  763:         } elsif ($crsenv{'internal.textbook'}) {
  764:             $crstype = 'textbook';
  765:         } elsif ($crsenv{'internal.lti'}) {
  766:             $crstype = 'lti';
  767:         } else {
  768:             $crstype = 'unofficial';
  769:         }
  770:     }
  771: 
  772: #
  773: # Store consumer-to-LON-CAPA course mapping if permitted
  774: #
  775: 
  776:     if (($lti{$itemid}{'storecrs'}) && ($sourcecrs ne '') && 
  777:         ($consumers{$sourcecrs} eq '') && ($cnum ne '')) {
  778:         if (ref($lti{$itemid}{'mapcrstype'}) eq 'ARRAY') {
  779:             if (grep(/^$crstype$/,@{$lti{$itemid}{'mapcrstype'}})) {
  780:                 &Apache::lonnet::put_dom('lticonsumers',{ $sourcecrs => $cnum },$cdom);
  781:             }
  782:         }
  783:     }
  784: 
  785: #
  786: # Start user session
  787: #
  788: 
  789:     &lti_session($r,$itemid,$uname,$udom,$uhome,$lonhost,$role,$mapurl,$tail,$symb,
  790:                  $cdom,$cnum,$params,\@ltiroles,$lti{$itemid},\@lcroles,undef,$sourcecrs,
  791:                  $selfenrollrole);
  792:     return OK;
  793: }
  794: 
  795: sub get_lti_itemid {
  796:     my ($requri,$hostname,$params,$lti,$lti_by_key) = @_;
  797:     return unless ((ref($params) eq 'HASH') && (ref($lti) eq 'HASH')  && (ref($lti_by_key) eq 'HASH'));
  798: 
  799:     if (exists($params->{'oauth_callback'})) {
  800:         $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0A;
  801:     } else {
  802:         $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0;
  803:     }
  804: 
  805:     my $protocol = 'http';
  806:     if ($ENV{'SERVER_PORT'} == 443) {
  807:         $protocol = 'https';
  808:     }
  809: 
  810:     my ($itemid,$consumer_key,$secret);
  811:     my $consumer_key = $params->{'oauth_consumer_key'};
  812:     if (ref($lti_by_key->{$consumer_key}) eq 'ARRAY') {
  813:         foreach my $id (@{$lti_by_key->{$consumer_key}}) {
  814:             if (ref($lti->{$id}) eq 'HASH') {
  815:                 $secret = $lti->{$id}{'secret'};
  816:                 my $request = Net::OAuth->request('request token')->from_hash($params,
  817:                                                    request_url => $protocol.'://'.$hostname.$requri,
  818:                                                    request_method => $env{'request.method'},
  819:                                                    consumer_secret => $secret,);
  820:                 if ($request->verify()) {
  821:                     $itemid = $id;
  822:                     last;
  823:                 }
  824:             }
  825:         }
  826:     }
  827:     return $itemid;
  828: }
  829: 
  830: sub lti_enroll {
  831:     my ($uname,$udom,$selfenrollrole) = @_;
  832:     my $enrollresult;
  833:     my ($role,$cdom,$cnum,$sec) =
  834:            ($selfenrollrole =~ m{^(\w+)\./($match_domain)/($match_courseid)(?:|/(\w*))$});
  835:     if (($cnum ne '') && ($cdom ne '')) {
  836:         my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
  837:         if ($chome ne 'no_host') {
  838:             my %coursehash = &Apache::lonnet::coursedescription($cdom.'_'.$cnum);
  839:             my $start = $coursehash{'default_enrollment_start_date'};
  840:             my $end = $coursehash{'default_enrollment_end_date'};
  841:             $enrollresult = &LONCAPA::ltiutils::enrolluser($udom,$uname,$role,$cdom,$cnum,$sec,
  842:                                                            $start,$end,1);
  843:         }
  844:     }
  845:     return $enrollresult;
  846: }
  847: 
  848: sub lti_reqcrs {
  849:     my ($r,$cdom,$form,$uname,$udom) = @_;
  850:     my (%can_request,%request_domains);
  851:     &Apache::lonnet::check_can_request($cdom,\%can_request,\%request_domains,$uname,$udom);
  852:     if ($can_request{'lti'}) {
  853:         my %domconfig = &Apache::lonnet::get_dom('configuration',['requestcourses'],$cdom);
  854:         my %domdefs = &Apache::lonnet::get_domain_defaults($cdom);
  855:         &Apache::lonrequestcourse::print_textbook_form($r,$cdom,[$cdom],\%domdefs,
  856:                                                        $domconfig{'requestcourses'},
  857:                                                        \%can_request,'lti',$form);
  858:     } else {
  859:         $r->print(
  860:               &Apache::loncommon::start_page('Invalid LTI call',undef,{'only_body' => 1}).
  861:               &mt('Invalid LTI call').
  862:               &Apache::loncommon::end_page()
  863:         );
  864:     }
  865: }
  866: 
  867: sub lti_session {
  868:     my ($r,$itemid,$uname,$udom,$uhome,$lonhost,$role,$mapurl,$tail,$symb,$cdom,$cnum,
  869:         $params,$ltiroles,$ltihash,$lcroles,$reqcrs,$sourcecrs,$selfenrollrole) = @_;
  870:     return unless ((ref($params) eq 'HASH') && (ref($ltiroles) eq 'ARRAY') &&
  871:                    (ref($ltihash) eq 'HASH') && (ref($lcroles) eq 'ARRAY'));
  872: #
  873: # Check if user should be hosted here or switched to another server.
  874: #
  875:     $r->user($uname);
  876:     if ($cnum) {
  877:         if ($role) {
  878:             &Apache::lonnet::logthis(" LTI authorized user ($itemid): $uname:$udom, role: $role, course: $cdom\_$cnum");
  879:         } elsif ($selfenrollrole =~ m{^(\w+)\./$cdom/$cnum}) {
  880:             &Apache::lonnet::logthis(" LTI authorized user ($itemid): $uname:$udom, desired role: $1 course: $cdom\_$cnum");
  881:         }
  882:     } else {
  883:         &Apache::lonnet::logthis(" LTI authorized user ($itemid): $uname:$udom, course dom: $cdom");
  884:     }
  885:     my ($is_balancer,$otherserver,$hosthere);
  886:     ($is_balancer,$otherserver) =
  887:         &Apache::lonnet::check_loadbalancing($uname,$udom,'login');
  888:     if ($is_balancer) {
  889:         if ($otherserver eq '') {
  890:             my $lowest_load;
  891:             ($otherserver,undef,undef,undef,$lowest_load) = &Apache::lonnet::choose_server($udom);
  892:             if ($lowest_load > 100) {
  893:                 $otherserver = &Apache::lonnet::spareserver($r,$lowest_load,$lowest_load,1,$udom);
  894:             }
  895:         }
  896:         if ($otherserver ne '') {
  897:             my @hosts = &Apache::lonnet::current_machine_ids();
  898:             if (grep(/^\Q$otherserver\E$/,@hosts)) {
  899:                 $hosthere = $otherserver;
  900:             }
  901:         }
  902:     }
  903:     my $protocol = 'http';
  904:     if ($ENV{'SERVER_PORT'} == 443) {
  905:         $protocol = 'https';
  906:     }
  907:     if (($is_balancer) && (!$hosthere)) {
  908:         # login but immediately go to switch server.
  909:         &Apache::lonauth::success($r,$uname,$udom,$uhome,'noredirect');
  910:         if (($ltihash->{'callback'}) && ($params->{$ltihash->{'callback'}})) {
  911:             &LONCAPA::ltiutils::setup_logout_callback($uname,$udom,$otherserver,
  912:                                                       $ltihash->{'key'},
  913:                                                       $ltihash->{'secret'},
  914:                                                       $params->{$ltihash->{'callback'}},
  915:                                                       $r->dir_config('ltiIDsDir'),
  916:                                                       $protocol,$r->hostname);
  917:         }
  918:         if ($symb) {
  919:             $env{'form.symb'} = $symb;
  920:             $env{'request.lti.uri'} = $tail;
  921:         } else {
  922:             if ($mapurl) {
  923:                 $env{'form.origurl'} = $mapurl;
  924:                 $env{'request.lti.uri'} = $mapurl;
  925:             } elsif ($tail =~ m{^\Q/tiny/$cdom/\E\w+$}) {
  926:                 $env{'form.origurl'} = $tail;
  927:                 $env{'request.lti.uri'} = $tail;
  928:             } elsif ($tail eq "/$cdom/$cnum") {
  929:                 $env{'form.origurl'} = '/adm/navmaps';
  930:                 $env{'request.lti.uri'} = $tail;
  931:             } else {
  932:                 unless ($tail eq '/adm/roles') {
  933:                     if ($cnum) {
  934:                         $env{'form.origurl'} = '/adm/navmaps';
  935:                     }
  936:                 }
  937:             }
  938:         }
  939:         if ($role) {
  940:             $env{'form.role'} = $role;
  941:         }
  942:         if (($lcroles->[0] eq 'cc') && ($reqcrs)) {
  943:             $env{'request.lti.reqcrs'} = 1;
  944:             $env{'request.lti.reqrole'} = 'cc';
  945:             $env{'request.lti.sourcecrs'} = $sourcecrs;
  946:         }
  947:         if ($selfenrollrole) {
  948:             $env{'request.lti.selfenrollrole'} = $selfenrollrole;
  949:             $env{'request.lti.sourcecrs'} = $sourcecrs;
  950:         }
  951:         if ($ltihash->{'passback'}) {
  952:             if ($params->{'lis_result_sourcedid'}) {
  953:                 $env{'request.lti.passbackid'} = $params->{'lis_result_sourcedid'};
  954:             }
  955:             if ($params->{'lis_outcome_service_url'}) {
  956:                 $env{'request.lti.passbackurl'} = $params->{'lis_outcome_service_url'};
  957:             }
  958:         }
  959:         if (($ltihash->{'roster'}) && (grep(/^Instructor$/,@{$ltiroles}))) {
  960:             if ($params->{'ext_ims_lis_memberships_id'}) {
  961:                 $env{'request.lti.rosterid'} = $params->{'ext_ims_lis_memberships_id'};
  962:             }
  963:             if ($params->{'ext_ims_lis_memberships_url'}) {
  964:                 $env{'request.lti.rosterurl'} = $params->{'ext_ims_lis_memberships_url'};
  965:             }
  966:         }
  967:         $env{'request.lti.login'} = $itemid;
  968:         if ($params->{'launch_presentation_document_target'}) {
  969:             $env{'request.lti.target'} = $params->{'launch_presentation_document_target'};
  970:         }
  971:         foreach my $key (keys(%{$params})) {
  972:             delete($env{'form.'.$key});
  973:         }
  974:         my $redirecturl = '/adm/switchserver';
  975:         if ($otherserver ne '') {
  976:             $redirecturl .= '?otherserver='.$otherserver;
  977:         }
  978:         $r->internal_redirect($redirecturl);
  979:         $r->set_handlers('PerlHandler'=> undef);
  980:     } else {
  981:         # need to login them in, so generate the need data that
  982:         # migrate expects to do login
  983:         foreach my $key (keys(%{$params})) {
  984:             delete($env{'form.'.$key});
  985:         }
  986:         if (($ltihash->{'callback'}) && ($params->{$ltihash->{'callback'}})) {
  987:             &LONCAPA::ltiutils::setup_logout_callback($uname,$udom,$lonhost,
  988:                                                       $ltihash->{'key'},
  989:                                                       $ltihash->{'secret'},
  990:                                                       $params->{$ltihash->{'callback'}},
  991:                                                       $r->dir_config('ltiIDsDir'),
  992:                                                       $protocol,$r->hostname);
  993:         }
  994:         my $ip = $r->get_remote_host();
  995:         my %info=('ip'        => $ip,
  996:                   'domain'    => $udom,
  997:                   'username'  => $uname,
  998:                   'server'    => $lonhost,
  999:                   'lti.login' => $itemid,
 1000:                   'lti.uri'   => $tail,
 1001:                  );
 1002:         if ($role) {
 1003:             $info{'role'} = $role;
 1004:         }
 1005:         if ($symb) {
 1006:             $info{'symb'} = $symb;
 1007:         }
 1008:         if (($lcroles->[0] eq 'cc') && ($reqcrs)) {
 1009:             $info{'lti.reqcrs'} = 1;
 1010:             $info{'lti.reqrole'} = 'cc';
 1011:             $info{'lti.sourcecrs'} = $sourcecrs;
 1012:         }
 1013:         if ($selfenrollrole) {
 1014:             $info{'lti.selfenrollrole'} = $selfenrollrole;
 1015:         }
 1016:         if ($ltihash->{'passback'}) {
 1017:             if ($params->{'lis_result_sourcedid'}) {
 1018:                 $info{'lti.passbackid'} = $params->{'lis_result_sourcedid'}
 1019:             }
 1020:             if ($params->{'lis_outcome_service_url'}) {
 1021:                 $info{'lti.passbackurl'} = $params->{'lis_outcome_service_url'}
 1022:             }
 1023:         }
 1024:         if (($ltihash->{'roster'}) && (grep(/^Instructor$/,@{$ltiroles}))) {
 1025:             if ($params->{'ext_ims_lis_memberships_id'}) {
 1026:                 $info{'lti.rosterid'} = $params->{'ext_ims_lis_memberships_id'};
 1027:             }
 1028:             if ($params->{'ext_ims_lis_memberships_url'}) {
 1029:                 $info{'lti.rosterurl'} = $params->{'ext_ims_lis_memberships_url'};
 1030:             }
 1031:         }
 1032:         if ($params->{'launch_presentation_document_target'}) {
 1033:             $info{'lti.target'} = $params->{'launch_presentation_document_target'};
 1034:         }
 1035: 
 1036:         unless ($info{'symb'}) {
 1037:             if ($mapurl) {
 1038:                 $info{'origurl'} = $mapurl;
 1039:             } elsif ($tail =~ m{^\Q/tiny/$cdom/\E\w+$}) {
 1040:                 $info{'origurl'} = $tail;
 1041:             } else {
 1042:                 unless ($tail eq '/adm/roles') {
 1043:                     if ($cnum) {
 1044:                         $info{'origurl'} = '/adm/navmaps';
 1045:                     }
 1046:                 }
 1047:             }
 1048:         }
 1049:         if (($is_balancer) && ($hosthere)) {
 1050:             $info{'noloadbalance'} = $hosthere;
 1051:         }
 1052:         my $token = &Apache::lonnet::tmpput(\%info,$lonhost);
 1053:         $env{'form.token'} = $token;
 1054:         $r->internal_redirect('/adm/migrateuser');
 1055:         $r->set_handlers('PerlHandler'=> undef);
 1056:     }
 1057:     return;
 1058: }
 1059: 
 1060: sub invalid_request {
 1061:     my ($r,$num) = @_;
 1062:     &Apache::loncommon::content_type($r,'text/html');
 1063:     $r->send_http_header;
 1064:     if ($r->header_only) {
 1065:         return;
 1066:     }
 1067:     &Apache::lonlocal::get_language_handle($r);
 1068:     $r->print(
 1069:         &Apache::loncommon::start_page('Invalid LTI call','',{ 'only_body' => 1,}).
 1070:         &mt('Invalid LTI call [_1]',$num).
 1071:         &Apache::loncommon::end_page());
 1072:     return;
 1073: }
 1074: 
 1075: sub course_from_tinyurl {
 1076:     my ($tail) = @_;
 1077:     my ($urlcdom,$urlcnum);
 1078:     if ($tail =~ m{^/tiny/($match_domain)/(\w+)$}) {
 1079:         ($urlcdom,my $key) = ($1,$2);
 1080:         my $tinyurl;
 1081:         my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$urlcdom."\0".$key);
 1082:         if (defined($cached)) {
 1083:             $tinyurl = $result;
 1084:         } else {
 1085:             my $configuname = &Apache::lonnet::get_domainconfiguser($urlcdom);
 1086:             my %currtiny = &Apache::lonnet::get('tiny',[$key],$urlcdom,$configuname);
 1087:             if ($currtiny{$key} ne '') {
 1088:                 $tinyurl = $currtiny{$key};
 1089:                 &Apache::lonnet::do_cache_new('tiny',$urlcdom."\0".$key,$currtiny{$key},600);
 1090:             }
 1091:         }
 1092:         if ($tinyurl ne '') {
 1093:             $urlcnum = (split(/\&/,$tinyurl))[0];
 1094:         }
 1095:     }
 1096:     return ($urlcdom,$urlcnum);
 1097: }
 1098: 
 1099: 1;

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