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