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