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