Annotation of loncom/lti/ltiutils.pm, revision 1.17.2.1
1.1 raeburn 1: # The LearningOnline Network with CAPA
2: # Utility functions for managing LON-CAPA LTI interactions
3: #
1.17.2.1! raeburn 4: # $Id: ltiutils.pm,v 1.17 2019/07/18 18:28:46 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 LONCAPA::ltiutils;
30:
31: use strict;
32: use Net::OAuth;
33: use Digest::SHA;
34: use Apache::lonnet;
35: use Apache::loncommon;
36: use LONCAPA qw(:DEFAULT :match);
37:
38: #
39: # LON-CAPA as LTI Consumer or LTI Provider
40: #
41: # Determine if a nonce in POSTed data has expired.
42: # If unexpired, confirm it has not already been used.
43: #
44: # When LON-CAPA is operating as a Consumer, nonce checking
45: # occurs when a Tool Provider launched from an instance of
46: # an external tool in a LON-CAPA course makes a request to
47: # (a) /adm/service/roster or (b) /adm/service/passback to,
48: # respectively, retrieve a roster or store the grade for
49: # the original launch by a specific user.
50: #
51: # When LON-CAPA is operating as a Provider, nonce checking
52: # occurs when a user in course context in another LMS (the
1.4 raeburn 53: # Consumer) launches an external tool to access a LON-CAPA URL:
1.1 raeburn 54: # /adm/lti/ with LON-CAPA symb, map, or deep-link ID appended.
55: #
56:
57: sub check_nonce {
58: my ($nonce,$timestamp,$lifetime,$domain,$ltidir) = @_;
59: if (($ltidir eq '') || ($timestamp eq '') || ($timestamp =~ /^\D/) ||
60: ($lifetime eq '') || ($lifetime =~ /\D/) || ($domain eq '')) {
61: return;
62: }
63: my $now = time;
64: if (($timestamp) && ($timestamp < ($now - $lifetime))) {
65: return;
66: }
67: if ($nonce eq '') {
68: return;
69: }
70: if (-e "$ltidir/$domain/$nonce") {
71: return;
72: } else {
73: unless (-e "$ltidir/$domain") {
74: unless (mkdir("$ltidir/$domain",0755)) {
75: return;
76: }
77: }
78: if (open(my $fh,'>',"$ltidir/$domain/$nonce")) {
79: print $fh $now;
80: close($fh);
81: return 1;
82: }
83: }
84: return;
85: }
86:
87: #
88: # LON-CAPA as LTI Consumer
89: #
90: # Verify a signed request using the consumer_key and
91: # secret for the specific LTI Provider.
92: #
93:
94: sub verify_request {
1.15 raeburn 95: my ($oauthtype,$protocol,$hostname,$requri,$reqmethod,$consumer_secret,$params,
96: $authheaders,$errors) = @_;
97: unless (ref($errors) eq 'HASH') {
98: $errors->{15} = 1;
99: return;
100: }
101: my $request;
102: if ($oauthtype eq 'consumer') {
103: my $oauthreq = Net::OAuth->request('consumer');
104: $oauthreq->add_required_message_params('body_hash');
105: $request = $oauthreq->from_authorization_header($authheaders,
106: request_url => $protocol.'://'.$hostname.$requri,
107: request_method => $reqmethod,
108: consumer_secret => $consumer_secret,);
109: } else {
110: $request = Net::OAuth->request('request token')->from_hash($params,
111: request_url => $protocol.'://'.$hostname.$requri,
112: request_method => $reqmethod,
113: consumer_secret => $consumer_secret,);
114: }
1.1 raeburn 115: unless ($request->verify()) {
116: $errors->{15} = 1;
117: return;
118: }
119: }
120:
121: #
122: # LON-CAPA as LTI Consumer
123: #
124: # Sign a request used to launch an instance of an external
1.4 raeburn 125: # tool in a LON-CAPA course, using the key and secret supplied
1.1 raeburn 126: # by the Tool Provider.
127: #
128:
129: sub sign_params {
1.17 raeburn 130: my ($url,$key,$secret,$paramsref,$sigmethod,$type,$callback,$post) = @_;
1.1 raeburn 131: return unless (ref($paramsref) eq 'HASH');
1.3 raeburn 132: if ($sigmethod eq '') {
133: $sigmethod = 'HMAC-SHA1';
134: }
1.17 raeburn 135: if ($type eq '') {
136: $type = 'request token';
137: }
138: if ($callback eq '') {
139: $callback = 'about:blank',
140: }
1.9 raeburn 141: srand( time() ^ ($$ + ($$ << 15)) ); # Seed rand.
1.1 raeburn 142: my $nonce = Digest::SHA::sha1_hex(sprintf("%06x%06x",rand(0xfffff0),rand(0xfffff0)));
1.17 raeburn 143: my $request = Net::OAuth->request($type)->new(
1.1 raeburn 144: consumer_key => $key,
145: consumer_secret => $secret,
146: request_url => $url,
147: request_method => 'POST',
1.3 raeburn 148: signature_method => $sigmethod,
1.1 raeburn 149: timestamp => time,
150: nonce => $nonce,
1.17 raeburn 151: callback => $callback,
1.1 raeburn 152: extra_params => $paramsref,
153: version => '1.0',
154: );
1.15 raeburn 155: $request->sign();
1.17 raeburn 156: if ($post) {
157: return $request->to_post_body();
158: } else {
159: return $request->to_hash();
160: }
1.1 raeburn 161: }
162:
163: #
1.6 raeburn 164: # LON-CAPA as LTI Provider
165: #
166: # Use the part of the launch URL after /adm/lti to determine
167: # the scope for the current session (i.e., restricted to a
168: # single resource, to a single folder/map, or to an entire
169: # course).
170: #
171: # Returns an array containing scope: resource, map, or course
172: # and the LON-CAPA URL that is displayed post-launch, including
173: # accommodation of URL encryption, and translation of a tiny URL
174: # to the actual URL
175: #
176:
177: sub lti_provider_scope {
1.10 raeburn 178: my ($tail,$cdom,$cnum,$getunenc) = @_;
179: my ($scope,$realuri,$passkey,$unencsymb);
180: if ($tail =~ m{^/?uploaded/$cdom/$cnum/(?:default|supplemental)(?:|_\d+)\.(?:sequence|page)(|___\d+___.+)$}) {
1.6 raeburn 181: my $rest = $1;
182: if ($rest eq '') {
183: $scope = 'map';
184: $realuri = $tail;
185: } else {
1.13 raeburn 186: my $symb = $tail;
187: $symb =~ s{^/}{};
188: my ($map,$resid,$url) = &Apache::lonnet::decode_symb($symb);
1.6 raeburn 189: $realuri = &Apache::lonnet::clutter($url);
1.7 raeburn 190: if ($url =~ /\.sequence$/) {
191: $scope = 'map';
1.6 raeburn 192: } else {
1.7 raeburn 193: $scope = 'resource';
1.13 raeburn 194: $realuri .= '?symb='.$symb;
195: $passkey = $symb;
1.10 raeburn 196: if ($getunenc) {
1.13 raeburn 197: $unencsymb = $symb;
1.10 raeburn 198: }
1.6 raeburn 199: }
200: }
1.10 raeburn 201: } elsif ($tail =~ m{^/?res/$match_domain/$match_username/.+\.(?:sequence|page)(|___\d+___.+)$}) {
1.8 raeburn 202: my $rest = $1;
203: if ($rest eq '') {
204: $scope = 'map';
205: $realuri = $tail;
206: } else {
1.13 raeburn 207: my $symb = $tail;
208: $symb =~ s{^/?res/}{};
209: my ($map,$resid,$url) = &Apache::lonnet::decode_symb($symb);
1.8 raeburn 210: $realuri = &Apache::lonnet::clutter($url);
211: if ($url =~ /\.sequence$/) {
212: $scope = 'map';
213: } else {
214: $scope = 'resource';
1.13 raeburn 215: $realuri .= '?symb='.$symb;
216: $passkey = $symb;
1.10 raeburn 217: if ($getunenc) {
1.13 raeburn 218: $unencsymb = $symb;
1.10 raeburn 219: }
1.8 raeburn 220: }
221: }
1.6 raeburn 222: } elsif ($tail =~ m{^/tiny/$cdom/(\w+)$}) {
223: my $key = $1;
224: my $tinyurl;
225: my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);
226: if (defined($cached)) {
227: $tinyurl = $result;
228: } else {
229: my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
230: my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);
231: if ($currtiny{$key} ne '') {
232: $tinyurl = $currtiny{$key};
233: &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);
234: }
235: }
236: if ($tinyurl ne '') {
237: my ($cnum,$symb) = split(/\&/,$tinyurl,2);
238: my ($map,$resid,$url) = &Apache::lonnet::decode_symb($symb);
239: if ($url =~ /\.(page|sequence)$/) {
240: $scope = 'map';
241: } else {
242: $scope = 'resource';
243: }
1.10 raeburn 244: $passkey = $symb;
1.6 raeburn 245: if ((&Apache::lonnet::EXT('resource.0.encrypturl',$symb) =~ /^yes$/i) &&
246: (!$env{'request.role.adv'})) {
247: $realuri = &Apache::lonenc::encrypted(&Apache::lonnet::clutter($url));
1.7 raeburn 248: if ($scope eq 'resource') {
1.6 raeburn 249: $realuri .= '?symb='.&Apache::lonenc::encrypted($symb);
250: }
251: } else {
252: $realuri = &Apache::lonnet::clutter($url);
1.7 raeburn 253: if ($scope eq 'resource') {
1.6 raeburn 254: $realuri .= '?symb='.$symb;
255: }
256: }
1.10 raeburn 257: if ($getunenc) {
258: $unencsymb = $symb;
259: }
1.6 raeburn 260: }
1.10 raeburn 261: } elsif (($tail =~ m{^/$cdom/$cnum$}) || ($tail eq '')) {
1.6 raeburn 262: $scope = 'course';
263: $realuri = '/adm/navmaps';
1.13 raeburn 264: $passkey = '';
1.10 raeburn 265: }
266: if ($scope eq 'map') {
267: $passkey = $realuri;
268: }
269: if (wantarray) {
270: return ($scope,$realuri,$unencsymb);
271: } else {
272: return $passkey;
273: }
274: }
275:
1.17 raeburn 276: sub setup_logout_callback {
277: my ($uname,$udom,$server,$ckey,$secret,$service_url,$idsdir,$protocol,$hostname) = @_;
278: if ($service_url =~ m{^https?://[^/]+/}) {
279: my $digest_user = &Encode::decode_utf8($uname.':'.$udom);
280: my $loginfile = &Digest::SHA::sha1_hex($digest_user).&md5_hex(&md5_hex(time.{}.rand().$$));
281: if ((-d $idsdir) && (open(my $fh,'>',"$idsdir/$loginfile"))) {
282: print $fh "$uname,$udom,$server\n";
283: close($fh);
284: my $callback = 'http://'.$hostname.'/adm/service/logout/'.$loginfile;
285: my %ltiparams = (
286: callback => $callback,
287: );
288: my $post = &sign_params($service_url,$ckey,$secret,\%ltiparams,
289: '','','',1);
290: my $request=new HTTP::Request('POST',$service_url);
291: $request->content($post);
292: my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10);
293: }
294: }
295: return;
296: }
297:
1.12 raeburn 298: #
299: # LON-CAPA as LTI Provider
300: #
301: # Create a new user in LON-CAPA. If the domain's configuration
302: # includes rules for format of "official" usernames, those rules
303: # will apply when determining if a user is to be created. In
304: # additional if institutional user information is available that
305: # will be used when creating a new user account.
306: #
307:
1.11 raeburn 308: sub create_user {
309: my ($ltiref,$uname,$udom,$domdesc,$data,$alerts,$rulematch,$inst_results,
310: $curr_rules,$got_rules) = @_;
311: return unless (ref($ltiref) eq 'HASH');
312: my $checkhash = { "$uname:$udom" => { 'newuser' => 1, }, };
313: my $checks = { 'username' => 1, };
314: my ($lcauth,$lcauthparm);
315: &Apache::loncommon::user_rule_check($checkhash,$checks,$alerts,$rulematch,
316: $inst_results,$curr_rules,$got_rules);
317: my ($userchkmsg,$lcauth,$lcauthparm);
318: my $allowed = 1;
319: if (ref($alerts->{'username'}) eq 'HASH') {
320: if (ref($alerts->{'username'}{$udom}) eq 'HASH') {
321: if ($alerts->{'username'}{$udom}{$uname}) {
322: if (ref($curr_rules->{$udom}) eq 'HASH') {
323: $userchkmsg =
324: &Apache::loncommon::instrule_disallow_msg('username',$domdesc,1).
325: &Apache::loncommon::user_rule_formats($udom,$domdesc,
326: $curr_rules->{$udom}{'username'},
327: 'username');
328: }
329: $allowed = 0;
330: }
331: }
332: }
333: if ($allowed) {
334: if (ref($rulematch->{$uname.':'.$udom}) eq 'HASH') {
335: my $matchedrule = $rulematch->{$uname.':'.$udom}{'username'};
336: my ($rules,$ruleorder) =
337: &Apache::lonnet::inst_userrules($udom,'username');
338: if (ref($rules) eq 'HASH') {
339: if (ref($rules->{$matchedrule}) eq 'HASH') {
340: $lcauth = $rules->{$matchedrule}{'authtype'};
341: $lcauthparm = $rules->{$matchedrule}{'authparm'};
342: }
343: }
344: }
345: if ($lcauth eq '') {
346: $lcauth = $ltiref->{'lcauth'};
347: if ($lcauth eq 'internal') {
348: $lcauthparm = &create_passwd();
349: } else {
350: $lcauthparm = $ltiref->{'lcauthparm'};
351: }
352: }
353: } else {
354: return 'notallowed';
355: }
356: my @userinfo = ('firstname','middlename','lastname','generation','permanentemail','id');
357: my (%useinstdata,%info);
358: if (ref($ltiref->{'instdata'}) eq 'ARRAY') {
359: map { $useinstdata{$_} = 1; } @{$ltiref->{'instdata'}};
360: }
361: foreach my $item (@userinfo) {
362: if (($useinstdata{$item}) && (ref($inst_results->{$uname.':'.$udom}) eq 'HASH') &&
363: ($inst_results->{$uname.':'.$udom}{$item} ne '')) {
364: $info{$item} = $inst_results->{$uname.':'.$udom}{$item};
365: } else {
366: if ($item eq 'permanentemail') {
367: if ($data->{'permanentemail'} =~/^[^\@]+\@[^@]+$/) {
368: $info{$item} = $data->{'permanentemail'};
369: }
370: } elsif (($item eq 'firstname') || ($item eq 'lastname')) {
371: $info{$item} = $data->{$item};
372: }
373: }
374: }
375: if (($info{'middlename'} eq '') && ($data->{'fullname'} ne '')) {
376: unless ($useinstdata{'middlename'}) {
377: my $fullname = $data->{'fullname'};
378: if ($info{'firstname'}) {
379: $fullname =~ s/^\s*\Q$info{'firstname'}\E\s*//i;
380: }
381: if ($info{'lastname'}) {
382: $fullname =~ s/\s*\Q$info{'lastname'}\E\s*$//i;
383: }
384: if ($fullname ne '') {
385: $fullname =~ s/^\s+|\s+$//g;
386: if ($fullname ne '') {
387: $info{'middlename'} = $fullname;
388: }
389: }
390: }
391: }
392: if (ref($inst_results->{$uname.':'.$udom}{'inststatus'}) eq 'ARRAY') {
393: my @inststatuses = @{$inst_results->{$uname.':'.$udom}{'inststatus'}};
394: $info{'inststatus'} = join(':',map { &escape($_); } @inststatuses);
395: }
396: my $result =
397: &Apache::lonnet::modifyuser($udom,$uname,$info{'id'},
398: $lcauth,$lcauthparm,$info{'firstname'},
399: $info{'middlename'},$info{'lastname'},
400: $info{'generation'},undef,undef,
401: $info{'permanentemail'},$info{'inststatus'});
402: return $result;
403: }
404:
1.12 raeburn 405: #
406: # LON-CAPA as LTI Provider
407: #
408: # Create a password for a new user if the authentication
409: # type to assign to new users created following LTI launch is
410: # to be LON-CAPA "internal".
411: #
412:
1.11 raeburn 413: sub create_passwd {
414: my $passwd = '';
1.12 raeburn 415: srand( time() ^ ($$ + ($$ << 15)) ); # Seed rand.
1.11 raeburn 416: my @letts = ("a".."z");
417: for (my $i=0; $i<8; $i++) {
418: my $lettnum = int(rand(2));
419: my $item = '';
420: if ($lettnum) {
421: $item = $letts[int(rand(26))];
422: my $uppercase = int(rand(2));
423: if ($uppercase) {
424: $item =~ tr/a-z/A-Z/;
425: }
426: } else {
427: $item = int(rand(10));
428: }
429: $passwd .= $item;
430: }
431: return ($passwd);
432: }
433:
1.12 raeburn 434: #
435: # LON-CAPA as LTI Provider
436: #
437: # Enroll a user in a LON-CAPA course, with the specified role and (optional)
438: # section. If this is a self-enroll case, i.e., a user launched the LTI tool
439: # in the Consumer, user privs will be added to the user's environment for
440: # the new role.
441: #
442: # If this is a self-enroll case, a Course Coordinator role will only be assigned
443: # if the current user is also the course owner.
444: #
445:
1.11 raeburn 446: sub enrolluser {
1.12 raeburn 447: my ($udom,$uname,$role,$cdom,$cnum,$sec,$start,$end,$selfenroll) = @_;
1.11 raeburn 448: my $enrollresult;
449: my $area = "/$cdom/$cnum";
450: if (($role ne 'cc') && ($role ne 'co') && ($sec ne '')) {
451: $area .= '/'.$sec;
452: }
453: my $spec = $role.'.'.$area;
454: my $instcid;
455: if ($role eq 'st') {
456: $enrollresult =
457: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,
458: undef,undef,$sec,$end,$start,
1.12 raeburn 459: 'ltienroll',undef,$cdom.'_'.$cnum,
460: $selfenroll,'ltienroll','',$instcid);
1.11 raeburn 461: } elsif ($role =~ /^(cc|in|ta|ep)$/) {
462: $enrollresult =
463: &Apache::lonnet::assignrole($udom,$uname,$area,$role,$end,$start,
1.12 raeburn 464: undef,$selfenroll,'ltienroll');
465: }
466: if ($enrollresult eq 'ok') {
467: if ($selfenroll) {
468: my (%userroles,%newrole,%newgroups);
469: &Apache::lonnet::standard_roleprivs(\%newrole,$role,$cdom,$spec,$cnum,
470: $area);
471: &Apache::lonnet::set_userprivs(\%userroles,\%newrole,\%newgroups);
472: $userroles{'user.role.'.$spec} = $start.'.'.$end;
473: &Apache::lonnet::appenv(\%userroles,[$role,'cm']);
474: }
1.11 raeburn 475: }
476: return $enrollresult;
477: }
478:
1.12 raeburn 479: #
480: # LON-CAPA as LTI Provider
481: #
482: # Gather a list of available LON-CAPA roles derived
483: # from a comma separated list of LTI roles.
484: #
485: # Which LON-CAPA roles are assignable by the current user
486: # and how LTI roles map to LON-CAPA roles (as defined in
487: # the domain configuration for the specific Consumer) are
488: # factored in when compiling the list of available roles.
489: #
490: # Inputs: 3
491: # $rolestr - comma separated list of LTI roles.
492: # $allowedroles - reference to array of assignable LC roles
493: # $maproles - ref to HASH of mapping of LTI roles to LC roles
494: #
495: # Outputs: 2
496: # (a) reference to array of available LC roles.
497: # (b) reference to array of LTI roles.
498: #
499:
1.11 raeburn 500: sub get_lc_roles {
501: my ($rolestr,$allowedroles,$maproles) = @_;
502: my (@ltiroles,@lcroles);
503: my @ltiroleorder = ('Instructor','TeachingAssistant','Mentor','Learner');
504: if ($rolestr =~ /,/) {
505: my @possltiroles = split(/\s*,\s*/,$rolestr);
506: foreach my $ltirole (@ltiroleorder) {
507: if (grep(/^\Q$ltirole\E$/,@possltiroles)) {
508: push(@ltiroles,$ltirole);
509: }
510: }
511: } else {
512: my $singlerole = $rolestr;
513: $singlerole =~ s/^\s|\s+$//g;
514: if ($singlerole ne '') {
515: if (grep(/^\Q$singlerole\E$/,@ltiroleorder)) {
516: @ltiroles = ($singlerole);
517: }
518: }
519: }
520: if (@ltiroles) {
521: my %possroles;
522: map { $possroles{$maproles->{$_}} = 1; } @ltiroles;
523: if (keys(%possroles) > 0) {
524: if (ref($allowedroles) eq 'ARRAY') {
525: foreach my $item (@{$allowedroles}) {
526: if (($item eq 'co') || ($item eq 'cc')) {
527: if ($possroles{'cc'}) {
528: push(@lcroles,$item);
529: }
530: } elsif ($possroles{$item}) {
531: push(@lcroles,$item);
532: }
533: }
534: }
535: }
536: }
537: return (\@lcroles,\@ltiroles);
538: }
539:
1.1 raeburn 540: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to ltiutils.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / lti