Annotation of loncom/lti/ltiauth.pm, revision 1.28

1.1       raeburn     1: # The LearningOnline Network
                      2: # Basic LTI Authentication Module
                      3: #
1.28    ! raeburn     4: # $Id: ltiauth.pm,v 1.27 2021/11/24 04:25:03 raeburn Exp $
1.1       raeburn     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;
1.6       raeburn    39: use Apache::lonrequestcourse;
1.2       raeburn    40: use LONCAPA::ltiutils;
1.1       raeburn    41: 
                     42: sub handler {
                     43:     my $r = shift;
                     44:     my $requri = $r->uri;
1.20      raeburn    45:     my $hostname = $r->hostname;
1.1       raeburn    46: #
1.9       raeburn    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: #
1.20      raeburn    61: # Retrieve data POSTed by LTI launch
1.1       raeburn    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:     }
1.9       raeburn    70: #
1.22      raeburn    71: # Check for existing session, and restore temporarily
1.9       raeburn    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:     }
1.1       raeburn    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: #
1.20      raeburn   101:     my @intdoms;
1.1       raeburn   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:     }
1.20      raeburn   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},
1.24      raeburn   200:                                                                  $lonhost,'link');
1.20      raeburn   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);
1.1       raeburn   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
1.9       raeburn   288: # (b) from tail of requested URL (after /adm/lti/) if it has format of a symb  
1.1       raeburn   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
1.5       raeburn   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).
1.1       raeburn   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)) {
1.20      raeburn   321:                 &invalid_request($r,12);
1.1       raeburn   322:                 return OK;
                    323:             }
                    324:             if ($rest eq '') {
                    325:                 $mapurl = $tail;
                    326:             } else {
                    327:                 $symb = $tail;
1.16      raeburn   328:                 $symb =~ s{^/}{};
1.1       raeburn   329:             }
1.9       raeburn   330:         } elsif ($tail =~ m{^/res/(?:$match_domain)/(?:$match_username)/.+\.(?:sequence|page)(|___\d+___.+)$}) {
                    331:             if ($1 eq '') {
                    332:                 $mapurl = $tail;
                    333:             } else {
                    334:                 $symb = $tail;
1.16      raeburn   335:                 $symb =~ s{^/res/}{};
1.9       raeburn   336:             }
1.1       raeburn   337:         } elsif ($tail =~ m{^/($match_domain)/($match_courseid)$}) {
                    338:             ($urlcdom,$urlcnum) = ($1,$2);
                    339:             if (($cdom ne '') && ($cdom ne $urlcdom)) {
1.20      raeburn   340:                 &invalid_request($r,13);
1.1       raeburn   341:                 return OK;
                    342:             }
1.5       raeburn   343:         } elsif ($tail =~ m{^/tiny/($match_domain)/(\w+)$}) {
1.20      raeburn   344:             ($urlcdom,$urlcnum) = &course_from_tinyurl($tail);
                    345:             if (($urlcdom eq '') || ($urlcnum eq '')) {
                    346:                 &invalid_request($r,14);
1.5       raeburn   347:                 return OK;
                    348:             }
1.1       raeburn   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: #
1.20      raeburn   371: # Retrieve information for LTI Consumers in course's domain
1.1       raeburn   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) {
1.20      raeburn   378:         &invalid_request($r,15);
1.1       raeburn   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 
1.20      raeburn   394: # keys in the course configuration or the domain configuration
                    395: # for LTI.
1.1       raeburn   396: #
                    397: 
1.20      raeburn   398:     my $itemid = &get_lti_itemid($requri,$hostname,$params,\%lti,\%lti_by_key);
1.1       raeburn   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')) {
1.20      raeburn   406:         &invalid_request($r,16);
1.1       raeburn   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: #
1.2       raeburn   414:     unless (&LONCAPA::ltiutils::check_nonce($params->{'oauth_nonce'},$params->{'oauth_timestamp'},
                    415:                                             $lti{$itemid}{'lifetime'},$cdom,$r->dir_config('lonLTIDir'))) {
1.20      raeburn   416:         &invalid_request($r,17);
1.1       raeburn   417:         return OK;
                    418:     }
                    419: 
                    420: #
1.17      raeburn   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+)$}) {
1.20      raeburn   427:             my $ltitype = 'd';
1.17      raeburn   428:             foreach my $key (%{$params}) {
                    429:                 delete($env{'form.'.$key});
                    430:             }
1.20      raeburn   431:             my $ltoken = &Apache::lonnet::tmpput({'linkprot' => $itemid.$ltitype.':'.$tail},
1.17      raeburn   432:                                                    $lonhost);
                    433:             if ($ltoken) {
                    434:                 $r->internal_redirect($tail.'?ltoken='.$ltoken);
                    435:                 $r->set_handlers('PerlHandler'=> undef);
                    436:             } else {
1.20      raeburn   437:                 &invalid_request($r,18);
1.17      raeburn   438:             }
                    439:         } else {
1.20      raeburn   440:             &invalid_request($r,19);
1.17      raeburn   441:         }
                    442:         return OK;
                    443:     }
                    444: 
                    445: #
