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