File:  [LON-CAPA] / loncom / lti / ltiauth.pm
Revision 1.1: download - view: text, annotated - select for diffs
Wed Dec 6 01:53:56 2017 UTC (6 years, 9 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD
- Bug 6754 LTI Integration: LON-CAPA as LTI Provider
  - Move auth/lonlti.pm to lti/ltiauth.pm

    1: # The LearningOnline Network
    2: # Basic LTI Authentication Module
    3: #
    4: # $Id: ltiauth.pm,v 1.1 2017/12/06 01:53:56 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: 
   40: sub handler {
   41:     my $r = shift;
   42:     my $requri = $r->uri;
   43: #
   44: # Retrieve data POSTed by LTI Consumer on launch  
   45: #
   46:     &Apache::lonacc::get_posted_cgi($r);
   47:     my $params = {};
   48:     foreach my $key (sort(keys(%env))) {
   49:         if ($key =~ /^form\.(.+)$/) {
   50:             $params->{$1} = $env{$key};
   51:         }
   52:     }
   53: 
   54:     unless (keys(%{$params})) {
   55:         &invalid_request($r,1);
   56:         return OK;
   57:     }
   58: 
   59:     unless ($params->{'oauth_consumer_key'} &&
   60:             $params->{'oauth_nonce'} &&
   61:             $params->{'oauth_timestamp'} &&
   62:             $params->{'oauth_version'} &&
   63:             $params->{'oauth_signature'} &&
   64:             $params->{'oauth_signature_method'}) {
   65:         &invalid_request($r,2);
   66:         return OK;
   67:     }
   68: 
   69: #
   70: # Retrieve "internet domains" for all this institution's LON-CAPA
   71: # nodes.
   72: #
   73:     my ($udom,$uname,$uhome,$cdom,$cnum,$symb,$mapurl,@intdoms);
   74:     my $lonhost = $r->dir_config('lonHostID');
   75:     my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
   76:     if (ref($internet_names) eq 'ARRAY') {
   77:         @intdoms = @{$internet_names};
   78:     }
   79: 
   80: #
   81: # For user who launched LTI in Consumer, determine user's domain in 
   82: # LON-CAPA.
   83: #
   84: # Order is:
   85: #
   86: # (a) from custom_userdomain item in POSTed data
   87: # (b) from lis_person_sourcedid in POSTed data
   88: # (c) from default "log-in" domain for node
   89: #     (can support multidomain servers, where specific domain is 
   90: #      first part of hostname).
   91: #
   92: # Note: "internet domain" for user's domain must be one of the
   93: # "internet domain(s)" for the institution's LON-CAPA servers.
   94: #
   95:     if (exists($params->{'custom_userdomain'})) {
   96:         if ($params->{'custom_userdomain'} =~ /^$match_domain$/) {
   97:             my $uprimary_id = &Apache::lonnet::domain($params->{'custom_userdomain'},'primary');
   98:             if ($uprimary_id ne '') {
   99:                 my $uintdom = &Apache::lonnet::internet_dom($uprimary_id);
  100:                 if (($uintdom ne '') && (grep(/^\Q$uintdom\E$/,@intdoms))) {
  101:                     $udom = $params->{'custom_userdomain'};
  102:                 }
  103:             }
  104:         }
  105:     }
  106:     my $defdom = &Apache::lonnet::default_login_domain();
  107:     my ($domain,$possuname,$possudom,$possmapuser);
  108:     if ($env{'form.lis_person_sourcedid'} =~ /^($match_username)\:($match_domain)$/) {
  109:         ($possuname,$possudom) = ($1,$2);
  110:         if ($udom eq '') {
  111:             my $uintdom = &Apache::lonnet::domain($possudom,'primary');
  112:             if (($uintdom ne '') && (grep(/^\Q$uintdom\E$/,@intdoms))) {
  113:                 $udom = $possudom;
  114:                 $possmapuser = 'lis_person_sourcedid';
  115:             } else {
  116:                 $udom = $defdom;
  117:             }
  118:         } elsif ($udom eq $possudom) {
  119:             $possmapuser = 'lis_person_sourcedid';
  120:         }
  121:     }
  122:     unless ($possuname) {
  123:         if ($env{'form.lis_person_sourcedid'} =~ /^$match_username$/) {
  124:             $possuname = $env{'form.lis_person_sourcedid'};
  125:             $possmapuser = 'lis_person_sourcedid';
  126:         } elsif ($env{'form.lis_person_contact_email_primary'} =~ /^$match_username$/) {
  127:             $possuname = $env{'form.lis_person_contact_email_primary'};
  128:             $possmapuser = 'lis_person_contact_email_primary';
  129:         }
  130:         unless ($udom) {
  131:             $udom = $defdom;
  132:         }
  133:     }
  134: 
  135: #
  136: # Determine course's domain in LON-CAPA
  137: #
  138: # Order is:
  139: #
  140: # (a) from custom_coursedomain item in POSTed data
  141: # (b) from tail of requested URL (after /adm/lti) if it has format of a symb  
  142: # (c) from tail of requested URL (after /adm/lti) if it has format of a map 
  143: # (d) from tail of requested URL (after /adm/lti) if it has format /domain/courseID
  144: # (e) from tail of requested URL (after /adm/lti) if it has format /tiny/domain/...
  145: # i.e., a shortened URL (see bug #6400) -- not implemented yet.   
  146: # (f) same as user's domain 
  147: #
  148: # Request invalid if custom_coursedomain is defined and is inconsistent with
  149: # domain contained in requested URL.
  150: #
  151: # Note: "internet domain" for course's domain must be one of the
  152: # internet domains for the institution's LON-CAPA servers.
  153: #
  154: 
  155:     if (exists($params->{'custom_coursedomain'})) {
  156:         if ($params->{'custom_coursedomain'} =~ /^$match_domain$/) {
  157:             my $cprimary_id = &Apache::lonnet::domain($params->{'custom_coursedomain'},'primary');
  158:             if ($cprimary_id ne '') {
  159:                 my $cintdom = &Apache::lonnet::internet_dom($cprimary_id);
  160:                 if (($cintdom ne '') && (grep(/^\Q$cintdom\E$/,@intdoms))) {
  161:                     $cdom = $params->{'custom_coursedomain'};
  162:                 }
  163:             }
  164:         }
  165:     }
  166: 
  167:     my ($tail) = ($requri =~ m{^/adm/lti(|/.*)$});
  168:     my $urlcnum;
  169:     if ($tail ne '') {
  170:         my $urlcdom;
  171:         if ($tail =~ m{^/uploaded/($match_domain)/($match_courseid)/(?:default|supplemental)(?:|_\d+)\.(?:sequence|page)(|___\d+___.+)$}) {
  172:             ($urlcdom,$urlcnum,my $rest) = ($1,$2,$3);
  173:             if (($cdom ne '') && ($cdom ne $urlcdom)) {
  174:                 &invalid_request($r,3);
  175:                 return OK;
  176:             }
  177:             if ($rest eq '') {
  178:                 $mapurl = $tail;
  179:             } else {
  180:                 $symb = $tail;
  181:                 $symb =~ s{^/+}{};
  182:             }
  183: #FIXME Need to handle encrypted URLs 
  184:         } elsif ($tail =~ m{^/($match_domain)/($match_courseid)$}) {
  185:             ($urlcdom,$urlcnum) = ($1,$2);
  186:             if (($cdom ne '') && ($cdom ne $urlcdom)) {
  187:                 &invalid_request($r,4);
  188:                 return OK;
  189:             }
  190:         }
  191:         if (($cdom eq '') && ($urlcdom ne '')) { 
  192:             my $cprimary_id = &Apache::lonnet::domain($urlcdom,'primary');
  193:             if ($cprimary_id ne '') {
  194:                 my $cintdom = &Apache::lonnet::internet_dom($cprimary_id);
  195:                 if (($cintdom ne '') && (grep(/^\Q$cintdom\E$/,@intdoms))) {
  196:                     $cdom = $urlcdom;
  197:                 }
  198:             } else {
  199:                 $urlcnum = '';
  200:             }
  201:         }
  202:     }
  203:     if ($cdom eq '') {
  204:         if ($udom ne '') {
  205:             $cdom = $udom;
  206:         } else {
  207:             $cdom = $defdom;
  208:         }
  209:     }
  210: 
  211: #
  212: # Retrieve information for LTI Consumers in course domain
  213: # and populate hash --  %lti_by_key -- for which keys
  214: # are those defined in domain configuration for LTI.
  215: #
  216:  
  217:     my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
  218:     unless (keys(%lti) > 0) {
  219:         &invalid_request($r,5);
  220:         return OK;
  221:     }
  222:     my %lti_by_key;
  223:     if (keys(%lti)) {
  224:         foreach my $id (keys(%lti)) {
  225:             if (ref($lti{$id}) eq 'HASH') {
  226:                 my $key = $lti{$id}{'key'};
  227:                 push(@{$lti_by_key{$key}},$id);
  228:             }
  229:         }
  230:     }
  231: 
  232: #
  233: # Verify the signed request using the secret for those
  234: # Consumers for which the key in the POSTed data matches 
  235: # keys in the domain configuration for LTI.
  236: #
  237:     my $hostname = $r->hostname;
  238:     my $protocol = 'http';
  239:     if ($ENV{'SERVER_PORT'} == 443) {
  240:         $protocol = 'https';
  241:     }
  242: 
  243:     my $itemid;
  244:     my $key = $params->{'oauth_consumer_key'};
  245:     my @ltiroles;
  246:     if (ref($lti_by_key{$key}) eq 'ARRAY') {
  247:         foreach my $id (@{$lti_by_key{$key}}) {
  248:             if (ref($lti{$id}) eq 'HASH') {
  249:                 my $secret = $lti{$id}{'secret'};
  250:                 my $request = Net::OAuth->request('request token')->from_hash($params,
  251:                                                    request_url => $protocol.'://'.$hostname.$requri,
  252:                                                    request_method => $env{'request.method'},
  253:                                                    consumer_secret => $secret,);
  254:                 if ($request->verify()) {
  255:                     $itemid = $id;
  256:                     last;
  257:                 }
  258:             }
  259:         }
  260:     }
  261: 
  262: #
  263: # Request is invalid if the signed request could not be verified
  264: # for the Consumer key and Consumer secret from the domain
  265: # configuration in LON-CAPA for that LTI Consumer.
  266: #
  267:     unless (($itemid) && (ref($lti{$itemid}) eq 'HASH')) {
  268:         &invalid_request($r,6);
  269:         return OK;
  270:     }
  271: 
  272: #
  273: # Determine if nonce in POSTed data has expired.
  274: # If unexpired, confirm it has not already been used.
  275: #
  276:     unless (&check_nonce($r,$params->{'oauth_nonce'},$params->{'oauth_timestamp'},$lti{$itemid}{'lifetime'},$cdom)) {
  277:         &invalid_request($r,7);
  278:         return OK;
  279:     }
  280: 
  281: #
  282: # Determinine if source of username matches requirement from the 
  283: # domain configuration for the specific LTI Consumer.
  284: # 
  285: 
  286:     if ($lti{$itemid}{'mapuser'} eq $possmapuser) {
  287:         $uname = $possuname;
  288:     } elsif ($lti{$itemid}{'mapuser'} eq 'lis_person_sourcedid') {
  289:         if ($params->{'lis_person_sourcedid'} =~ /^$match_username$/) {
  290:             $uname = $possuname;
  291:         }
  292:     } elsif ($lti{$itemid}{'mapuser'} eq 'lis_person_contact_email_primary') {
  293:         if ($params->{'lis_person_contact_email_primary'} =~ /^$match_username$/) {
  294:             $uname = $params->{'lis_person_contact_email_primary'};
  295:         }
  296:     } elsif (exists($params->{$lti{$itemid}{'mapuser'}})) {
  297:         if ($params->{$lti{$itemid}{'mapuser'}} =~ /^$match_username$/) {
  298:             $uname = $params->{$lti{$itemid}{'mapuser'}};
  299:         }
  300:     }
  301: 
  302: #
  303: # Determine the courseID of the LON-CAPA course to which the
  304: # launch of LON-CAPA should provide access.
  305: #
  306: # Order is:
  307: #
  308: # (a) from course mapping (if the link between Consumer "course" and 
  309: # Provider "course" has been established previously).
  310: # (b) from tail of requested URL (after /adm/lti) if it has format of a symb
  311: # (c) from tail of requested URL (after /adm/lti) if it has format of a map
  312: # (d) from tail of requested URL (after /adm/lti) if it has format /domain/courseID
  313: # (e) from tail of requested URL (after /adm/lti) if it has format /tiny/domain/...
  314: # i.e., a shortened URL (see bug #6400) -- not implemented yet.
  315: #
  316: # If Consumer course included in POSTed data points as a target course which
  317: # has a format which matches a LON-CAPA courseID, but the course does not
  318: # exist, the request is invalid.
  319: # 
  320: 
  321:     my ($sourcecrs,%consumers);
  322:     if ($lti{$itemid}{'mapcrs'} eq 'course_offering_sourcedid') {
  323:         $sourcecrs = $params->{'course_offering_sourcedid'};
  324:     } elsif ($lti{$itemid}{'mapcrs'} eq 'context_id') {
  325:         $sourcecrs = $params->{'context_id'};
  326:     } elsif ($lti{$itemid}{'mapcrs'} ne '') {
  327:         $sourcecrs = $params->{$lti{$itemid}{'mapcrs'}};
  328:     }
  329: 
  330:     my $posscnum;
  331:     if ($sourcecrs ne '') {
  332:         %consumers = &Apache::lonnet::get_dom('lticonsumers',[$sourcecrs],$cdom);
  333:         if (exists($consumers{$sourcecrs})) {
  334:             if ($consumers{$sourcecrs} =~ /^$match_courseid$/) {
  335:                 my $crshome = &Apache::lonnet::homeserver($consumers{$sourcecrs},$cdom);
  336:                 if ($crshome =~ /(con_lost|no_host|no_such_host)/) {
  337:                     &invalid_request($r,8);
  338:                     return OK;
  339:                 } else {
  340:                     $posscnum = $consumers{$sourcecrs};
  341:                 }
  342:             }
  343:         }
  344:     }
  345: 
  346:     if ($urlcnum ne '') {
  347:         if ($posscnum ne '') {
  348:             if ($posscnum ne $urlcnum) {
  349:                 &invalid_request($r,9);
  350:                 return OK;
  351:             } else {
  352:                 $cnum = $posscnum;
  353:             }
  354:         } else {
  355:             my $crshome = &Apache::lonnet::homeserver($urlcnum,$cdom);
  356:             if ($crshome =~ /(con_lost|no_host|no_such_host)/) {
  357:                 &invalid_request($r,10);
  358:                 return OK;
  359:             } else {
  360:                 $cnum = $urlcnum;
  361:             }
  362:         }
  363:     } elsif ($posscnum ne '') {
  364:         $cnum = $posscnum;
  365:     }
  366: 
  367: #
  368: # Get LON-CAPA role to use from role-mapping of Consumer roles
  369: # defined in domain configuration for the appropriate LTI
  370: # Consumer.
  371: #
  372: # If multiple LON-CAPA roles are indicated, choose based
  373: # on the order: cc, in, ta, ep, st
  374: #
  375: 
  376:     my $reqrole;
  377: 
  378:     my @roleorder = ('cc','in','ta','ep','st');
  379:     if ($params->{'roles'} =~ /,/) {
  380:         @ltiroles = split(/\s*,\s*/,$params->{'role'});
  381:     } else {
  382:         my $singlerole = $params->{'roles'};
  383:         $singlerole =~ s/^\s|\s+$//g;
  384:         @ltiroles = ($singlerole);
  385:     }
  386:     if (@ltiroles) {
  387:         if (ref($lti{$itemid}{maproles}) eq 'HASH') {
  388:             my %possroles;
  389:             map { $possroles{$lti{$itemid}{maproles}{$_}} = 1; } @ltiroles;
  390:             my @possibles = keys(%possroles);
  391:             if (@possibles == 1) {
  392:                 if (grep(/^\Q$possibles[0]\E$/,@roleorder)) {
  393:                     $reqrole = $possibles[0];
  394: 
  395:                 }
  396:             } elsif (@possibles > 1) {
  397:                 foreach my $item (@roleorder) {
  398:                     if ($possroles{$item}) {
  399:                         $reqrole = $item;
  400:                         last;
  401:                     }
  402:                 }
  403:             }
  404:         }
  405:     }
  406: 
  407: #
  408: # If no LON-CAPA username  -- is user allowed to create one?
  409: #
  410: 
  411:     my $selfcreate;
  412:     if (($uname ne '') && ($udom ne '')) {
  413:         $uhome = &Apache::lonnet::homeserver($uname,$udom);
  414:         if ($uhome =~ /(con_lost|no_host|no_such_host)/) {
  415:             &Apache::lonnet::logthis(" LTI authorized unknown user $uname:$udom ");
  416:             if (ref($lti{$itemid}{'makeuser'}) eq 'ARRAY') {
  417:                 if (@{$lti{$itemid}{'makeuser'}} > 0) {
  418:                     foreach my $ltirole (@ltiroles) {
  419:                         if (grep(/^\Q$ltirole\E$/,@{$lti{$itemid}{'makeuser'}})) {
  420:                             $selfcreate = 1;
  421:                         }
  422:                     }
  423:                 }
  424:             }
  425:             if ($selfcreate) {
  426: #FIXME Do user creation here.
  427:                 return OK
  428:             } else {
  429:                 &invalid_request($r,11);
  430:                 return OK;
  431:             } 
  432:         } 
  433:     } else {
  434:         &invalid_request($r,12);
  435:         return OK;
  436:     }
  437: 
  438: #
  439: # If no LON-CAPA course available, check if domain's configuration
  440: # for the specific LTI Consumer allows a new course to be created 
  441: # (requires role in Consumer to be: Instructor).
  442: #
  443: 
  444:     if ($cnum eq '') {
  445:         if ((@ltiroles) && (grep(/^Instructor$/,@ltiroles)) &&
  446:             ($lti{$itemid}{'mapcrs'})) {
  447: #FIXME Create a new LON-CAPA course here.
  448:             return OK;
  449:         } else {
  450:             &invalid_request($r,13);
  451:             return OK; 
  452:         }
  453:     }
  454: 
  455: #
  456: # If LON-CAPA course is a Community, and LON-CAPA role
  457: # indicated is cc, change role indicated to co.
  458: # 
  459: 
  460:     if ($reqrole eq 'cc') {
  461:         if (($cdom ne '') && ($cnum ne '')) {
  462:             my %crsenv = &Apache::lonnet::coursedescription($cnum.'_'.$cdom,{ 'one_time' => 1,});
  463:             if ($crsenv{'type'} eq 'Community') {
  464:                 $reqrole = 'co'; 
  465:             }
  466:         }
  467:     }
  468: 
  469: #
  470: # Determine if user has required LON-CAPA role
  471: # in the mapped LON-CAPA course.
  472: #
  473: 
  474:     my $role;
  475:     my %crsroles = &Apache::lonnet::get_my_roles($uname,$udom,'userroles',undef,[$reqrole],[$cdom]);
  476:     if (exists($crsroles{$cnum.':'.$cdom.':'.$reqrole})) {
  477:         $role = $reqrole.'./'.$cdom.'/'.$cnum;
  478: #FIXME Need to accommodate sections
  479:     } elsif (ref($lti{$itemid}{'selfenroll'}) eq 'ARRAY') {
  480:         if (grep(/^\Q$reqrole\E$/,@{$lti{$itemid}{'selfenroll'}})) {
  481: #FIXME Do self-enrollment here
  482:             return OK;
  483:         } else {
  484:             &invalid_request($r,14);
  485:         }
  486:     }
  487: 
  488: #
  489: # Store consumer-to-LON-CAPA course mapping
  490: #
  491:     if (($sourcecrs ne '')  && ($consumers{$sourcecrs} eq '') && ($cnum ne '')) {
  492:         &Apache::lonnet::put_dom('lticonsumers',{ $sourcecrs => $cnum },$cdom);
  493:     }
  494: 
  495: #
  496: # Check if user should be hosted here or switched to another server.
  497: #
  498: 
  499:     &Apache::lonnet::logthis(" LTI authorized user: $uname:$udom role: $role course: $cnum:$cdom");
  500:     $r->user($uname);
  501:     my ($is_balancer,$otherserver,$hosthere);
  502:     ($is_balancer,$otherserver) =
  503:         &Apache::lonnet::check_loadbalancing($uname,$udom,'login');
  504:     if ($is_balancer) {
  505:         if ($otherserver eq '') {
  506:             my $lowest_load;
  507:             ($otherserver,undef,undef,undef,$lowest_load) = &Apache::lonnet::choose_server($udom);
  508:             if ($lowest_load > 100) {
  509:                 $otherserver = &Apache::lonnet::spareserver($lowest_load,$lowest_load,1,$udom);
  510:             }
  511:         }
  512:         if ($otherserver ne '') {
  513:             my @hosts = &Apache::lonnet::current_machine_ids();
  514:             if (grep(/^\Q$otherserver\E$/,@hosts)) {
  515:                 $hosthere = $otherserver;
  516:             }
  517:         }
  518:     }
  519:     if (($is_balancer) && (!$hosthere)) {
  520:         # login but immediately go to switch server.
  521:         &Apache::lonauth::success($r,$uname,$udom,$uhome,'noredirect');
  522:         if ($symb) {
  523:             $env{'form.symb'} = $symb;
  524:         }
  525:         if ($role) {
  526:             $env{'form.role'} = $role;
  527:         }
  528:         if ($lti{$itemid}{'passback'}) {
  529:             if ($params->{'lis_result_sourcedid'}) {
  530:                 $env{'request.lti.passbackid'} = $params->{'lis_result_sourcedid'};
  531:             }
  532:             if ($params->{'lis_outcome_service_url'}) {
  533:                 $env{'request.lti.passbackurl'} = $params->{'lis_outcome_service_url'};
  534:             }
  535:         }
  536:         if (($lti{$itemid}{'roster'}) && (grep(/^Instructor$/,@ltiroles))) {
  537:             if ($params->{'ext_ims_lis_memberships_id'}) {
  538:                 $env{'request.lti.rosterid'} = $params->{'ext_ims_lis_memberships_id'}; 
  539:             }
  540:             if ($params->{'ext_ims_lis_memberships_url'}) {
  541:                 $env{'request.lti.rosterurl'} = $params->{'ext_ims_lis_memberships_url'};
  542:             }
  543:         }
  544:         $env{'request.lti.login'} = 1;
  545:         foreach my $key (%{$params}) {
  546:             delete($env{'form.'.$key});
  547:         }
  548:         my $redirecturl = '/adm/switchserver';
  549:         if ($otherserver ne '') {
  550:             $redirecturl .= '?otherserver='.$otherserver;
  551:         }
  552:         $r->internal_redirect($redirecturl);
  553:         $r->set_handlers('PerlHandler'=> undef);
  554:     } else {
  555:         # need to login them in, so generate the need data that
  556:         # migrate expects to do login
  557:         foreach my $key (%{$params}) {
  558:             delete($env{'form.'.$key});
  559:         }
  560:         my $ip = $r->get_remote_host();
  561:         my %info=('ip'        => $ip,
  562:                   'domain'    => $udom,
  563:                   'username'  => $uname,
  564:                   'server'    => $lonhost,
  565:                   'lti.login' => 1,
  566:                  );
  567:         if ($role) {
  568:             $info{'role'} = $role;
  569:         }
  570:         if ($symb) {
  571:             $info{'symb'} = $symb; 
  572:         }
  573:         if ($lti{$itemid}{'passback'}) {
  574:             if ($params->{'lis_result_sourcedid'}) {
  575:                 $info{'lti.passbackid'} = $params->{'lis_result_sourcedid'}
  576:             }
  577:             if ($params->{'lis_outcome_service_url'}) {
  578:                 $info{'lti.passbackurl'} = $params->{'lis_outcome_service_url'}
  579:             }
  580:         }
  581:         if (($lti{$itemid}{'roster'}) && (grep(/^Instructor$/,@ltiroles))) {
  582:             if ($params->{'ext_ims_lis_memberships_id'}) {
  583:                 $info{'lti.rosterid'} = $params->{'ext_ims_lis_memberships_id'};
  584:             }
  585:             if ($params->{'ext_ims_lis_memberships_url'}) {
  586:                 $info{'lti.rosterurl'} = $params->{'ext_ims_lis_memberships_url'};
  587:             }
  588:         }
  589:         unless ($info{'symb'}) {
  590:             if ($mapurl) {
  591:                 $info{'origurl'} = $mapurl;
  592:                 if ($mapurl =~ m{/default_\d+\.sequence$}) {
  593:                     $info{'origurl'} .=  (($mapurl =~/\?/)?'&':'?').'navmap=1';
  594:                 }
  595:             } else {
  596:                 unless ($tail eq '/adm/roles') {
  597:                     $info{'origurl'} = '/adm/navmaps';
  598:                 }
  599:             }
  600:         }
  601:         if (($is_balancer) && ($hosthere)) {
  602:             $info{'noloadbalance'} = $hosthere;
  603:         }
  604:         my $token = &Apache::lonnet::tmpput(\%info,$lonhost);
  605:         $env{'form.token'} = $token;
  606:         $r->internal_redirect('/adm/migrateuser');
  607:         $r->set_handlers('PerlHandler'=> undef);
  608:     }
  609:     return OK;
  610: }
  611: 
  612: sub check_nonce {
  613:     my ($r,$nonce,$timestamp,$lifetime,$domain) = @_;
  614:     if (($timestamp eq '') || ($timestamp =~ /^\D/) || ($lifetime eq '') || ($lifetime =~ /\D/) || ($domain eq '')) {
  615:         return 0;
  616:     }
  617:     my $now = time;
  618:     if (($timestamp) && ($timestamp < ($now - $lifetime))) {
  619:         return 0;
  620:     }
  621:     if ($nonce eq '') {
  622:         return 0;
  623:     }
  624:     my $lonltidir = $r->dir_config('lonLTIDir');
  625:     if (-e "$lonltidir/$domain/$nonce") {
  626:         return 0;
  627:     } else {
  628:         unless (-e "$lonltidir/$domain") {
  629:             mkdir("$lonltidir/$domain",0755);
  630:         }  
  631:         if (open(my $fh,'>',"$lonltidir/$domain/$nonce")) {
  632:             print $fh $now;
  633:             close($fh);
  634:         } else {
  635:             return 0;
  636:         }
  637:     }
  638:     return 1;
  639: }
  640: 
  641: sub invalid_request {
  642:     my ($r,$num) = @_;
  643:     &Apache::loncommon::content_type($r,'text/html');
  644:     $r->send_http_header;
  645:     if ($r->header_only) {
  646:         return;
  647:     }
  648:     &Apache::lonlocal::get_language_handle($r);
  649:     $r->print(
  650:         &Apache::loncommon::start_page('Invalid LTI call').
  651:         &mt('Invalid LTI call [_1]',$num).
  652:         &Apache::loncommon::end_page());
  653:     return;
  654: }
  655: 
  656: 1;

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