1.6       raeburn   446: # Determine if source of username matches requirement from the 
1.1       raeburn   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).
1.9       raeburn   474: # (b) from tail of requested URL (after /adm/lti/) if it has format of a symb
1.1       raeburn   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
1.5       raeburn   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).
1.1       raeburn   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})) {
1.28    ! raeburn   498:             if ($consumers{$sourcecrs} =~ /^\Q$itemid:\E($match_courseid)$/) {
        !           499:                 $storedcnum = $1;
        !           500:                 my $crshome = &Apache::lonnet::homeserver($storedcnum,$cdom);
1.1       raeburn   501:                 if ($crshome =~ /(con_lost|no_host|no_such_host)/) {
1.20      raeburn   502:                     &invalid_request($r,20);
1.1       raeburn   503:                     return OK;
                    504:                 } else {
1.28    ! raeburn   505:                     $posscnum = $storedcnum;
1.1       raeburn   506:                 }
                    507:             }
                    508:         }
                    509:     }
                    510: 
                    511:     if ($urlcnum ne '') {
                    512:         if ($posscnum ne '') {
                    513:             if ($posscnum ne $urlcnum) {
1.20      raeburn   514:                 &invalid_request($r,21);
1.1       raeburn   515:                 return OK;
                    516:             } else {
                    517:                 $cnum = $posscnum;
                    518:             }
                    519:         } else {
                    520:             my $crshome = &Apache::lonnet::homeserver($urlcnum,$cdom);
                    521:             if ($crshome =~ /(con_lost|no_host|no_such_host)/) {
1.20      raeburn   522:                 &invalid_request($r,22);
1.1       raeburn   523:                 return OK;
                    524:             } else {
                    525:                 $cnum = $urlcnum;
                    526:             }
                    527:         }
                    528:     } elsif ($posscnum ne '') {
                    529:         $cnum = $posscnum;
                    530:     }
                    531: 
                    532: #
1.6       raeburn   533: # Get LON-CAPA role(s) to use from role-mapping of Consumer roles
1.1       raeburn   534: # defined in domain configuration for the appropriate LTI
                    535: # Consumer.
                    536: #
1.6       raeburn   537: # If multiple LON-CAPA roles are indicated for the current user,
                    538: # ordering (from first to last) is: cc/co, in, ta, ep, st.
1.1       raeburn   539: #
                    540: 
1.6       raeburn   541:     my (@ltiroles,@lcroles);
                    542:     my @lcroleorder = ('cc','in','ta','ep','st');
1.15      raeburn   543:     my ($lcrolesref,$ltirolesref) = 
                    544:         &LONCAPA::ltiutils::get_lc_roles($params->{'roles'},
                    545:                                          \@lcroleorder,
                    546:                                          $lti{$itemid}{maproles});
