Annotation of loncom/lti/ltiutils.pm, revision 1.1
1.1 ! raeburn 1: # The LearningOnline Network with CAPA
! 2: # Utility functions for managing LON-CAPA LTI interactions
! 3: #
! 4: # $Id: ltiutils.pm,v 1.1 2017/11/30 22:41:20 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 = &get_service_id($secret,$uniqid);
! 290: if ($expected_sig eq $sigrec) {
! 291: return 1;
! 292: } else {
! 293: $errors->{16} = 1;
! 294: }
! 295: } elsif ($context eq 'roster') {
! 296: my $uniqid = $digsymb.':::'.$cdom.'_'.$cnum;
! 297: $expected_sig = &get_service_id($secret,$uniqid);
! 298: if ($expected_sig eq $sigrec) {
! 299: return 1;
! 300: } else {
! 301: $errors->{17} = 1;
! 302: }
! 303: }
! 304: } else {
! 305: $errors->{18} = 1;
! 306: }
! 307: } else {
! 308: $errors->{19} = 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: # too 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,$paramsref) = @_;
! 323: return unless (ref($paramsref) eq 'HASH');
! 324: my $nonce = Digest::SHA::sha1_hex(sprintf("%06x%06x",rand(0xfffff0),rand(0xfffff0)));
! 325: my $request = Net::OAuth->request("request token")->new(
! 326: consumer_key => $key,
! 327: consumer_secret => $secret,
! 328: request_url => $url,
! 329: request_method => 'POST',
! 330: signature_method => 'HMAC-SHA1',
! 331: timestamp => time,
! 332: nonce => $nonce,
! 333: callback => 'about:blank',
! 334: extra_params => $paramsref,
! 335: version => '1.0',
! 336: );
! 337: $request->sign;
! 338: return $request->to_hash();
! 339: }
! 340:
! 341: #
! 342: # LON-CAPA as LTI Consumer
! 343: #
! 344: # Generate a signature for a unique identifier (roster request:
! 345: # ext_ims_lis_memberships_id, or grade store: lis_result_sourcedid)
! 346: #
! 347:
! 348: sub get_service_id {
! 349: my ($secret,$id) = @_;
! 350: my $sig = Digest::SHA::sha1_hex($secret.':::'.$id);
! 351: return $sig.':::'.$id;
! 352: }
! 353:
! 354: #
! 355: # LON-CAPA as LTI Consumer
! 356: #
! 357: # Generate and store the time-limited secret used to create the
! 358: # signature in a service request identifier (roster request or
! 359: # grade store). An existing secret past its expiration date
! 360: # will be stored as old<service name>secret, and a new secret
! 361: # <service name>secret will be stored.
! 362: #
! 363: # Secrets are specific to service name and to the tool instance
! 364: # (and are stored in the exttool_$marker db file).
! 365: # The time period a secret remains valid is determined by the
! 366: # domain configuration for the specific tool and the service.
! 367: #
! 368:
! 369: sub set_service_secret {
! 370: my ($cdom,$cnum,$marker,$name,$now,$toolsettings,$ltitools) = @_;
! 371: return unless ((ref($toolsettings) eq 'HASH') && (ref($ltitools) eq 'HASH'));
! 372: my $warning;
! 373: my ($needsnew,$oldsecret,$lifetime);
! 374: if ($name eq 'grade') {
! 375: $lifetime = $ltitools->{'passbackvalid'}
! 376: } elsif ($name eq 'roster') {
! 377: $lifetime = $ltitools->{'rostervalid'};
! 378: }
! 379: if ($toolsettings->{$name} eq '') {
! 380: $needsnew = 1;
! 381: } elsif (($toolsettings->{$name.'date'} + $lifetime) < $now) {
! 382: $oldsecret = $toolsettings->{$name.'secret'};
! 383: $needsnew = 1;
! 384: }
! 385: if ($needsnew) {
! 386: if (&get_tool_lock($cdom,$cnum,$marker,$name,$now) eq 'ok') {
! 387: my $secret = UUID::Tiny::create_uuid_as_string(UUID_V4);
! 388: $toolsettings->{$name.'secret'} = $secret;
! 389: my %secrethash = (
! 390: $name.'secret' => $secret,
! 391: $name.'secretdate' => $now,
! 392: );
! 393: if ($oldsecret ne '') {
! 394: $secrethash{'old'.$name.'secret'} = $oldsecret;
! 395: }
! 396: my $putres = &Apache::lonnet::put('exttool_'.$marker,
! 397: \%secrethash,$cdom,$cnum);
! 398: my $delresult = &release_tool_lock($cdom,$cnum,$marker,$name);
! 399: if ($delresult ne 'ok') {
! 400: $warning = $delresult ;
! 401: }
! 402: if ($putres eq 'ok') {
! 403: return 'ok';
! 404: }
! 405: } else {
! 406: $warning = 'Could not obtain exclusive lock';
! 407: }
! 408: } else {
! 409: return 'ok';
! 410: }
! 411: return;
! 412: }
! 413:
! 414: #
! 415: # LON-CAPA as LTI Consumer
! 416: #
! 417: # Add a lock key to exttools.db for the instance of an external tool
! 418: # when generating and storing a service secret.
! 419: #
! 420:
! 421: sub get_tool_lock {
! 422: my ($cdom,$cnum,$marker,$name,$now) = @_;
! 423: # get lock for tool for which secret is being set
! 424: my $lockhash = {
! 425: $name."\0".$marker."\0".'lock' => $now.':'.$env{'user.name'}.
! 426: ':'.$env{'user.domain'},
! 427: };
! 428: my $tries = 0;
! 429: my $gotlock = &Apache::lonnet::newput('exttools',$lockhash,$cdom,$cnum);
! 430:
! 431: while (($gotlock ne 'ok') && $tries <3) {
! 432: $tries ++;
! 433: sleep(1);
! 434: $gotlock = &Apache::lonnet::newput('exttools',$lockhash,$cdom,$cnum);
! 435: }
! 436: return $gotlock;
! 437: }
! 438:
! 439: #
! 440: # LON-CAPA as LTI Consumer
! 441: #
! 442: # Remove a lock key from exttools.db for the instance of an external
! 443: # tool created when generating and storing a service secret.
! 444: #
! 445:
! 446: sub release_tool_lock {
! 447: my ($cdom,$cnum,$marker) = @_;
! 448: # remove lock
! 449: my @del_lock = ($name."\0".$marker."\0".'lock');
! 450: my $dellockoutcome=&Apache::lonnet::del('exttools',\@del_lock,$cdom,$cnum);
! 451: if ($dellockoutcome ne 'ok') {
! 452: return 'Warning: failed to release lock for exttool';
! 453: } else {
! 454: return 'ok';
! 455: }
! 456: }
! 457:
! 458: 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