--- loncom/lti/ltiutils.pm 2018/08/12 02:24:42 1.13
+++ loncom/lti/ltiutils.pm 2022/03/29 20:12:46 1.18
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Utility functions for managing LON-CAPA LTI interactions
#
-# $Id: ltiutils.pm,v 1.13 2018/08/12 02:24:42 raeburn Exp $
+# $Id: ltiutils.pm,v 1.18 2022/03/29 20:12:46 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -31,6 +31,8 @@ package LONCAPA::ltiutils;
use strict;
use Net::OAuth;
use Digest::SHA;
+use Digest::MD5 qw(md5_hex);
+use Encode;
use UUID::Tiny ':std';
use Apache::lonnet;
use Apache::loncommon;
@@ -241,12 +243,26 @@ sub get_tool_secret {
#
sub verify_request {
- my ($params,$protocol,$hostname,$requri,$reqmethod,$consumer_secret,$errors) = @_;
- return unless (ref($errors) eq 'HASH');
- my $request = Net::OAuth->request('request token')->from_hash($params,
- request_url => $protocol.'://'.$hostname.$requri,
- request_method => $reqmethod,
- consumer_secret => $consumer_secret,);
+ my ($oauthtype,$protocol,$hostname,$requri,$reqmethod,$consumer_secret,$params,
+ $authheaders,$errors) = @_;
+ unless (ref($errors) eq 'HASH') {
+ $errors->{15} = 1;
+ return;
+ }
+ my $request;
+ if ($oauthtype eq 'consumer') {
+ my $oauthreq = Net::OAuth->request('consumer');
+ $oauthreq->add_required_message_params('body_hash');
+ $request = $oauthreq->from_authorization_header($authheaders,
+ request_url => $protocol.'://'.$hostname.$requri,
+ request_method => $reqmethod,
+ consumer_secret => $consumer_secret,);
+ } else {
+ $request = Net::OAuth->request('request token')->from_hash($params,
+ request_url => $protocol.'://'.$hostname.$requri,
+ request_method => $reqmethod,
+ consumer_secret => $consumer_secret,);
+ }
unless ($request->verify()) {
$errors->{15} = 1;
return;
@@ -276,7 +292,7 @@ sub verify_lis_item {
my ($has_action, $valid_for);
if ($context eq 'grade') {
$has_action = $ltitools->{'passback'};
- $valid_for = $ltitools->{'passbackvalid'}
+ $valid_for = $ltitools->{'passbackvalid'} * 86400; # convert days to seconds
} elsif ($context eq 'roster') {
$has_action = $ltitools->{'roster'};
$valid_for = $ltitools->{'rostervalid'};
@@ -296,7 +312,7 @@ sub verify_lis_item {
if ($expected_sig eq $sigrec) {
return 1;
} else {
- $errors->{17} = 1;
+ $errors->{18} = 1;
}
} elsif ($context eq 'roster') {
my $uniqid = $digsymb.':::'.$cdom.'_'.$cnum;
@@ -304,14 +320,14 @@ sub verify_lis_item {
if ($expected_sig eq $sigrec) {
return 1;
} else {
- $errors->{18} = 1;
+ $errors->{19} = 1;
}
}
} else {
- $errors->{19} = 1;
+ $errors->{20} = 1;
}
} else {
- $errors->{20} = 1;
+ $errors->{21} = 1;
}
return;
}
@@ -325,14 +341,20 @@ sub verify_lis_item {
#
sub sign_params {
- my ($url,$key,$secret,$sigmethod,$paramsref) = @_;
+ my ($url,$key,$secret,$paramsref,$sigmethod,$type,$callback,$post) = @_;
return unless (ref($paramsref) eq 'HASH');
if ($sigmethod eq '') {
$sigmethod = 'HMAC-SHA1';
}
+ if ($type eq '') {
+ $type = 'request token';
+ }
+ if ($callback eq '') {
+ $callback = 'about:blank',
+ }
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(
+ my $request = Net::OAuth->request($type)->new(
consumer_key => $key,
consumer_secret => $secret,
request_url => $url,
@@ -340,12 +362,16 @@ sub sign_params {
signature_method => $sigmethod,
timestamp => time,
nonce => $nonce,
- callback => 'about:blank',
+ callback => $callback,
extra_params => $paramsref,
version => '1.0',
);
- $request->sign;
- return $request->to_hash();
+ $request->sign();
+ if ($post) {
+ return $request->to_post_body();
+ } else {
+ return $request->to_hash();
+ }
}
#
@@ -382,13 +408,13 @@ sub set_service_secret {
my $warning;
my ($needsnew,$oldsecret,$lifetime);
if ($name eq 'grade') {
- $lifetime = $ltitools->{'passbackvalid'}
+ $lifetime = $ltitools->{'passbackvalid'} * 86400; # convert days to seconds
} elsif ($name eq 'roster') {
$lifetime = $ltitools->{'rostervalid'};
}
- if ($toolsettings->{$name} eq '') {
+ if ($toolsettings->{$name.'secret'} eq '') {
$needsnew = 1;
- } elsif (($toolsettings->{$name.'date'} + $lifetime) < $now) {
+ } elsif (($toolsettings->{$name.'secretdate'} + $lifetime) < $now) {
$oldsecret = $toolsettings->{$name.'secret'};
$needsnew = 1;
}
@@ -466,6 +492,47 @@ sub release_tool_lock {
}
#
+# LON-CAPA as LTI Consumer
+#
+# Parse XML containing grade data sent by an LTI Provider
+#
+
+sub parse_grade_xml {
+ my ($xml) = @_;
+ my %data = ();
+ my $count = 0;
+ my @state = ();
+ my $p = HTML::Parser->new(
+ xml_mode => 1,
+ start_h =>
+ [sub {
+ my ($tagname, $attr) = @_;
+ push(@state,$tagname);
+ if ("@state" eq "imsx_POXEnvelopeRequest imsx_POXBody replaceResultRequest resultRecord") {
+ $count ++;
+ }
+ }, "tagname, attr"],
+ text_h =>
+ [sub {
+ my ($text) = @_;
+ if ("@state" eq "imsx_POXEnvelopeRequest imsx_POXBody replaceResultRequest resultRecord sourcedGUID sourcedId") {
+ $data{$count}{sourcedid} = $text;
+ } elsif ("@state" eq "imsx_POXEnvelopeRequest imsx_POXBody replaceResultRequest resultRecord result resultScore textString") {
+ $data{$count}{score} = $text;
+ }
+ }, "dtext"],
+ end_h =>
+ [sub {
+ my ($tagname) = @_;
+ pop @state;
+ }, "tagname"],
+ );
+ $p->parse($xml);
+ $p->eof;
+ return %data;
+}
+
+#
# LON-CAPA as LTI Provider
#
# Use the part of the launch URL after /adm/lti to determine
@@ -592,7 +659,7 @@ sub get_roster {
lti_message_type => 'basic-lis-readmembershipsforcontext',
ext_ims_lis_memberships_id => $id,
);
- my $hashref = &sign_params($url,$ckey,$secret,'',\%ltiparams);
+ my $hashref = &sign_params($url,$ckey,$secret,\%ltiparams);
if (ref($hashref) eq 'HASH') {
my $request=new HTTP::Request('POST',$url);
$request->content(join('&',map {
@@ -651,7 +718,7 @@ sub get_roster {
#
sub send_grade {
- my ($id,$url,$ckey,$secret,$scoretype,$total,$possible) = @_;
+ my ($id,$url,$ckey,$secret,$scoretype,$sigmethod,$msgformat,$total,$possible) = @_;
my $score;
if ($possible > 0) {
if ($scoretype eq 'ratio') {
@@ -664,30 +731,114 @@ sub send_grade {
$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;
+ if ($sigmethod eq '') {
+ $sigmethod = 'HMAC-SHA1';
+ }
+ my $request;
+ if ($msgformat eq '1.0') {
+ 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,$sigmethod);
+ if (ref($hashref) eq 'HASH') {
+ $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})));
+ }
+ } else {
+ srand( time() ^ ($$ + ($$ << 15)) ); # Seed rand.
+ my $nonce = Digest::SHA::sha1_hex(sprintf("%06x%06x",rand(0xfffff0),rand(0xfffff0)));
+ my $uniqmsgid = int(rand(2**32));
+ my $gradexml = <<END;
+<?xml version = "1.0" encoding = "UTF-8"?>
+<imsx_POXEnvelopeRequest xmlns = "http://www.imsglobal.org/services/ltiv1p1/xsd/imsoms_v1p0">
+ <imsx_POXHeader>
+ <imsx_POXRequestHeaderInfo>
+ <imsx_version>V1.0</imsx_version>
+ <imsx_messageIdentifier>$uniqmsgid</imsx_messageIdentifier>
+ </imsx_POXRequestHeaderInfo>
+ </imsx_POXHeader>
+ <imsx_POXBody>
+ <replaceResultRequest>
+ <resultRecord>
+ <sourcedGUID>
+ <sourcedId>$id</sourcedId>
+ </sourcedGUID>
+ <result>
+ <resultScore>
+ <language>en</language>
+ <textString>$score</textString>
+ </resultScore>
+ </result>
+ </resultRecord>
+ </replaceResultRequest>
+ </imsx_POXBody>
+</imsx_POXEnvelopeRequest>
+END
+ chomp($gradexml);
+ my $bodyhash = Digest::SHA::sha1_base64($gradexml);
+ while (length($bodyhash) % 4) {
+ $bodyhash .= '=';
+ }
+ my $gradereq = Net::OAuth->request('consumer')->new(
+ consumer_key => $ckey,
+ consumer_secret => $secret,
+ request_url => $url,
+ request_method => 'POST',
+ signature_method => $sigmethod,
+ timestamp => time(),
+ nonce => $nonce,
+ body_hash => $bodyhash,
+ );
+ $gradereq->add_required_message_params('body_hash');
+ $gradereq->sign();
+ $request = HTTP::Request->new(
+ $gradereq->request_method,
+ $gradereq->request_url,
+ [
+ 'Authorization' => $gradereq->to_authorization_header,
+ 'Content-Type' => 'application/xml',
+ ],
+ $gradexml,
+ );
+ }
+ my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10);
+ my $message=$response->status_line;
#FIXME Handle case where pass back of score to LTI Consumer failed.
+}
+
+sub setup_logout_callback {
+ my ($uname,$udom,$server,$ckey,$secret,$service_url,$idsdir,$protocol,$hostname) = @_;
+ if ($service_url =~ m{^https?://[^/]+/}) {
+ my $digest_user = &Encode::decode('UTF-8',$uname.':'.$udom);
+ my $loginfile = &Digest::SHA::sha1_hex($digest_user).&md5_hex(&md5_hex(time.{}.rand().$$));
+ if ((-d $idsdir) && (open(my $fh,'>',"$idsdir/$loginfile"))) {
+ print $fh "$uname,$udom,$server\n";
+ close($fh);
+ my $callback = 'http://'.$hostname.'/adm/service/logout/'.$loginfile;
+ my %ltiparams = (
+ callback => $callback,
+ );
+ my $post = &sign_params($service_url,$ckey,$secret,\%ltiparams,
+ '','','',1);
+ my $request=new HTTP::Request('POST',$service_url);
+ $request->content($post);
+ my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10);
+ }
}
+ return;
}
#