1.13      raeburn   547:     if (ref($lcrolesref) eq 'ARRAY') {
                    548:         @lcroles = @{$lcrolesref};
1.1       raeburn   549:     }
1.13      raeburn   550:     if (ref($ltirolesref) eq 'ARRAY') {
                    551:         @ltiroles = @{$ltirolesref};
1.1       raeburn   552:     }
                    553: 
                    554: #
                    555: # If no LON-CAPA username  -- is user allowed to create one?
                    556: #
                    557: 
                    558:     my $selfcreate;
                    559:     if (($uname ne '') && ($udom ne '')) {
                    560:         $uhome = &Apache::lonnet::homeserver($uname,$udom);
                    561:         if ($uhome =~ /(con_lost|no_host|no_such_host)/) {
                    562:             &Apache::lonnet::logthis(" LTI authorized unknown user $uname:$udom ");
                    563:             if (ref($lti{$itemid}{'makeuser'}) eq 'ARRAY') {
                    564:                 if (@{$lti{$itemid}{'makeuser'}} > 0) {
                    565:                     foreach my $ltirole (@ltiroles) {
                    566:                         if (grep(/^\Q$ltirole\E$/,@{$lti{$itemid}{'makeuser'}})) {
                    567:                             $selfcreate = 1;
1.6       raeburn   568:                             last;
1.1       raeburn   569:                         }
                    570:                     }
                    571:                 }
                    572:             }
                    573:             if ($selfcreate) {
1.13      raeburn   574:                 my (%rulematch,%inst_results,%curr_rules,%got_rules,%alerts);
                    575:                 my $domdesc = &Apache::lonnet::domain($udom,'description');
                    576:                 my %data = (
                    577:                     'permanentemail' => $env{'form.lis_person_contact_email_primary'},
                    578:                     'firstname'      => $env{'form.lis_person_name_given'},
                    579:                     'lastname'       => $env{'form.lis_person_name_family'},
                    580:                     'fullname'       => $env{'form.lis_person_name_full'},
                    581:                 );
                    582:                 my $result =
                    583:                     &LONCAPA::ltiutils::create_user($lti{$itemid},$uname,$udom,
                    584:                                                     $domdesc,\%data,\%alerts,\%rulematch,
                    585:                                                     \%inst_results,\%curr_rules,%got_rules);
                    586:                 if ($result eq 'notallowed') {
1.20      raeburn   587:                     &invalid_request($r,23);
1.13      raeburn   588:                 } elsif ($result eq 'ok') {
1.6       raeburn   589:                     if (($ltiroles[0] eq 'Instructor') && ($lcroles[0] eq 'cc') && ($lti{$itemid}{'mapcrs'}) &&
                    590:                         ($lti{$itemid}{'makecrs'})) {
                    591:                         unless (&Apache::lonnet::usertools_access($uname,$udom,'lti','reload','requestcourses')) {
1.10      raeburn   592:                             &Apache::lonnet::put('environment',{ 'requestcourses.lti' => 'autolimit=', },$udom,$uname);
1.6       raeburn   593:                         }
                    594:                     }
                    595:                 } else {
1.20      raeburn   596:                     &invalid_request($r,24);
1.6       raeburn   597:                     return OK;
                    598:                 }
1.1       raeburn   599:             } else {
1.20      raeburn   600:                 &invalid_request($r,25);
1.1       raeburn   601:                 return OK;
1.6       raeburn   602:             }
                    603:         }
1.1       raeburn   604:     } else {
1.20      raeburn   605:         &invalid_request($r,26);
1.1       raeburn   606:         return OK;
                    607:     }
                    608: 
                    609: #
                    610: # If no LON-CAPA course available, check if domain's configuration
                    611: # for the specific LTI Consumer allows a new course to be created 
1.6       raeburn   612: # (requires role in Consumer to be: Instructor and Instructor to map to CC)
1.1       raeburn   613: #
                    614: 
1.6       raeburn   615:     my $reqcrs;
1.1       raeburn   616:     if ($cnum eq '') {
1.26      raeburn   617:         if ($lti{$itemid}{'crsinc'}) {
                    618:             if ((@ltiroles) && ($lti{$itemid}{'mapcrs'}) &&
                    619:                 ($ltiroles[0] eq 'Instructor') && ($lcroles[0] eq 'cc') && ($lti{$itemid}{'makecrs'})) {
                    620:                 my (%can_request,%request_domains);
                    621:                 &Apache::lonnet::check_can_request($cdom,\%can_request,\%request_domains,$uname,$udom);
                    622:                 if ($can_request{'lti'}) {
                    623:                     $reqcrs = 1;
                    624:                     &lti_session($r,$itemid,$uname,$udom,$uhome,$lonhost,undef,$mapurl,$tail,
                    625:                                  $symb,$cdom,$cnum,$params,\@ltiroles,$lti{$itemid},\@lcroles,
                    626:                                  $reqcrs,$sourcecrs);
                    627:                 } else {
                    628:                     &invalid_request($r,27);
                    629:                 }
1.6       raeburn   630:             } else {
1.26      raeburn   631:                 &invalid_request($r,28);
1.6       raeburn   632:             }
1.1       raeburn   633:         } else {
1.26      raeburn   634:             &lti_session($r,$itemid,$uname,$udom,$uhome,$lonhost,undef,$mapurl,$tail,
                    635:                          $symb,$cdom,$cnum,$params,\@ltiroles,$lti{$itemid},\@lcroles,
                    636:                          $reqcrs,$sourcecrs);
1.1       raeburn   637:         }
1.6       raeburn   638:         return OK;
1.1       raeburn   639:     }
                    640: 
                    641: #
                    642: # If LON-CAPA course is a Community, and LON-CAPA role
                    643: # indicated is cc, change role indicated to co.
