1: # The LearningOnline Network with CAPA
2: # Utility functions for managing LON-CAPA LTI interactions
3: #
4: # $Id: ltiutils.pm,v 1.9 2018/05/15 04:33:17 raeburn Exp $
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 UUID::Tiny ':std';
35: use Apache::lonnet;
36: use Apache::loncommon;
37: use LONCAPA qw(:DEFAULT :match);
38:
39: #
40: # LON-CAPA as LTI Consumer or LTI Provider
41: #
42: # Determine if a nonce in POSTed data has expired.
43: # If unexpired, confirm it has not already been used.
44: #
45: # When LON-CAPA is operating as a Consumer, nonce checking
46: # occurs when a Tool Provider launched from an instance of
47: # an external tool in a LON-CAPA course makes a request to
48: # (a) /adm/service/roster or (b) /adm/service/passback to,
49: # respectively, retrieve a roster or store the grade for
50: # the original launch by a specific user.
51: #
52: # When LON-CAPA is operating as a Provider, nonce checking
53: # occurs when a user in course context in another LMS (the
54: # Consumer) launches an external tool to access a LON-CAPA URL:
55: # /adm/lti/ with LON-CAPA symb, map, or deep-link ID appended.
56: #
57:
58: sub check_nonce {
59: my ($nonce,$timestamp,$lifetime,$domain,$ltidir) = @_;
60: if (($ltidir eq '') || ($timestamp eq '') || ($timestamp =~ /^\D/) ||
61: ($lifetime eq '') || ($lifetime =~ /\D/) || ($domain eq '')) {
62: return;
63: }
64: my $now = time;
65: if (($timestamp) && ($timestamp < ($now - $lifetime))) {
66: return;
67: }
68: if ($nonce eq '') {
69: return;
70: }
71: if (-e "$ltidir/$domain/$nonce") {
72: return;
73: } else {
74: unless (-e "$ltidir/$domain") {
75: unless (mkdir("$ltidir/$domain",0755)) {
76: return;
77: }
78: }
79: if (open(my $fh,'>',"$ltidir/$domain/$nonce")) {
80: print $fh $now;
81: close($fh);
82: return 1;
83: }
84: }
85: return;
86: }
87:
88: #
89: # LON-CAPA as LTI Consumer
90: #
91: # Determine the domain and the courseID of the LON-CAPA course
92: # for which access is needed by a Tool Provider -- either to
93: # retrieve a roster or store the grade for an instance of an
94: # external tool in the course.
95: #
96:
97: sub get_loncapa_course {
98: my ($lonhost,$cid,$errors) = @_;
99: return unless (ref($errors) eq 'HASH');
100: my ($cdom,$cnum);
101: if ($cid =~ /^($match_domain)_($match_courseid)$/) {
102: my ($posscdom,$posscnum) = ($1,$2);
103: my $cprimary_id = &Apache::lonnet::domain($posscdom,'primary');
104: if ($cprimary_id eq '') {
105: $errors->{5} = 1;
106: return;
107: } else {
108: my @intdoms;
109: my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
110: if (ref($internet_names) eq 'ARRAY') {
111: @intdoms = @{$internet_names};
112: }
113: my $cintdom = &Apache::lonnet::internet_dom($cprimary_id);
114: if (($cintdom ne '') && (grep(/^\Q$cintdom\E$/,@intdoms))) {
115: $cdom = $posscdom;
116: } else {
117: $errors->{6} = 1;
118: return;
119: }
120: }
121: my $chome = &Apache::lonnet::homeserver($posscnum,$posscdom);
122: if ($chome =~ /(con_lost|no_host|no_such_host)/) {
123: $errors->{7} = 1;
124: return;
125: } else {
126: $cnum = $posscnum;
127: }
128: } else {
129: $errors->{8} = 1;
130: return;
131: }
132: return ($cdom,$cnum);
133: }
134:
135: #
136: # LON-CAPA as LTI Consumer
137: #
138: # Determine the symb and (optionally) LON-CAPA user for an
139: # instance of an external tool in a course -- either to
140: # to retrieve a roster or store a grade.
141: #
142: # Use the digested symb to lookup the real symb in exttools.db
143: # and the digested userID to lookup the real userID (if needed).
144: # and extract the exttool instance and symb.
145: #
146:
147: sub get_tool_instance {
148: my ($cdom,$cnum,$digsymb,$diguser,$errors) = @_;
149: return unless (ref($errors) eq 'HASH');
150: my ($marker,$symb,$uname,$udom);
151: my @keys = ($digsymb);
152: if ($diguser) {
153: push(@keys,$diguser);
154: }
155: my %digesthash = &Apache::lonnet::get('exttools',\@keys,$cdom,$cnum);
156: if ($digsymb) {
157: $symb = $digesthash{$digsymb};
158: if ($symb) {
159: my ($map,$id,$url) = split(/___/,$symb);
160: $marker = (split(m{/},$url))[3];
161: $marker=~s/\D//g;
162: } else {
163: $errors->{9} = 1;
164: }
165: }
166: if ($diguser) {
167: if ($digesthash{$diguser} =~ /^($match_username):($match_domain)$/) {
168: ($uname,$udom) = ($1,$2);
169: } else {
170: $errors->{10} = 1;
171: }
172: return ($marker,$symb,$uname,$udom);
173: } else {
174: return ($marker,$symb);
175: }
176: }
177:
178: #
179: # LON-CAPA as LTI Consumer
180: #
181: # Retrieve data needed to validate a request from a Tool Provider
182: # for a roster or to store a grade for an instance of an external
183: # tool in a LON-CAPA course.
184: #
185: # Retrieve the Consumer key and Consumer secret from the domain
186: # configuration or the Tool Provider ID stored in the
187: # exttool_$marker db file and compare the Consumer key with the
188: # one in the POSTed data.
189: #
190: # Side effect is to populate the $toolsettings hashref with the
191: # contents of the .db file (instance of tool in course) and the
192: # $ltitools hashref with the configuration for the tool (at
193: # domain level).
194: #
195:
196: sub get_tool_secret {
197: my ($key,$marker,$symb,$cdom,$cnum,$toolsettings,$ltitools,$errors) = @_;
198: return unless ((ref($toolsettings) eq 'HASH') && (ref($ltitools) eq 'HASH') &&
199: (ref($errors) eq 'HASH'));
200: my ($consumer_secret,$nonce_lifetime);
201: if ($marker) {
202: %{$toolsettings}=&Apache::lonnet::dump('exttool_'.$marker,$cdom,$cnum);
203: if ($toolsettings->{'id'}) {
204: my $idx = $toolsettings->{'id'};
205: my %lti = &Apache::lonnet::get_domain_lti($cdom,'consumer');
206: if (ref($lti{$idx}) eq 'HASH') {
207: %{$ltitools} = %{$lti{$idx}};
208: if ($ltitools->{'key'} eq $key) {
209: $consumer_secret = $ltitools->{'secret'};
210: $nonce_lifetime = $ltitools->{'lifetime'};
211: } else {
212: $errors->{11} = 1;
213: return;
214: }
215: } else {
216: $errors->{12} = 1;
217: return;
218: }
219: } else {
220: $errors->{13} = 1;
221: return;
222: }
223: } else {
224: $errors->{14};
225: return;
226: }
227: return ($consumer_secret,$nonce_lifetime);
228: }
229:
230: #
231: # LON-CAPA as LTI Consumer
232: #
233: # Verify a signed request using the consumer_key and
234: # secret for the specific LTI Provider.
235: #
236:
237: sub verify_request {
238: my ($params,$protocol,$hostname,$requri,$reqmethod,$consumer_secret,$errors) = @_;
239: return unless (ref($errors) eq 'HASH');
240: my $request = Net::OAuth->request('request token')->from_hash($params,
241: request_url => $protocol.'://'.$hostname.$requri,
242: request_method => $reqmethod,
243: consumer_secret => $consumer_secret,);
244: unless ($request->verify()) {
245: $errors->{15} = 1;
246: return;
247: }
248: }
249:
250: #
251: # LON-CAPA as LTI Consumer
252: #
253: # Verify that an item identifier (either roster request:
254: # ext_ims_lis_memberships_id, or grade store:
255: # lis_result_sourcedid) has not been tampered with, and
256: # the secret used to create the unique identifier has not
257: # expired.
258: #
259: # Prepending the current secret (if still valid),
260: # or the previous secret (if current one is no longer valid),
261: # to a string composed of the :::-separated components
262: # must generate the result signature in the lis item ID
263: # sent by the Tool Provider.
264: #
265:
266: sub verify_lis_item {
267: my ($sigrec,$context,$digsymb,$diguser,$cdom,$cnum,$toolsettings,$ltitools,$errors) = @_;
268: return unless ((ref($toolsettings) eq 'HASH') && (ref($ltitools) eq 'HASH') &&
269: (ref($errors) eq 'HASH'));
270: my ($has_action, $valid_for);
271: if ($context eq 'grade') {
272: $has_action = $ltitools->{'passback'};
273: $valid_for = $ltitools->{'passbackvalid'}
274: } elsif ($context eq 'roster') {
275: $has_action = $ltitools->{'roster'};
276: $valid_for = $ltitools->{'rostervalid'};
277: }
278: if ($has_action) {
279: my $secret;
280: if (($toolsettings->{$context.'secretdate'} + $valid_for) > time) {
281: $secret = $toolsettings->{$context.'secret'};
282: } else {
283: $secret = $toolsettings->{'old'.$context.'secret'};
284: }
285: if ($secret) {
286: my $expected_sig;
287: if ($context eq 'grade') {
288: my $uniqid = $digsymb.':::'.$diguser.':::'.$cdom.'_'.$cnum;
289: $expected_sig = (split(/:::/,&get_service_id($secret,$uniqid)))[0];
290: if ($expected_sig eq $sigrec) {
291: return 1;
292: } else {
293: $errors->{17} = 1;
294: }
295: } elsif ($context eq 'roster') {
296: my $uniqid = $digsymb.':::'.$cdom.'_'.$cnum;
297: $expected_sig = (split(/:::/,&get_service_id($secret,$uniqid)))[0];
298: if ($expected_sig eq $sigrec) {
299: return 1;
300: } else {
301: $errors->{18} = 1;
302: }
303: }
304: } else {
305: $errors->{19} = 1;
306: }
307: } else {
308: $errors->{20} = 1;
309: }
310: return;
311: }
312:
313: #
314: # LON-CAPA as LTI Consumer
315: #
316: # Sign a request used to launch an instance of an external
317: # tool in a LON-CAPA course, using the key and secret supplied
318: # by the Tool Provider.
319: #
320:
321: sub sign_params {
322: my ($url,$key,$secret,$sigmethod,$paramsref) = @_;
323: return unless (ref($paramsref) eq 'HASH');
324: if ($sigmethod eq '') {
325: $sigmethod = 'HMAC-SHA1';
326: }
327: srand( time() ^ ($$ + ($$ << 15)) ); # Seed rand.
328: my $nonce = Digest::SHA::sha1_hex(sprintf("%06x%06x",rand(0xfffff0),rand(0xfffff0)));
329: my $request = Net::OAuth->request("request token")->new(
330: consumer_key => $key,
331: consumer_secret => $secret,
332: request_url => $url,
333: request_method => 'POST',
334: signature_method => $sigmethod,
335: timestamp => time,
336: nonce => $nonce,
337: callback => 'about:blank',
338: extra_params => $paramsref,
339: version => '1.0',
340: );
341: $request->sign;
342: return $request->to_hash();
343: }
344:
345: #
346: # LON-CAPA as LTI Consumer
347: #
348: # Generate a signature for a unique identifier (roster request:
349: # ext_ims_lis_memberships_id, or grade store: lis_result_sourcedid)
350: #
351:
352: sub get_service_id {
353: my ($secret,$id) = @_;
354: my $sig = Digest::SHA::sha1_hex($secret.':::'.$id);
355: return $sig.':::'.$id;
356: }
357:
358: #
359: # LON-CAPA as LTI Consumer
360: #
361: # Generate and store the time-limited secret used to create the
362: # signature in a service request identifier (roster request or
363: # grade store). An existing secret past its expiration date
364: # will be stored as old<service name>secret, and a new secret
365: # <service name>secret will be stored.
366: #
367: # Secrets are specific to service name and to the tool instance
368: # (and are stored in the exttool_$marker db file).
369: # The time period a secret remains valid is determined by the
370: # domain configuration for the specific tool and the service.
371: #
372:
373: sub set_service_secret {
374: my ($cdom,$cnum,$marker,$name,$now,$toolsettings,$ltitools) = @_;
375: return unless ((ref($toolsettings) eq 'HASH') && (ref($ltitools) eq 'HASH'));
376: my $warning;
377: my ($needsnew,$oldsecret,$lifetime);
378: if ($name eq 'grade') {
379: $lifetime = $ltitools->{'passbackvalid'}
380: } elsif ($name eq 'roster') {
381: $lifetime = $ltitools->{'rostervalid'};
382: }
383: if ($toolsettings->{$name} eq '') {
384: $needsnew = 1;
385: } elsif (($toolsettings->{$name.'date'} + $lifetime) < $now) {
386: $oldsecret = $toolsettings->{$name.'secret'};
387: $needsnew = 1;
388: }
389: if ($needsnew) {
390: if (&get_tool_lock($cdom,$cnum,$marker,$name,$now) eq 'ok') {
391: my $secret = UUID::Tiny::create_uuid_as_string(UUID_V4);
392: $toolsettings->{$name.'secret'} = $secret;
393: my %secrethash = (
394: $name.'secret' => $secret,
395: $name.'secretdate' => $now,
396: );
397: if ($oldsecret ne '') {
398: $secrethash{'old'.$name.'secret'} = $oldsecret;
399: }
400: my $putres = &Apache::lonnet::put('exttool_'.$marker,
401: \%secrethash,$cdom,$cnum);
402: my $delresult = &release_tool_lock($cdom,$cnum,$marker,$name);
403: if ($delresult ne 'ok') {
404: $warning = $delresult ;
405: }
406: if ($putres eq 'ok') {
407: return 'ok';
408: }
409: } else {
410: $warning = 'Could not obtain exclusive lock';
411: }
412: } else {
413: return 'ok';
414: }
415: return;
416: }
417:
418: #
419: # LON-CAPA as LTI Consumer
420: #
421: # Add a lock key to exttools.db for the instance of an external tool
422: # when generating and storing a service secret.
423: #
424:
425: sub get_tool_lock {
426: my ($cdom,$cnum,$marker,$name,$now) = @_;
427: # get lock for tool for which secret is being set
428: my $lockhash = {
429: $name."\0".$marker."\0".'lock' => $now.':'.$env{'user.name'}.
430: ':'.$env{'user.domain'},
431: };
432: my $tries = 0;
433: my $gotlock = &Apache::lonnet::newput('exttools',$lockhash,$cdom,$cnum);
434:
435: while (($gotlock ne 'ok') && $tries <3) {
436: $tries ++;
437: sleep(1);
438: $gotlock = &Apache::lonnet::newput('exttools',$lockhash,$cdom,$cnum);
439: }
440: return $gotlock;
441: }
442:
443: #
444: # LON-CAPA as LTI Consumer
445: #
446: # Remove a lock key from exttools.db for the instance of an external
447: # tool created when generating and storing a service secret.
448: #
449:
450: sub release_tool_lock {
451: my ($cdom,$cnum,$marker,$name) = @_;
452: # remove lock
453: my @del_lock = ($name."\0".$marker."\0".'lock');
454: my $dellockoutcome=&Apache::lonnet::del('exttools',\@del_lock,$cdom,$cnum);
455: if ($dellockoutcome ne 'ok') {
456: return 'Warning: failed to release lock for exttool';
457: } else {
458: return 'ok';
459: }
460: }
461:
462: #
463: # LON-CAPA as LTI Provider
464: #
465: # Use the part of the launch URL after /adm/lti to determine
466: # the scope for the current session (i.e., restricted to a
467: # single resource, to a single folder/map, or to an entire
468: # course).
469: #
470: # Returns an array containing scope: resource, map, or course
471: # and the LON-CAPA URL that is displayed post-launch, including
472: # accommodation of URL encryption, and translation of a tiny URL
473: # to the actual URL
474: #
475:
476: sub lti_provider_scope {
477: my ($tail,$cdom,$cnum) = @_;
478: my ($scope,$realuri);
479: if ($tail =~ m{^/uploaded/$cdom/$cnum/(?:default|supplemental)(?:|_\d+)\.(?:sequence|page)(|___\d+___.+)$}) {
480: my $rest = $1;
481: if ($rest eq '') {
482: $scope = 'map';
483: $realuri = $tail;
484: } else {
485: my ($map,$resid,$url) = &Apache::lonnet::decode_symb($tail);
486: $realuri = &Apache::lonnet::clutter($url);
487: if ($url =~ /\.sequence$/) {
488: $scope = 'map';
489: } else {
490: $scope = 'resource';
491: $realuri .= '?symb='.$tail;
492: }
493: }
494: } elsif ($tail =~ m{^/res/$match_domain/$match_username/.+\.(?:sequence|page)(|___\d+___.+)$}) {
495: my $rest = $1;
496: if ($rest eq '') {
497: $scope = 'map';
498: $realuri = $tail;
499: } else {
500: my ($map,$resid,$url) = &Apache::lonnet::decode_symb($tail);
501: $realuri = &Apache::lonnet::clutter($url);
502: if ($url =~ /\.sequence$/) {
503: $scope = 'map';
504: } else {
505: $scope = 'resource';
506: $realuri .= '?symb='.$tail;
507: }
508: }
509: } elsif ($tail =~ m{^/tiny/$cdom/(\w+)$}) {
510: my $key = $1;
511: my $tinyurl;
512: my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);
513: if (defined($cached)) {
514: $tinyurl = $result;
515: } else {
516: my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
517: my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);
518: if ($currtiny{$key} ne '') {
519: $tinyurl = $currtiny{$key};
520: &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);
521: }
522: }
523: if ($tinyurl ne '') {
524: my ($cnum,$symb) = split(/\&/,$tinyurl,2);
525: my ($map,$resid,$url) = &Apache::lonnet::decode_symb($symb);
526: if ($url =~ /\.(page|sequence)$/) {
527: $scope = 'map';
528: } else {
529: $scope = 'resource';
530: }
531: if ((&Apache::lonnet::EXT('resource.0.encrypturl',$symb) =~ /^yes$/i) &&
532: (!$env{'request.role.adv'})) {
533: $realuri = &Apache::lonenc::encrypted(&Apache::lonnet::clutter($url));
534: if ($scope eq 'resource') {
535: $realuri .= '?symb='.&Apache::lonenc::encrypted($symb);
536: }
537: } else {
538: $realuri = &Apache::lonnet::clutter($url);
539: if ($scope eq 'resource') {
540: $realuri .= '?symb='.$symb;
541: }
542: }
543: }
544: } elsif ($tail =~ m{^/$cdom/$cnum$}) {
545: $scope = 'course';
546: $realuri = '/adm/navmaps';
547: }
548: return ($scope,$realuri);
549: }
550:
551: 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