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