1.27      raeburn   644: #
1.1       raeburn   645: 
1.6       raeburn   646:     my %crsenv;
                    647:     if ($lcroles[0] eq 'cc') {
1.1       raeburn   648:         if (($cdom ne '') && ($cnum ne '')) {
1.6       raeburn   649:             %crsenv = &Apache::lonnet::coursedescription($cdom.'_'.$cnum,{ 'one_time' => 1,});
1.1       raeburn   650:             if ($crsenv{'type'} eq 'Community') {
1.6       raeburn   651:                 $lcroles[0] = 'co';
                    652:             }
                    653:         }
                    654:     }
                    655: 
                    656: #
                    657: # Determine if user has a LON-CAPA role in the mapped LON-CAPA course.
                    658: # If multiple LON-CAPA roles are available for the user's assigned LTI roles,
                    659: # choose the first available LON-CAPA role in the order: cc/co, in, ta, ep, st
                    660: #
                    661: 
                    662:     my ($role,$usec,$withsec);
                    663:     unless ((($lcroles[0] eq 'cc') || ($lcroles[0] eq 'co')) && (@lcroles == 1)) {
                    664:         if ($lti{$itemid}{'section'} ne '') {
                    665:             if ($lti{$itemid}{'section'} eq 'course_section_sourcedid') {
                    666:                 if ($env{'form.course_section_sourcedid'} !~ /\W/) {
                    667:                     $usec = $env{'form.course_section_sourcedid'};
                    668:                 }
                    669:             } elsif ($env{'form.'.$lti{$itemid}{'section'}} !~ /\W/) {
                    670:                 $usec = $env{'form.'.$lti{$itemid}{'section'}};
                    671:             }
                    672:         }
                    673:         if ($usec ne '') {
                    674:             $withsec = 1;
                    675:         }
                    676:     }
                    677: 
                    678:     if (@lcroles) {
                    679:         my %crsroles = &Apache::lonnet::get_my_roles($uname,$udom,'userroles',undef,\@lcroles,
                    680:                                                      [$cdom],$withsec);
                    681:         foreach my $reqrole (@lcroles) {
                    682:             if ($withsec) {
                    683:                 my $incsec;
                    684:                 if (($reqrole eq 'cc') || ($reqrole eq 'co')) {
                    685:                     $incsec = '';
                    686:                 } else {
                    687:                     $incsec = $usec;
                    688:                 }
                    689:                 if (exists($crsroles{$cnum.':'.$cdom.':'.$reqrole.':'.$incsec})) {
                    690:                     $role = $reqrole.'./'.$cdom.'/'.$cnum;
                    691:                     if ($incsec ne '') {
                    692:                         $role .= '/'.$usec;
                    693:                     }
                    694:                     last;
                    695:                 }
                    696:             } else {
                    697:                 if (exists($crsroles{$cnum.':'.$cdom.':'.$reqrole})) {
                    698:                     $role = $reqrole.'./'.$cdom.'/'.$cnum;
                    699:                     last;
                    700:                 }
1.1       raeburn   701:             }
                    702:         }
                    703:     }
                    704: 
                    705: #
1.6       raeburn   706: # Determine if user can selfenroll
1.1       raeburn   707: #
                    708: 
1.6       raeburn   709:     my ($reqrole,$selfenrollrole);
                    710:     if ($role eq '') {
                    711:         if ((@ltiroles) && (ref($lti{$itemid}{'selfenroll'}) eq 'ARRAY')) {
                    712:             foreach my $ltirole (@ltiroles) {
                    713:                 if (grep(/^\Q$ltirole\E$/,@{$lti{$itemid}{'selfenroll'}})) {
                    714:                     if (ref($lti{$itemid}{maproles}) eq 'HASH') {
                    715:                         $reqrole = $lti{$itemid}{maproles}{$ltirole};
                    716:                         last;
                    717:                     }
                    718:                 }
                    719:             }
                    720:         }
                    721:         if ($reqrole eq '') {
1.20      raeburn   722:             &invalid_request($r,29);
1.1       raeburn   723:             return OK;
                    724:         } else {
1.6       raeburn   725:             unless (%crsenv) {
                    726:                 %crsenv = &Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                    727:             }
                    728:             my $default_enrollment_start_date = $crsenv{'default_enrollment_start_date'};
                    729:             my $default_enrollment_end_date   = $crsenv{'default_enrollment_end_date'};
                    730:             my $now = time;
                    731:             if ($default_enrollment_end_date && $default_enrollment_end_date <= $now) {
1.20      raeburn   732:                 &invalid_request($r,30);
1.6       raeburn   733:                 return OK;
                    734:             } elsif ($default_enrollment_start_date && $default_enrollment_start_date >$now) {
1.20      raeburn   735:                 &invalid_request($r,31);
1.6       raeburn   736:                 return OK;
                    737:             } else {
                    738:                 $selfenrollrole = $reqrole.'./'.$cdom.'/'.$cnum;
                    739:                 if (($withsec) && ($reqrole ne 'cc') && ($reqrole ne 'co')) {
                    740:                     if ($usec ne '') {
                    741:                         $selfenrollrole .= '/'.$usec;
                    742:                     }
                    743:                 }
                    744:             }
1.1       raeburn   745:         }
                    746:     }
                    747: 
                    748: #
