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