Annotation of loncom/lti/ltiauth.pm, revision 1.27
1.1 raeburn 1: # The LearningOnline Network
2: # Basic LTI Authentication Module
3: #
1.27 ! raeburn 4: # $Id: ltiauth.pm,v 1.26 2021/11/22 23:41: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 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.26 raeburn 616: if ($lti{$itemid}{'crsinc'}) {
617: if ((@ltiroles) && ($lti{$itemid}{'mapcrs'}) &&
618: ($ltiroles[0] eq 'Instructor') && ($lcroles[0] eq 'cc') && ($lti{$itemid}{'makecrs'})) {
619: my (%can_request,%request_domains);
620: &Apache::lonnet::check_can_request($cdom,\%can_request,\%request_domains,$uname,$udom);
621: if ($can_request{'lti'}) {
622: $reqcrs = 1;
623: <i_session($r,$itemid,$uname,$udom,$uhome,$lonhost,undef,$mapurl,$tail,
624: $symb,$cdom,$cnum,$params,\@ltiroles,$lti{$itemid},\@lcroles,
625: $reqcrs,$sourcecrs);
626: } else {
627: &invalid_request($r,27);
628: }
1.6 raeburn 629: } else {
1.26 raeburn 630: &invalid_request($r,28);
1.6 raeburn 631: }
1.1 raeburn 632: } else {
1.26 raeburn 633: <i_session($r,$itemid,$uname,$udom,$uhome,$lonhost,undef,$mapurl,$tail,
634: $symb,$cdom,$cnum,$params,\@ltiroles,$lti{$itemid},\@lcroles,
635: $reqcrs,$sourcecrs);
1.1 raeburn 636: }
1.6 raeburn 637: return OK;
1.1 raeburn 638: }
639:
640: #
641: # If LON-CAPA course is a Community, and LON-CAPA role
642: # indicated is cc, change role indicated to co.
1.27 ! raeburn 643: #
1.1 raeburn 644:
1.6 raeburn 645: my %crsenv;
646: if ($lcroles[0] eq 'cc') {
1.1 raeburn 647: if (($cdom ne '') && ($cnum ne '')) {
1.6 raeburn 648: %crsenv = &Apache::lonnet::coursedescription($cdom.'_'.$cnum,{ 'one_time' => 1,});
1.1 raeburn 649: if ($crsenv{'type'} eq 'Community') {
1.6 raeburn 650: $lcroles[0] = 'co';
651: }
652: }
653: }
654:
655: #
656: # Determine if user has a LON-CAPA role in the mapped LON-CAPA course.
657: # If multiple LON-CAPA roles are available for the user's assigned LTI roles,
658: # choose the first available LON-CAPA role in the order: cc/co, in, ta, ep, st
659: #
660:
661: my ($role,$usec,$withsec);
662: unless ((($lcroles[0] eq 'cc') || ($lcroles[0] eq 'co')) && (@lcroles == 1)) {
663: if ($lti{$itemid}{'section'} ne '') {
664: if ($lti{$itemid}{'section'} eq 'course_section_sourcedid') {
665: if ($env{'form.course_section_sourcedid'} !~ /\W/) {
666: $usec = $env{'form.course_section_sourcedid'};
667: }
668: } elsif ($env{'form.'.$lti{$itemid}{'section'}} !~ /\W/) {
669: $usec = $env{'form.'.$lti{$itemid}{'section'}};
670: }
671: }
672: if ($usec ne '') {
673: $withsec = 1;
674: }
675: }
676:
677: if (@lcroles) {
678: my %crsroles = &Apache::lonnet::get_my_roles($uname,$udom,'userroles',undef,\@lcroles,
679: [$cdom],$withsec);
680: foreach my $reqrole (@lcroles) {
681: if ($withsec) {
682: my $incsec;
683: if (($reqrole eq 'cc') || ($reqrole eq 'co')) {
684: $incsec = '';
685: } else {
686: $incsec = $usec;
687: }
688: if (exists($crsroles{$cnum.':'.$cdom.':'.$reqrole.':'.$incsec})) {
689: $role = $reqrole.'./'.$cdom.'/'.$cnum;
690: if ($incsec ne '') {
691: $role .= '/'.$usec;
692: }
693: last;
694: }
695: } else {
696: if (exists($crsroles{$cnum.':'.$cdom.':'.$reqrole})) {
697: $role = $reqrole.'./'.$cdom.'/'.$cnum;
698: last;
699: }
1.1 raeburn 700: }
701: }
702: }
703:
704: #
1.6 raeburn 705: # Determine if user can selfenroll
1.1 raeburn 706: #
707:
1.6 raeburn 708: my ($reqrole,$selfenrollrole);
709: if ($role eq '') {
710: if ((@ltiroles) && (ref($lti{$itemid}{'selfenroll'}) eq 'ARRAY')) {
711: foreach my $ltirole (@ltiroles) {
712: if (grep(/^\Q$ltirole\E$/,@{$lti{$itemid}{'selfenroll'}})) {
713: if (ref($lti{$itemid}{maproles}) eq 'HASH') {
714: $reqrole = $lti{$itemid}{maproles}{$ltirole};
715: last;
716: }
717: }
718: }
719: }
720: if ($reqrole eq '') {
1.20 raeburn 721: &invalid_request($r,29);
1.1 raeburn 722: return OK;
723: } else {
1.6 raeburn 724: unless (%crsenv) {
725: %crsenv = &Apache::lonnet::coursedescription($cdom.'_'.$cnum);
726: }
727: my $default_enrollment_start_date = $crsenv{'default_enrollment_start_date'};
728: my $default_enrollment_end_date = $crsenv{'default_enrollment_end_date'};
729: my $now = time;
730: if ($default_enrollment_end_date && $default_enrollment_end_date <= $now) {
1.20 raeburn 731: &invalid_request($r,30);
1.6 raeburn 732: return OK;
733: } elsif ($default_enrollment_start_date && $default_enrollment_start_date >$now) {
1.20 raeburn 734: &invalid_request($r,31);
1.6 raeburn 735: return OK;
736: } else {
737: $selfenrollrole = $reqrole.'./'.$cdom.'/'.$cnum;
738: if (($withsec) && ($reqrole ne 'cc') && ($reqrole ne 'co')) {
739: if ($usec ne '') {
740: $selfenrollrole .= '/'.$usec;
741: }
742: }
743: }
1.1 raeburn 744: }
745: }
746:
747: #
1.27 ! raeburn 748: # Retrieve course type of LON-CAPA course to check if mapping from a Consumer
! 749: # course identifier permitted for this type of course (one of: official,
! 750: # unofficial, community, textbook, placement or lti.
! 751: #
! 752:
! 753: unless (%crsenv) {
! 754: %crsenv = &Apache::lonnet::coursedescription($cdom.'_'.$cnum);
! 755: }
! 756: my $crstype = lc($crsenv{'type'});
! 757: if ($crstype eq '') {
! 758: $crstype = 'course';
! 759: }
! 760: if ($crstype eq 'course') {
! 761: if ($crsenv{'internal.coursecode'}) {
! 762: $crstype = 'official';
! 763: } elsif ($crsenv{'internal.textbook'}) {
! 764: $crstype = 'textbook';
! 765: } elsif ($crsenv{'internal.lti'}) {
! 766: $crstype = 'lti';
! 767: } else {
! 768: $crstype = 'unofficial';
! 769: }
! 770: }
! 771:
! 772: #
! 773: # Store consumer-to-LON-CAPA course mapping if permitted
1.1 raeburn 774: #
1.6 raeburn 775:
1.27 ! raeburn 776: if (($lti{$itemid}{'storecrs'}) && ($sourcecrs ne '') &&
! 777: ($consumers{$sourcecrs} eq '') && ($cnum ne '')) {
! 778: if (ref($lti{$itemid}{'mapcrstype'}) eq 'ARRAY') {
! 779: if (grep(/^$crstype$/,@{$lti{$itemid}{'mapcrstype'}})) {
! 780: &Apache::lonnet::put_dom('lticonsumers',{ $sourcecrs => $cnum },$cdom);
! 781: }
! 782: }
1.1 raeburn 783: }
784:
785: #
1.6 raeburn 786: # Start user session
787: #
788:
789: <i_session($r,$itemid,$uname,$udom,$uhome,$lonhost,$role,$mapurl,$tail,$symb,
790: $cdom,$cnum,$params,\@ltiroles,$lti{$itemid},\@lcroles,undef,$sourcecrs,
791: $selfenrollrole);
792: return OK;
793: }
794:
1.20 raeburn 795: sub get_lti_itemid {
796: my ($requri,$hostname,$params,$lti,$lti_by_key) = @_;
797: return unless ((ref($params) eq 'HASH') && (ref($lti) eq 'HASH') && (ref($lti_by_key) eq 'HASH'));
798:
799: if (exists($params->{'oauth_callback'})) {
800: $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0A;
801: } else {
802: $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0;
803: }
804:
805: my $protocol = 'http';
806: if ($ENV{'SERVER_PORT'} == 443) {
807: $protocol = 'https';
808: }
809:
810: my ($itemid,$consumer_key,$secret);
811: my $consumer_key = $params->{'oauth_consumer_key'};
812: if (ref($lti_by_key->{$consumer_key}) eq 'ARRAY') {
813: foreach my $id (@{$lti_by_key->{$consumer_key}}) {
814: if (ref($lti->{$id}) eq 'HASH') {
815: $secret = $lti->{$id}{'secret'};
816: my $request = Net::OAuth->request('request token')->from_hash($params,
817: request_url => $protocol.'://'.$hostname.$requri,
818: request_method => $env{'request.method'},
819: consumer_secret => $secret,);
820: if ($request->verify()) {
821: $itemid = $id;
822: last;
823: }
824: }
825: }
826: }
827: return $itemid;
828: }
829:
1.6 raeburn 830: sub lti_enroll {
831: my ($uname,$udom,$selfenrollrole) = @_;
832: my $enrollresult;
833: my ($role,$cdom,$cnum,$sec) =
834: ($selfenrollrole =~ m{^(\w+)\./($match_domain)/($match_courseid)(?:|/(\w*))$});
835: if (($cnum ne '') && ($cdom ne '')) {
836: my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
837: if ($chome ne 'no_host') {
838: my %coursehash = &Apache::lonnet::coursedescription($cdom.'_'.$cnum);
839: my $start = $coursehash{'default_enrollment_start_date'};
840: my $end = $coursehash{'default_enrollment_end_date'};
1.14 raeburn 841: $enrollresult = &LONCAPA::ltiutils::enrolluser($udom,$uname,$role,$cdom,$cnum,$sec,
842: $start,$end,1);
1.6 raeburn 843: }
844: }
845: return $enrollresult;
846: }
847:
848: sub lti_reqcrs {
849: my ($r,$cdom,$form,$uname,$udom) = @_;
850: my (%can_request,%request_domains);
851: &Apache::lonnet::check_can_request($cdom,\%can_request,\%request_domains,$uname,$udom);
852: if ($can_request{'lti'}) {
853: my %domconfig = &Apache::lonnet::get_dom('configuration',['requestcourses'],$cdom);
854: my %domdefs = &Apache::lonnet::get_domain_defaults($cdom);
855: &Apache::lonrequestcourse::print_textbook_form($r,$cdom,[$cdom],\%domdefs,
856: $domconfig{'requestcourses'},
857: \%can_request,'lti',$form);
858: } else {
859: $r->print(
860: &Apache::loncommon::start_page('Invalid LTI call',undef,{'only_body' => 1}).
861: &mt('Invalid LTI call').
862: &Apache::loncommon::end_page()
863: );
864: }
865: }
866:
867: sub lti_session {
868: my ($r,$itemid,$uname,$udom,$uhome,$lonhost,$role,$mapurl,$tail,$symb,$cdom,$cnum,
869: $params,$ltiroles,$ltihash,$lcroles,$reqcrs,$sourcecrs,$selfenrollrole) = @_;
870: return unless ((ref($params) eq 'HASH') && (ref($ltiroles) eq 'ARRAY') &&
871: (ref($ltihash) eq 'HASH') && (ref($lcroles) eq 'ARRAY'));
872: #
1.1 raeburn 873: # Check if user should be hosted here or switched to another server.
874: #
875: $r->user($uname);
1.6 raeburn 876: if ($cnum) {
877: if ($role) {
878: &Apache::lonnet::logthis(" LTI authorized user ($itemid): $uname:$udom, role: $role, course: $cdom\_$cnum");
879: } elsif ($selfenrollrole =~ m{^(\w+)\./$cdom/$cnum}) {
880: &Apache::lonnet::logthis(" LTI authorized user ($itemid): $uname:$udom, desired role: $1 course: $cdom\_$cnum");
881: }
882: } else {
883: &Apache::lonnet::logthis(" LTI authorized user ($itemid): $uname:$udom, course dom: $cdom");
884: }
1.1 raeburn 885: my ($is_balancer,$otherserver,$hosthere);
886: ($is_balancer,$otherserver) =
887: &Apache::lonnet::check_loadbalancing($uname,$udom,'login');
888: if ($is_balancer) {
889: if ($otherserver eq '') {
890: my $lowest_load;
891: ($otherserver,undef,undef,undef,$lowest_load) = &Apache::lonnet::choose_server($udom);
892: if ($lowest_load > 100) {
1.23 raeburn 893: $otherserver = &Apache::lonnet::spareserver($r,$lowest_load,$lowest_load,1,$udom);
1.1 raeburn 894: }
895: }
896: if ($otherserver ne '') {
897: my @hosts = &Apache::lonnet::current_machine_ids();
898: if (grep(/^\Q$otherserver\E$/,@hosts)) {
899: $hosthere = $otherserver;
900: }
901: }
902: }
1.19 raeburn 903: my $protocol = 'http';
904: if ($ENV{'SERVER_PORT'} == 443) {
905: $protocol = 'https';
906: }
1.1 raeburn 907: if (($is_balancer) && (!$hosthere)) {
908: # login but immediately go to switch server.
909: &Apache::lonauth::success($r,$uname,$udom,$uhome,'noredirect');
1.19 raeburn 910: if (($ltihash->{'callback'}) && ($params->{$ltihash->{'callback'}})) {
911: &LONCAPA::ltiutils::setup_logout_callback($uname,$udom,$otherserver,
912: $ltihash->{'key'},
913: $ltihash->{'secret'},
914: $params->{$ltihash->{'callback'}},
915: $r->dir_config('ltiIDsDir'),
916: $protocol,$r->hostname);
917: }
1.1 raeburn 918: if ($symb) {
919: $env{'form.symb'} = $symb;
1.16 raeburn 920: $env{'request.lti.uri'} = $tail;
1.6 raeburn 921: } else {
922: if ($mapurl) {
923: $env{'form.origurl'} = $mapurl;
1.8 raeburn 924: $env{'request.lti.uri'} = $mapurl;
1.6 raeburn 925: } elsif ($tail =~ m{^\Q/tiny/$cdom/\E\w+$}) {
926: $env{'form.origurl'} = $tail;
1.8 raeburn 927: $env{'request.lti.uri'} = $tail;
1.9 raeburn 928: } elsif ($tail eq "/$cdom/$cnum") {
929: $env{'form.origurl'} = '/adm/navmaps';
930: $env{'request.lti.uri'} = $tail;
1.6 raeburn 931: } else {
932: unless ($tail eq '/adm/roles') {
1.26 raeburn 933: if ($cnum) {
934: $env{'form.origurl'} = '/adm/navmaps';
935: }
1.6 raeburn 936: }
937: }
1.1 raeburn 938: }
939: if ($role) {
940: $env{'form.role'} = $role;
941: }
1.6 raeburn 942: if (($lcroles->[0] eq 'cc') && ($reqcrs)) {
943: $env{'request.lti.reqcrs'} = 1;
944: $env{'request.lti.reqrole'} = 'cc';
945: $env{'request.lti.sourcecrs'} = $sourcecrs;
946: }
947: if ($selfenrollrole) {
1.18 raeburn 948: $env{'request.lti.selfenrollrole'} = $selfenrollrole;
1.6 raeburn 949: $env{'request.lti.sourcecrs'} = $sourcecrs;
950: }
951: if ($ltihash->{'passback'}) {
1.1 raeburn 952: if ($params->{'lis_result_sourcedid'}) {
953: $env{'request.lti.passbackid'} = $params->{'lis_result_sourcedid'};
954: }
955: if ($params->{'lis_outcome_service_url'}) {
956: $env{'request.lti.passbackurl'} = $params->{'lis_outcome_service_url'};
957: }
958: }
1.6 raeburn 959: if (($ltihash->{'roster'}) && (grep(/^Instructor$/,@{$ltiroles}))) {
1.1 raeburn 960: if ($params->{'ext_ims_lis_memberships_id'}) {
1.6 raeburn 961: $env{'request.lti.rosterid'} = $params->{'ext_ims_lis_memberships_id'};
1.1 raeburn 962: }
963: if ($params->{'ext_ims_lis_memberships_url'}) {
964: $env{'request.lti.rosterurl'} = $params->{'ext_ims_lis_memberships_url'};
965: }
966: }
1.10 raeburn 967: $env{'request.lti.login'} = $itemid;
1.8 raeburn 968: if ($params->{'launch_presentation_document_target'}) {
969: $env{'request.lti.target'} = $params->{'launch_presentation_document_target'};
970: }
1.25 raeburn 971: foreach my $key (keys(%{$params})) {
1.1 raeburn 972: delete($env{'form.'.$key});
973: }
974: my $redirecturl = '/adm/switchserver';
975: if ($otherserver ne '') {
976: $redirecturl .= '?otherserver='.$otherserver;
977: }
978: $r->internal_redirect($redirecturl);
979: $r->set_handlers('PerlHandler'=> undef);
980: } else {
981: # need to login them in, so generate the need data that
982: # migrate expects to do login
1.25 raeburn 983: foreach my $key (keys(%{$params})) {
1.1 raeburn 984: delete($env{'form.'.$key});
985: }
1.19 raeburn 986: if (($ltihash->{'callback'}) && ($params->{$ltihash->{'callback'}})) {
987: &LONCAPA::ltiutils::setup_logout_callback($uname,$udom,$lonhost,
988: $ltihash->{'key'},
989: $ltihash->{'secret'},
990: $params->{$ltihash->{'callback'}},
991: $r->dir_config('ltiIDsDir'),
992: $protocol,$r->hostname);
993: }
1.1 raeburn 994: my $ip = $r->get_remote_host();
995: my %info=('ip' => $ip,
996: 'domain' => $udom,
997: 'username' => $uname,
998: 'server' => $lonhost,
1.10 raeburn 999: 'lti.login' => $itemid,
1.8 raeburn 1000: 'lti.uri' => $tail,
1.1 raeburn 1001: );
1002: if ($role) {
1003: $info{'role'} = $role;
1004: }
1005: if ($symb) {
1.6 raeburn 1006: $info{'symb'} = $symb;
1007: }
1008: if (($lcroles->[0] eq 'cc') && ($reqcrs)) {
1009: $info{'lti.reqcrs'} = 1;
1010: $info{'lti.reqrole'} = 'cc';
1011: $info{'lti.sourcecrs'} = $sourcecrs;
1012: }
1013: if ($selfenrollrole) {
1014: $info{'lti.selfenrollrole'} = $selfenrollrole;
1.1 raeburn 1015: }
1.6 raeburn 1016: if ($ltihash->{'passback'}) {
1.1 raeburn 1017: if ($params->{'lis_result_sourcedid'}) {
1018: $info{'lti.passbackid'} = $params->{'lis_result_sourcedid'}
1019: }
1020: if ($params->{'lis_outcome_service_url'}) {
1021: $info{'lti.passbackurl'} = $params->{'lis_outcome_service_url'}
1022: }
1023: }
1.6 raeburn 1024: if (($ltihash->{'roster'}) && (grep(/^Instructor$/,@{$ltiroles}))) {
1.1 raeburn 1025: if ($params->{'ext_ims_lis_memberships_id'}) {
1026: $info{'lti.rosterid'} = $params->{'ext_ims_lis_memberships_id'};
1027: }
1028: if ($params->{'ext_ims_lis_memberships_url'}) {
1029: $info{'lti.rosterurl'} = $params->{'ext_ims_lis_memberships_url'};
1030: }
1031: }
1.8 raeburn 1032: if ($params->{'launch_presentation_document_target'}) {
1033: $info{'lti.target'} = $params->{'launch_presentation_document_target'};
1034: }
1035:
1.1 raeburn 1036: unless ($info{'symb'}) {
1037: if ($mapurl) {
1038: $info{'origurl'} = $mapurl;
1.6 raeburn 1039: } elsif ($tail =~ m{^\Q/tiny/$cdom/\E\w+$}) {
1040: $info{'origurl'} = $tail;
1.1 raeburn 1041: } else {
1042: unless ($tail eq '/adm/roles') {
1.26 raeburn 1043: if ($cnum) {
1044: $info{'origurl'} = '/adm/navmaps';
1045: }
1.1 raeburn 1046: }
1047: }
1048: }
1049: if (($is_balancer) && ($hosthere)) {
1050: $info{'noloadbalance'} = $hosthere;
1051: }
1052: my $token = &Apache::lonnet::tmpput(\%info,$lonhost);
1053: $env{'form.token'} = $token;
1054: $r->internal_redirect('/adm/migrateuser');
1055: $r->set_handlers('PerlHandler'=> undef);
1056: }
1.6 raeburn 1057: return;
1.1 raeburn 1058: }
1059:
1060: sub invalid_request {
1061: my ($r,$num) = @_;
1062: &Apache::loncommon::content_type($r,'text/html');
1063: $r->send_http_header;
1064: if ($r->header_only) {
1065: return;
1066: }
1067: &Apache::lonlocal::get_language_handle($r);
1068: $r->print(
1.10 raeburn 1069: &Apache::loncommon::start_page('Invalid LTI call','',{ 'only_body' => 1,}).
1.1 raeburn 1070: &mt('Invalid LTI call [_1]',$num).
1071: &Apache::loncommon::end_page());
1072: return;
1073: }
1074:
1.20 raeburn 1075: sub course_from_tinyurl {
1076: my ($tail) = @_;
1077: my ($urlcdom,$urlcnum);
1078: if ($tail =~ m{^/tiny/($match_domain)/(\w+)$}) {
1.21 raeburn 1079: ($urlcdom,my $key) = ($1,$2);
1.20 raeburn 1080: my $tinyurl;
1081: my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$urlcdom."\0".$key);
1082: if (defined($cached)) {
1083: $tinyurl = $result;
1084: } else {
1085: my $configuname = &Apache::lonnet::get_domainconfiguser($urlcdom);
1086: my %currtiny = &Apache::lonnet::get('tiny',[$key],$urlcdom,$configuname);
1087: if ($currtiny{$key} ne '') {
1088: $tinyurl = $currtiny{$key};
1089: &Apache::lonnet::do_cache_new('tiny',$urlcdom."\0".$key,$currtiny{$key},600);
1090: }
1091: }
1092: if ($tinyurl ne '') {
1093: $urlcnum = (split(/\&/,$tinyurl))[0];
1094: }
1095: }
1096: return ($urlcdom,$urlcnum);
1097: }
1098:
1.1 raeburn 1099: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>