1.27      raeburn   749: # Retrieve course type of LON-CAPA course to check if mapping from a Consumer
                    750: # course identifier permitted for this type of course (one of: official,
                    751: # unofficial, community, textbook, placement or lti.
                    752: #
                    753: 
                    754:     unless (%crsenv) {
                    755:         %crsenv = &Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                    756:     }
                    757:     my $crstype = lc($crsenv{'type'});
                    758:     if ($crstype eq '') {
                    759:         $crstype = 'course';
                    760:     }
                    761:     if ($crstype eq 'course') {
                    762:         if ($crsenv{'internal.coursecode'}) {
                    763:             $crstype = 'official';
                    764:         } elsif ($crsenv{'internal.textbook'}) {
                    765:             $crstype = 'textbook';
                    766:         } elsif ($crsenv{'internal.lti'}) {
                    767:             $crstype = 'lti';
                    768:         } else {
                    769:             $crstype = 'unofficial';
                    770:         }
                    771:     }
                    772: 
                    773: #
                    774: # Store consumer-to-LON-CAPA course mapping if permitted
1.1       raeburn   775: #
1.6       raeburn   776: 
1.27      raeburn   777:     if (($lti{$itemid}{'storecrs'}) && ($sourcecrs ne '') && 
                    778:         ($consumers{$sourcecrs} eq '') && ($cnum ne '')) {
                    779:         if (ref($lti{$itemid}{'mapcrstype'}) eq 'ARRAY') {
                    780:             if (grep(/^$crstype$/,@{$lti{$itemid}{'mapcrstype'}})) {
1.28    ! raeburn   781:                 &Apache::lonnet::put_dom('lticonsumers',{ $sourcecrs => $itemid.':'.$cnum },$cdom);
1.27      raeburn   782:             }
                    783:         }
1.1       raeburn   784:     }
                    785: 
                    786: #
1.6       raeburn   787: # Start user session
                    788: #
                    789: 
                    790:     &lti_session($r,$itemid,$uname,$udom,$uhome,$lonhost,$role,$mapurl,$tail,$symb,
                    791:                  $cdom,$cnum,$params,\@ltiroles,$lti{$itemid},\@lcroles,undef,$sourcecrs,
                    792:                  $selfenrollrole);
                    793:     return OK;
                    794: }
                    795: 
1.20      raeburn   796: sub get_lti_itemid {
                    797:     my ($requri,$hostname,$params,$lti,$lti_by_key) = @_;
                    798:     return unless ((ref($params) eq 'HASH') && (ref($lti) eq 'HASH')  && (ref($lti_by_key) eq 'HASH'));
                    799: 
                    800:     if (exists($params->{'oauth_callback'})) {
                    801:         $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0A;
                    802:     } else {
                    803:         $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0;
                    804:     }
                    805: 
                    806:     my $protocol = 'http';
                    807:     if ($ENV{'SERVER_PORT'} == 443) {
                    808:         $protocol = 'https';
                    809:     }
                    810: 
                    811:     my ($itemid,$consumer_key,$secret);
                    812:     my $consumer_key = $params->{'oauth_consumer_key'};
                    813:     if (ref($lti_by_key->{$consumer_key}) eq 'ARRAY') {
                    814:         foreach my $id (@{$lti_by_key->{$consumer_key}}) {
                    815:             if (ref($lti->{$id}) eq 'HASH') {
                    816:                 $secret = $lti->{$id}{'secret'};
                    817:                 my $request = Net::OAuth->request('request token')->from_hash($params,
                    818:                                                    request_url => $protocol.'://'.$hostname.$requri,
                    819:                                                    request_method => $env{'request.method'},
                    820:                                                    consumer_secret => $secret,);
                    821:                 if ($request->verify()) {
                    822:                     $itemid = $id;
                    823:                     last;
                    824:                 }
                    825:             }
                    826:         }
                    827:     }
                    828:     return $itemid;
                    829: }
                    830: 
