--- loncom/lti/ltiutils.pm 2020/04/09 23:17:19 1.9.2.1 +++ loncom/lti/ltiutils.pm 2018/05/15 04:59:22 1.10 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Utility functions for managing LON-CAPA LTI interactions # -# $Id: ltiutils.pm,v 1.9.2.1 2020/04/09 23:17:19 raeburn Exp $ +# $Id: ltiutils.pm,v 1.10 2018/05/15 04:59:22 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -31,12 +31,14 @@ package LONCAPA::ltiutils; use strict; use Net::OAuth; use Digest::SHA; +use UUID::Tiny ':std'; use Apache::lonnet; use Apache::loncommon; +use Math::Round(); use LONCAPA qw(:DEFAULT :match); # -# LON-CAPA as LTI Consumer +# LON-CAPA as LTI Consumer or LTI Provider # # Determine if a nonce in POSTed data has expired. # If unexpired, confirm it has not already been used. @@ -48,6 +50,11 @@ use LONCAPA qw(:DEFAULT :match); # respectively, retrieve a roster or store the grade for # the original launch by a specific user. # +# When LON-CAPA is operating as a Provider, nonce checking +# occurs when a user in course context in another LMS (the +# Consumer) launches an external tool to access a LON-CAPA URL: +# /adm/lti/ with LON-CAPA symb, map, or deep-link ID appended. +# sub check_nonce { my ($nonce,$timestamp,$lifetime,$domain,$ltidir) = @_; @@ -172,6 +179,58 @@ sub get_tool_instance { # # LON-CAPA as LTI Consumer # +# Retrieve data needed to validate a request from a Tool Provider +# for a roster or to store a grade for an instance of an external +# tool in a LON-CAPA course. +# +# Retrieve the Consumer key and Consumer secret from the domain +# configuration or the Tool Provider ID stored in the +# exttool_$marker db file and compare the Consumer key with the +# one in the POSTed data. +# +# Side effect is to populate the $toolsettings hashref with the +# contents of the .db file (instance of tool in course) and the +# $ltitools hashref with the configuration for the tool (at +# domain level). +# + +sub get_tool_secret { + my ($key,$marker,$symb,$cdom,$cnum,$toolsettings,$ltitools,$errors) = @_; + return unless ((ref($toolsettings) eq 'HASH') && (ref($ltitools) eq 'HASH') && + (ref($errors) eq 'HASH')); + my ($consumer_secret,$nonce_lifetime); + if ($marker) { + %{$toolsettings}=&Apache::lonnet::dump('exttool_'.$marker,$cdom,$cnum); + if ($toolsettings->{'id'}) { + my $idx = $toolsettings->{'id'}; + my %lti = &Apache::lonnet::get_domain_lti($cdom,'consumer'); + if (ref($lti{$idx}) eq 'HASH') { + %{$ltitools} = %{$lti{$idx}}; + if ($ltitools->{'key'} eq $key) { + $consumer_secret = $ltitools->{'secret'}; + $nonce_lifetime = $ltitools->{'lifetime'}; + } else { + $errors->{11} = 1; + return; + } + } else { + $errors->{12} = 1; + return; + } + } else { + $errors->{13} = 1; + return; + } + } else { + $errors->{14}; + return; + } + return ($consumer_secret,$nonce_lifetime); +} + +# +# LON-CAPA as LTI Consumer +# # Verify a signed request using the consumer_key and # secret for the specific LTI Provider. # @@ -192,6 +251,69 @@ sub verify_request { # # LON-CAPA as LTI Consumer # +# Verify that an item identifier (either roster request: +# ext_ims_lis_memberships_id, or grade store: +# lis_result_sourcedid) has not been tampered with, and +# the secret used to create the unique identifier has not +# expired. +# +# Prepending the current secret (if still valid), +# or the previous secret (if current one is no longer valid), +# to a string composed of the :::-separated components +# must generate the result signature in the lis item ID +# sent by the Tool Provider. +# + +sub verify_lis_item { + my ($sigrec,$context,$digsymb,$diguser,$cdom,$cnum,$toolsettings,$ltitools,$errors) = @_; + return unless ((ref($toolsettings) eq 'HASH') && (ref($ltitools) eq 'HASH') && + (ref($errors) eq 'HASH')); + my ($has_action, $valid_for); + if ($context eq 'grade') { + $has_action = $ltitools->{'passback'}; + $valid_for = $ltitools->{'passbackvalid'} + } elsif ($context eq 'roster') { + $has_action = $ltitools->{'roster'}; + $valid_for = $ltitools->{'rostervalid'}; + } + if ($has_action) { + my $secret; + if (($toolsettings->{$context.'secretdate'} + $valid_for) > time) { + $secret = $toolsettings->{$context.'secret'}; + } else { + $secret = $toolsettings->{'old'.$context.'secret'}; + } + if ($secret) { + my $expected_sig; + if ($context eq 'grade') { + my $uniqid = $digsymb.':::'.$diguser.':::'.$cdom.'_'.$cnum; + $expected_sig = (split(/:::/,&get_service_id($secret,$uniqid)))[0]; + if ($expected_sig eq $sigrec) { + return 1; + } else { + $errors->{17} = 1; + } + } elsif ($context eq 'roster') { + my $uniqid = $digsymb.':::'.$cdom.'_'.$cnum; + $expected_sig = (split(/:::/,&get_service_id($secret,$uniqid)))[0]; + if ($expected_sig eq $sigrec) { + return 1; + } else { + $errors->{18} = 1; + } + } + } else { + $errors->{19} = 1; + } + } else { + $errors->{20} = 1; + } + return; +} + +# +# LON-CAPA as LTI Consumer +# # Sign a request used to launch an instance of an external # tool in a LON-CAPA course, using the key and secret supplied # by the Tool Provider. @@ -221,4 +343,270 @@ sub sign_params { return $request->to_hash(); } +# +# LON-CAPA as LTI Consumer +# +# Generate a signature for a unique identifier (roster request: +# ext_ims_lis_memberships_id, or grade store: lis_result_sourcedid) +# + +sub get_service_id { + my ($secret,$id) = @_; + my $sig = Digest::SHA::sha1_hex($secret.':::'.$id); + return $sig.':::'.$id; +} + +# +# LON-CAPA as LTI Consumer +# +# Generate and store the time-limited secret used to create the +# signature in a service request identifier (roster request or +# grade store). An existing secret past its expiration date +# will be stored as oldsecret, and a new secret +# secret will be stored. +# +# Secrets are specific to service name and to the tool instance +# (and are stored in the exttool_$marker db file). +# The time period a secret remains valid is determined by the +# domain configuration for the specific tool and the service. +# + +sub set_service_secret { + my ($cdom,$cnum,$marker,$name,$now,$toolsettings,$ltitools) = @_; + return unless ((ref($toolsettings) eq 'HASH') && (ref($ltitools) eq 'HASH')); + my $warning; + my ($needsnew,$oldsecret,$lifetime); + if ($name eq 'grade') { + $lifetime = $ltitools->{'passbackvalid'} + } elsif ($name eq 'roster') { + $lifetime = $ltitools->{'rostervalid'}; + } + if ($toolsettings->{$name} eq '') { + $needsnew = 1; + } elsif (($toolsettings->{$name.'date'} + $lifetime) < $now) { + $oldsecret = $toolsettings->{$name.'secret'}; + $needsnew = 1; + } + if ($needsnew) { + if (&get_tool_lock($cdom,$cnum,$marker,$name,$now) eq 'ok') { + my $secret = UUID::Tiny::create_uuid_as_string(UUID_V4); + $toolsettings->{$name.'secret'} = $secret; + my %secrethash = ( + $name.'secret' => $secret, + $name.'secretdate' => $now, + ); + if ($oldsecret ne '') { + $secrethash{'old'.$name.'secret'} = $oldsecret; + } + my $putres = &Apache::lonnet::put('exttool_'.$marker, + \%secrethash,$cdom,$cnum); + my $delresult = &release_tool_lock($cdom,$cnum,$marker,$name); + if ($delresult ne 'ok') { + $warning = $delresult ; + } + if ($putres eq 'ok') { + return 'ok'; + } + } else { + $warning = 'Could not obtain exclusive lock'; + } + } else { + return 'ok'; + } + return; +} + +# +# LON-CAPA as LTI Consumer +# +# Add a lock key to exttools.db for the instance of an external tool +# when generating and storing a service secret. +# + +sub get_tool_lock { + my ($cdom,$cnum,$marker,$name,$now) = @_; + # get lock for tool for which secret is being set + my $lockhash = { + $name."\0".$marker."\0".'lock' => $now.':'.$env{'user.name'}. + ':'.$env{'user.domain'}, + }; + my $tries = 0; + my $gotlock = &Apache::lonnet::newput('exttools',$lockhash,$cdom,$cnum); + + while (($gotlock ne 'ok') && $tries <3) { + $tries ++; + sleep(1); + $gotlock = &Apache::lonnet::newput('exttools',$lockhash,$cdom,$cnum); + } + return $gotlock; +} + +# +# LON-CAPA as LTI Consumer +# +# Remove a lock key from exttools.db for the instance of an external +# tool created when generating and storing a service secret. +# + +sub release_tool_lock { + my ($cdom,$cnum,$marker,$name) = @_; + # remove lock + my @del_lock = ($name."\0".$marker."\0".'lock'); + my $dellockoutcome=&Apache::lonnet::del('exttools',\@del_lock,$cdom,$cnum); + if ($dellockoutcome ne 'ok') { + return 'Warning: failed to release lock for exttool'; + } else { + return 'ok'; + } +} + +# +# LON-CAPA as LTI Provider +# +# Use the part of the launch URL after /adm/lti to determine +# the scope for the current session (i.e., restricted to a +# single resource, to a single folder/map, or to an entire +# course). +# +# Returns an array containing scope: resource, map, or course +# and the LON-CAPA URL that is displayed post-launch, including +# accommodation of URL encryption, and translation of a tiny URL +# to the actual URL +# + +sub lti_provider_scope { + my ($tail,$cdom,$cnum,$getunenc) = @_; + my ($scope,$realuri,$passkey,$unencsymb); + if ($tail =~ m{^/?uploaded/$cdom/$cnum/(?:default|supplemental)(?:|_\d+)\.(?:sequence|page)(|___\d+___.+)$}) { + my $rest = $1; + if ($rest eq '') { + $scope = 'map'; + $realuri = $tail; + } else { + my ($map,$resid,$url) = &Apache::lonnet::decode_symb($tail); + $realuri = &Apache::lonnet::clutter($url); + if ($url =~ /\.sequence$/) { + $scope = 'map'; + } else { + $scope = 'resource'; + $realuri .= '?symb='.$tail; + $passkey = $tail; + if ($getunenc) { + $unencsymb = $tail; + } + } + } + } elsif ($tail =~ m{^/?res/$match_domain/$match_username/.+\.(?:sequence|page)(|___\d+___.+)$}) { + my $rest = $1; + if ($rest eq '') { + $scope = 'map'; + $realuri = $tail; + } else { + my ($map,$resid,$url) = &Apache::lonnet::decode_symb($tail); + $realuri = &Apache::lonnet::clutter($url); + if ($url =~ /\.sequence$/) { + $scope = 'map'; + } else { + $scope = 'resource'; + $realuri .= '?symb='.$tail; + $passkey = $tail; + if ($getunenc) { + $unencsymb = $tail; + } + } + } + } elsif ($tail =~ m{^/tiny/$cdom/(\w+)$}) { + my $key = $1; + my $tinyurl; + my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key); + if (defined($cached)) { + $tinyurl = $result; + } else { + my $configuname = &Apache::lonnet::get_domainconfiguser($cdom); + my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname); + if ($currtiny{$key} ne '') { + $tinyurl = $currtiny{$key}; + &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600); + } + } + if ($tinyurl ne '') { + my ($cnum,$symb) = split(/\&/,$tinyurl,2); + my ($map,$resid,$url) = &Apache::lonnet::decode_symb($symb); + if ($url =~ /\.(page|sequence)$/) { + $scope = 'map'; + } else { + $scope = 'resource'; + } + $passkey = $symb; + if ((&Apache::lonnet::EXT('resource.0.encrypturl',$symb) =~ /^yes$/i) && + (!$env{'request.role.adv'})) { + $realuri = &Apache::lonenc::encrypted(&Apache::lonnet::clutter($url)); + if ($scope eq 'resource') { + $realuri .= '?symb='.&Apache::lonenc::encrypted($symb); + } + } else { + $realuri = &Apache::lonnet::clutter($url); + if ($scope eq 'resource') { + $realuri .= '?symb='.$symb; + } + } + if ($getunenc) { + $unencsymb = $symb; + } + } + } elsif (($tail =~ m{^/$cdom/$cnum$}) || ($tail eq '')) { + $scope = 'course'; + $realuri = '/adm/navmaps'; + $passkey = $tail; + } + if ($scope eq 'map') { + $passkey = $realuri; + } + if (wantarray) { + return ($scope,$realuri,$unencsymb); + } else { + return $passkey; + } +} + +sub send_grade { + my ($id,$url,$ckey,$secret,$scoretype,$total,$possible) = @_; + my $score; + if ($possible > 0) { + if ($scoretype eq 'ratio') { + $score = Math::Round::round($total).'/'.Math::Round::round($possible); + } elsif ($scoretype eq 'percentage') { + $score = (100.0*$total)/$possible; + $score = Math::Round::round($score); + } else { + $score = $total/$possible; + $score = sprintf("%.2f",$score); + } + } + my $date = &Apache::loncommon::utc_string(time); + my %ltiparams = ( + lti_version => 'LTI-1p0', + lti_message_type => 'basic-lis-updateresult', + sourcedid => $id, + result_resultscore_textstring => $score, + result_resultscore_language => 'en-US', + result_resultvaluesourcedid => $scoretype, + result_statusofresult => 'final', + result_date => $date, + ); + my $hashref = &sign_params($url,$ckey,$secret,\%ltiparams); + if (ref($hashref) eq 'HASH') { + my $request=new HTTP::Request('POST',$url); + $request->content(join('&',map { + my $name = escape($_); + "$name=" . ( ref($hashref->{$_}) eq 'ARRAY' + ? join("&$name=", map {escape($_) } @{$hashref->{$_}}) + : &escape($hashref->{$_}) ); + } keys(%{$hashref}))); + my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10); + my $message=$response->status_line; +#FIXME Handle case where pass back of score to LTI Consumer failed. + } +} + 1;