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