1.6       raeburn   831: sub lti_enroll {
                    832:     my ($uname,$udom,$selfenrollrole) = @_;
                    833:     my $enrollresult;
                    834:     my ($role,$cdom,$cnum,$sec) =
                    835:            ($selfenrollrole =~ m{^(\w+)\./($match_domain)/($match_courseid)(?:|/(\w*))$});
                    836:     if (($cnum ne '') && ($cdom ne '')) {
                    837:         my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
                    838:         if ($chome ne 'no_host') {
                    839:             my %coursehash = &Apache::lonnet::coursedescription($cdom.'_'.$cnum);
                    840:             my $start = $coursehash{'default_enrollment_start_date'};
                    841:             my $end = $coursehash{'default_enrollment_end_date'};
1.14      raeburn   842:             $enrollresult = &LONCAPA::ltiutils::enrolluser($udom,$uname,$role,$cdom,$cnum,$sec,
                    843:                                                            $start,$end,1);
1.6       raeburn   844:         }
                    845:     }
                    846:     return $enrollresult;
                    847: }
                    848: 
                    849: sub lti_reqcrs {
                    850:     my ($r,$cdom,$form,$uname,$udom) = @_;
                    851:     my (%can_request,%request_domains);
                    852:     &Apache::lonnet::check_can_request($cdom,\%can_request,\%request_domains,$uname,$udom);
                    853:     if ($can_request{'lti'}) {
                    854:         my %domconfig = &Apache::lonnet::get_dom('configuration',['requestcourses'],$cdom);
                    855:         my %domdefs = &Apache::lonnet::get_domain_defaults($cdom);
                    856:         &Apache::lonrequestcourse::print_textbook_form($r,$cdom,[$cdom],\%domdefs,
                    857:                                                        $domconfig{'requestcourses'},
                    858:                                                        \%can_request,'lti',$form);
                    859:     } else {
                    860:         $r->print(
                    861:               &Apache::loncommon::start_page('Invalid LTI call',undef,{'only_body' => 1}).
                    862:               &mt('Invalid LTI call').
                    863:               &Apache::loncommon::end_page()
                    864:         );
                    865:     }
                    866: }
                    867: 
                    868: sub lti_session {
                    869:     my ($r,$itemid,$uname,$udom,$uhome,$lonhost,$role,$mapurl,$tail,$symb,$cdom,$cnum,
                    870:         $params,$ltiroles,$ltihash,$lcroles,$reqcrs,$sourcecrs,$selfenrollrole) = @_;
                    871:     return unless ((ref($params) eq 'HASH') && (ref($ltiroles) eq 'ARRAY') &&
                    872:                    (ref($ltihash) eq 'HASH') && (ref($lcroles) eq 'ARRAY'));
                    873: #
1.1       raeburn   874: # Check if user should be hosted here or switched to another server.
                    875: #
                    876:     $r->user($uname);
1.6       raeburn   877:     if ($cnum) {
                    878:         if ($role) {
                    879:             &Apache::lonnet::logthis(" LTI authorized user ($itemid): $uname:$udom, role: $role, course: $cdom\_$cnum");
                    880:         } elsif ($selfenrollrole =~ m{^(\w+)\./$cdom/$cnum}) {
                    881:             &Apache::lonnet::logthis(" LTI authorized user ($itemid): $uname:$udom, desired role: $1 course: $cdom\_$cnum");
                    882:         }
                    883:     } else {
                    884:         &Apache::lonnet::logthis(" LTI authorized user ($itemid): $uname:$udom, course dom: $cdom");
                    885:     }
1.1       raeburn   886:     my ($is_balancer,$otherserver,$hosthere);
                    887:     ($is_balancer,$otherserver) =
                    888:         &Apache::lonnet::check_loadbalancing($uname,$udom,'login');
                    889:     if ($is_balancer) {
                    890:         if ($otherserver eq '') {
                    891:             my $lowest_load;
                    892:             ($otherserver,undef,undef,undef,$lowest_load) = &Apache::lonnet::choose_server($udom);
                    893:             if ($lowest_load > 100) {
1.23      raeburn   894:                 $otherserver = &Apache::lonnet::spareserver($r,$lowest_load,$lowest_load,1,$udom);
1.1       raeburn   895:             }
                    896:         }
                    897:         if ($otherserver ne '') {
                    898:             my @hosts = &Apache::lonnet::current_machine_ids();
                    899:             if (grep(/^\Q$otherserver\E$/,@hosts)) {
                    900:                 $hosthere = $otherserver;
                    901:             }
                    902:         }
                    903:     }
1.19      raeburn   904:     my $protocol = 'http';
                    905:     if ($ENV{'SERVER_PORT'} == 443) {
                    906:         $protocol = 'https';
                    907:     }
1.1       raeburn   908:     if (($is_balancer) && (!$hosthere)) {
                    909:         # login but immediately go to switch server.
                    910:         &Apache::lonauth::success($r,$uname,$udom,$uhome,'noredirect');
1.19      raeburn   911:         if (($ltihash->{'callback'}) && ($params->{$ltihash->{'callback'}})) {
                    912:             &LONCAPA::ltiutils::setup_logout_callback($uname,$udom,$otherserver,
                    913:                                                       $ltihash->{'key'},
                    914:                                                       $ltihash->{'secret'},
                    915:                                                       $params->{$ltihash->{'callback'}},
                    916:                                                       $r->dir_config('ltiIDsDir'),
                    917:                                                       $protocol,$r->hostname);
                    918:         }
1.1       raeburn   919:         if ($symb) {
                    920:             $env{'form.symb'} = $symb;
1.16      raeburn   921:             $env{'request.lti.uri'} = $tail;
1.6       raeburn   922:         } else {
                    923:             if ($mapurl) {
                    924:                 $env{'form.origurl'} = $mapurl;
1.8       raeburn   925:                 $env{'request.lti.uri'} = $mapurl;
1.6       raeburn   926:             } elsif ($tail =~ m{^\Q/tiny/$cdom/\E\w+$}) {
                    927:                 $env{'form.origurl'} = $tail;
1.8       raeburn   928:                 $env{'request.lti.uri'} = $tail;
1.9       raeburn   929:             } elsif ($tail eq "/$cdom/$cnum") {
                    930:                 $env{'form.origurl'} = '/adm/navmaps';
                    931:                 $env{'request.lti.uri'} = $tail;
1.6       raeburn   932:             } else {
                    933:                 unless ($tail eq '/adm/roles') {
1.26      raeburn   934:                     if ($cnum) {
                    935:                         $env{'form.origurl'} = '/adm/navmaps';
                    936:                     }
1.6       raeburn   937:                 }
                    938:             }
1.1       raeburn   939:         }
                    940:         if ($role) {
                    941:             $env{'form.role'} = $role;
                    942:         }
1.6       raeburn   943:         if (($lcroles->[0] eq 'cc') && ($reqcrs)) {
                    944:             $env{'request.lti.reqcrs'} = 1;
                    945:             $env{'request.lti.reqrole'} = 'cc';
                    946:             $env{'request.lti.sourcecrs'} = $sourcecrs;
                    947:         }
                    948:         if ($selfenrollrole) {
1.18      raeburn   949:             $env{'request.lti.selfenrollrole'} = $selfenrollrole;
1.6       raeburn   950:             $env{'request.lti.sourcecrs'} = $sourcecrs;
                    951:         }
                    952:         if ($ltihash->{'passback'}) {
1.1       raeburn   953:             if ($params->{'lis_result_sourcedid'}) {
                    954:                 $env{'request.lti.passbackid'} = $params->{'lis_result_sourcedid'};
                    955:             }
                    956:             if ($params->{'lis_outcome_service_url'}) {
                    957:                 $env{'request.lti.passbackurl'} = $params->{'lis_outcome_service_url'};
                    958:             }
                    959:         }
1.6       raeburn   960:         if (($ltihash->{'roster'}) && (grep(/^Instructor$/,@{$ltiroles}))) {
1.1       raeburn   961:             if ($params->{'ext_ims_lis_memberships_id'}) {
1.6       raeburn   962:                 $env{'request.lti.rosterid'} = $params->{'ext_ims_lis_memberships_id'};
1.1       raeburn   963:             }
                    964:             if ($params->{'ext_ims_lis_memberships_url'}) {
                    965:                 $env{'request.lti.rosterurl'} = $params->{'ext_ims_lis_memberships_url'};
                    966:             }
                    967:         }
1.10      raeburn   968:         $env{'request.lti.login'} = $itemid;
1.8       raeburn   969:         if ($params->{'launch_presentation_document_target'}) {
                    970:             $env{'request.lti.target'} = $params->{'launch_presentation_document_target'};
                    971:         }
1.25      raeburn   972:         foreach my $key (keys(%{$params})) {
1.1       raeburn   973:             delete($env{'form.'.$key});
                    974:         }
                    975:         my $redirecturl = '/adm/switchserver';
                    976:         if ($otherserver ne '') {
                    977:             $redirecturl .= '?otherserver='.$otherserver;
                    978:         }
                    979:         $r->internal_redirect($redirecturl);
                    980:         $r->set_handlers('PerlHandler'=> undef);
                    981:     } else {
                    982:         # need to login them in, so generate the need data that
                    983:         # migrate expects to do login
1.25      raeburn   984:         foreach my $key (keys(%{$params})) {
1.1       raeburn   985:             delete($env{'form.'.$key});
                    986:         }
1.19      raeburn   987:         if (($ltihash->{'callback'}) && ($params->{$ltihash->{'callback'}})) {
                    988:             &LONCAPA::ltiutils::setup_logout_callback($uname,$udom,$lonhost,
                    989:                                                       $ltihash->{'key'},
                    990:                                                       $ltihash->{'secret'},
                    991:                                                       $params->{$ltihash->{'callback'}},
                    992:                                                       $r->dir_config('ltiIDsDir'),
                    993:                                                       $protocol,$r->hostname);
                    994:         }
1.1       raeburn   995:         my $ip = $r->get_remote_host();
                    996:         my %info=('ip'        => $ip,
                    997:                   'domain'    => $udom,
                    998:                   'username'  => $uname,
                    999:                   'server'    => $lonhost,
1.10      raeburn  1000:                   'lti.login' => $itemid,
1.8       raeburn  1001:                   'lti.uri'   => $tail,
1.1       raeburn  1002:                  );
                   1003:         if ($role) {
                   1004:             $info{'role'} = $role;
                   1005:         }
                   1006:         if ($symb) {
1.6       raeburn  1007:             $info{'symb'} = $symb;
                   1008:         }
                   1009:         if (($lcroles->[0] eq 'cc') && ($reqcrs)) {
                   1010:             $info{'lti.reqcrs'} = 1;
                   1011:             $info{'lti.reqrole'} = 'cc';
                   1012:             $info{'lti.sourcecrs'} = $sourcecrs;
                   1013:         }
                   1014:         if ($selfenrollrole) {
                   1015:             $info{'lti.selfenrollrole'} = $selfenrollrole;
1.1       raeburn  1016:         }
1.6       raeburn  1017:         if ($ltihash->{'passback'}) {
1.1       raeburn  1018:             if ($params->{'lis_result_sourcedid'}) {
                   1019:                 $info{'lti.passbackid'} = $params->{'lis_result_sourcedid'}
                   1020:             }
                   1021:             if ($params->{'lis_outcome_service_url'}) {
                   1022:                 $info{'lti.passbackurl'} = $params->{'lis_outcome_service_url'}
                   1023:             }
                   1024:         }
1.6       raeburn  1025:         if (($ltihash->{'roster'}) && (grep(/^Instructor$/,@{$ltiroles}))) {
1.1       raeburn  1026:             if ($params->{'ext_ims_lis_memberships_id'}) {
                   1027:                 $info{'lti.rosterid'} = $params->{'ext_ims_lis_memberships_id'};
                   1028:             }
                   1029:             if ($params->{'ext_ims_lis_memberships_url'}) {
                   1030:                 $info{'lti.rosterurl'} = $params->{'ext_ims_lis_memberships_url'};
                   1031:             }
                   1032:         }
1.8       raeburn  1033:         if ($params->{'launch_presentation_document_target'}) {
                   1034:             $info{'lti.target'} = $params->{'launch_presentation_document_target'};
                   1035:         }
                   1036: 
1.1       raeburn  1037:         unless ($info{'symb'}) {
                   1038:             if ($mapurl) {
                   1039:                 $info{'origurl'} = $mapurl;
1.6       raeburn  1040:             } elsif ($tail =~ m{^\Q/tiny/$cdom/\E\w+$}) {
                   1041:                 $info{'origurl'} = $tail;
1.1       raeburn  1042:             } else {
                   1043:                 unless ($tail eq '/adm/roles') {
1.26      raeburn  1044:                     if ($cnum) {
                   1045:                         $info{'origurl'} = '/adm/navmaps';
                   1046:                     }
1.1       raeburn  1047:                 }
                   1048:             }
                   1049:         }
                   1050:         if (($is_balancer) && ($hosthere)) {
                   1051:             $info{'noloadbalance'} = $hosthere;
                   1052:         }
                   1053:         my $token = &Apache::lonnet::tmpput(\%info,$lonhost);
                   1054:         $env{'form.token'} = $token;
                   1055:         $r->internal_redirect('/adm/migrateuser');
                   1056:         $r->set_handlers('PerlHandler'=> undef);
                   1057:     }
1.6       raeburn  1058:     return;
1.1       raeburn  1059: }
                   1060: 
                   1061: sub invalid_request {
                   1062:     my ($r,$num) = @_;
                   1063:     &Apache::loncommon::content_type($r,'text/html');
                   1064:     $r->send_http_header;
                   1065:     if ($r->header_only) {
                   1066:         return;
                   1067:     }
                   1068:     &Apache::lonlocal::get_language_handle($r);
                   1069:     $r->print(
1.10      raeburn  1070:         &Apache::loncommon::start_page('Invalid LTI call','',{ 'only_body' => 1,}).
1.1       raeburn  1071:         &mt('Invalid LTI call [_1]',$num).
                   1072:         &Apache::loncommon::end_page());
                   1073:     return;
                   1074: }
                   1075: 
