--- loncom/lti/ltiutils.pm 2017/12/07 15:36:25 1.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.1 2017/12/07 15:36:25 raeburn Exp $ +# $Id: ltiutils.pm,v 1.10 2018/05/15 04:59:22 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -34,6 +34,7 @@ use Digest::SHA; use UUID::Tiny ':std'; use Apache::lonnet; use Apache::loncommon; +use Math::Round(); use LONCAPA qw(:DEFAULT :match); # @@ -51,7 +52,7 @@ use LONCAPA qw(:DEFAULT :match); # # 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: +# Consumer) launches an external tool to access a LON-CAPA URL: # /adm/lti/ with LON-CAPA symb, map, or deep-link ID appended. # @@ -286,26 +287,26 @@ sub verify_lis_item { my $expected_sig; if ($context eq 'grade') { my $uniqid = $digsymb.':::'.$diguser.':::'.$cdom.'_'.$cnum; - $expected_sig = &get_service_id($secret,$uniqid); + $expected_sig = (split(/:::/,&get_service_id($secret,$uniqid)))[0]; if ($expected_sig eq $sigrec) { return 1; } else { - $errors->{16} = 1; + $errors->{17} = 1; } } elsif ($context eq 'roster') { my $uniqid = $digsymb.':::'.$cdom.'_'.$cnum; - $expected_sig = &get_service_id($secret,$uniqid); + $expected_sig = (split(/:::/,&get_service_id($secret,$uniqid)))[0]; if ($expected_sig eq $sigrec) { return 1; } else { - $errors->{17} = 1; + $errors->{18} = 1; } } } else { - $errors->{18} = 1; + $errors->{19} = 1; } } else { - $errors->{19} = 1; + $errors->{20} = 1; } return; } @@ -314,20 +315,24 @@ sub verify_lis_item { # LON-CAPA as LTI Consumer # # Sign a request used to launch an instance of an external -# too in a LON-CAPA course, using the key and secret supplied +# tool in a LON-CAPA course, using the key and secret supplied # by the Tool Provider. # sub sign_params { - my ($url,$key,$secret,$paramsref) = @_; + my ($url,$key,$secret,$sigmethod,$paramsref) = @_; return unless (ref($paramsref) eq 'HASH'); + if ($sigmethod eq '') { + $sigmethod = 'HMAC-SHA1'; + } + srand( time() ^ ($$ + ($$ << 15)) ); # Seed rand. my $nonce = Digest::SHA::sha1_hex(sprintf("%06x%06x",rand(0xfffff0),rand(0xfffff0))); my $request = Net::OAuth->request("request token")->new( consumer_key => $key, consumer_secret => $secret, request_url => $url, request_method => 'POST', - signature_method => 'HMAC-SHA1', + signature_method => $sigmethod, timestamp => time, nonce => $nonce, callback => 'about:blank', @@ -444,7 +449,7 @@ sub get_tool_lock { # sub release_tool_lock { - my ($cdom,$cnum,$marker) = @_; + 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); @@ -455,4 +460,153 @@ sub release_tool_lock { } } +# +# 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;