1.20      raeburn  1076: sub course_from_tinyurl {
                   1077:     my ($tail) = @_;
                   1078:     my ($urlcdom,$urlcnum);
                   1079:     if ($tail =~ m{^/tiny/($match_domain)/(\w+)$}) {
1.21      raeburn  1080:         ($urlcdom,my $key) = ($1,$2);
1.20      raeburn  1081:         my $tinyurl;
                   1082:         my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$urlcdom."\0".$key);
                   1083:         if (defined($cached)) {
                   1084:             $tinyurl = $result;
                   1085:         } else {
                   1086:             my $configuname = &Apache::lonnet::get_domainconfiguser($urlcdom);
                   1087:             my %currtiny = &Apache::lonnet::get('tiny',[$key],$urlcdom,$configuname);
                   1088:             if ($currtiny{$key} ne '') {
                   1089:                 $tinyurl = $currtiny{$key};
                   1090:                 &Apache::lonnet::do_cache_new('tiny',$urlcdom."\0".$key,$currtiny{$key},600);
                   1091:             }
                   1092:         }
                   1093:         if ($tinyurl ne '') {
                   1094:             $urlcnum = (split(/\&/,$tinyurl))[0];
                   1095:         }
                   1096:     }
                   1097:     return ($urlcdom,$urlcnum);
                   1098: }
                   1099: 
1.1       raeburn  1100: 1;

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

Internal Server Error

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

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

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