version 1.14, 2018/08/14 17:24:21
|
version 1.19, 2023/06/02 01:20:28
|
Line 31 package LONCAPA::ltiutils;
|
Line 31 package LONCAPA::ltiutils;
|
use strict; |
use strict; |
use Net::OAuth; |
use Net::OAuth; |
use Digest::SHA; |
use Digest::SHA; |
|
use Digest::MD5 qw(md5_hex); |
|
use Encode; |
use UUID::Tiny ':std'; |
use UUID::Tiny ':std'; |
use Apache::lonnet; |
use Apache::lonnet; |
use Apache::loncommon; |
use Apache::loncommon; |
Line 40 use Apache::lonenc();
|
Line 42 use Apache::lonenc();
|
use Apache::longroup(); |
use Apache::longroup(); |
use Apache::lonlocal; |
use Apache::lonlocal; |
use Math::Round(); |
use Math::Round(); |
|
use LONCAPA::Lond; |
use LONCAPA qw(:DEFAULT :match); |
use LONCAPA qw(:DEFAULT :match); |
|
|
# |
# |
Line 208 sub get_tool_secret {
|
Line 211 sub get_tool_secret {
|
%{$toolsettings}=&Apache::lonnet::dump('exttool_'.$marker,$cdom,$cnum); |
%{$toolsettings}=&Apache::lonnet::dump('exttool_'.$marker,$cdom,$cnum); |
if ($toolsettings->{'id'}) { |
if ($toolsettings->{'id'}) { |
my $idx = $toolsettings->{'id'}; |
my $idx = $toolsettings->{'id'}; |
my %lti = &Apache::lonnet::get_domain_lti($cdom,'consumer'); |
my ($crsdef,$ltinum); |
if (ref($lti{$idx}) eq 'HASH') { |
if ($idx =~ /^c(\d+)$/) { |
%{$ltitools} = %{$lti{$idx}}; |
$ltinum = $1; |
if ($ltitools->{'key'} eq $key) { |
$crsdef = 1; |
$consumer_secret = $ltitools->{'secret'}; |
my %crslti = &Apache::lonnet::get_course_lti($cnum,$cdom,'consumer'); |
|
if (ref($crslti{$ltinum}) eq 'HASH') { |
|
%{$ltitools} = %{$crslti{$ltinum}}; |
|
} else { |
|
undef($ltinum); |
|
} |
|
} elsif ($idx =~ /^\d+$/) { |
|
my %lti = &Apache::lonnet::get_domain_lti($cdom,'consumer'); |
|
if (ref($lti{$idx}) eq 'HASH') { |
|
%{$ltitools} = %{$lti{$idx}}; |
|
$ltinum = $idx; |
|
} |
|
} |
|
if ($ltinum ne '') { |
|
my $loncaparev = &Apache::lonnet::get_server_loncaparev($cdom); |
|
my $keynum = $ltitools->{'cipher'}; |
|
my ($poss_key,$poss_secret) = |
|
&LONCAPA::Lond::get_lti_credentials($cdom,$cnum,$crsdef,'tools',$ltinum,$keynum,$loncaparev); |
|
if ($poss_key eq $key) { |
|
$consumer_secret = $poss_secret; |
$nonce_lifetime = $ltitools->{'lifetime'}; |
$nonce_lifetime = $ltitools->{'lifetime'}; |
} else { |
} else { |
$errors->{11} = 1; |
$errors->{11} = 1; |
Line 240 sub get_tool_secret {
|
Line 262 sub get_tool_secret {
|
# secret for the specific LTI Provider. |
# secret for the specific LTI Provider. |
# |
# |
|
|
|
# FIXME Move to Lond.pm and perform on course's homeserver |
|
|
sub verify_request { |
sub verify_request { |
my ($params,$protocol,$hostname,$requri,$reqmethod,$consumer_secret,$errors) = @_; |
my ($oauthtype,$protocol,$hostname,$requri,$reqmethod,$consumer_secret,$params, |
return unless (ref($errors) eq 'HASH'); |
$authheaders,$errors) = @_; |
my $request = Net::OAuth->request('request token')->from_hash($params, |
unless (ref($errors) eq 'HASH') { |
request_url => $protocol.'://'.$hostname.$requri, |
$errors->{15} = 1; |
request_method => $reqmethod, |
return; |
consumer_secret => $consumer_secret,); |
} |
|
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()) { |
unless ($request->verify()) { |
$errors->{15} = 1; |
$errors->{15} = 1; |
return; |
return; |
Line 296 sub verify_lis_item {
|
Line 334 sub verify_lis_item {
|
if ($expected_sig eq $sigrec) { |
if ($expected_sig eq $sigrec) { |
return 1; |
return 1; |
} else { |
} else { |
$errors->{17} = 1; |
$errors->{18} = 1; |
} |
} |
} elsif ($context eq 'roster') { |
} elsif ($context eq 'roster') { |
my $uniqid = $digsymb.':::'.$cdom.'_'.$cnum; |
my $uniqid = $digsymb.':::'.$cdom.'_'.$cnum; |
Line 304 sub verify_lis_item {
|
Line 342 sub verify_lis_item {
|
if ($expected_sig eq $sigrec) { |
if ($expected_sig eq $sigrec) { |
return 1; |
return 1; |
} else { |
} else { |
$errors->{18} = 1; |
$errors->{19} = 1; |
} |
} |
} |
} |
} else { |
} else { |
$errors->{19} = 1; |
$errors->{20} = 1; |
} |
} |
} else { |
} else { |
$errors->{20} = 1; |
$errors->{21} = 1; |
} |
} |
return; |
return; |
} |
} |
Line 325 sub verify_lis_item {
|
Line 363 sub verify_lis_item {
|
# |
# |
|
|
sub sign_params { |
sub sign_params { |
my ($url,$key,$secret,$sigmethod,$paramsref) = @_; |
my ($url,$key,$secret,$paramsref,$sigmethod,$type,$callback,$post) = @_; |
return unless (ref($paramsref) eq 'HASH'); |
return unless (ref($paramsref) eq 'HASH'); |
if ($sigmethod eq '') { |
if ($sigmethod eq '') { |
$sigmethod = 'HMAC-SHA1'; |
$sigmethod = 'HMAC-SHA1'; |
} |
} |
|
if ($type eq '') { |
|
$type = 'request token'; |
|
} |
|
if ($callback eq '') { |
|
$callback = 'about:blank', |
|
} |
srand( time() ^ ($$ + ($$ << 15)) ); # Seed rand. |
srand( time() ^ ($$ + ($$ << 15)) ); # Seed rand. |
my $nonce = Digest::SHA::sha1_hex(sprintf("%06x%06x",rand(0xfffff0),rand(0xfffff0))); |
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_key => $key, |
consumer_secret => $secret, |
consumer_secret => $secret, |
request_url => $url, |
request_url => $url, |
Line 340 sub sign_params {
|
Line 384 sub sign_params {
|
signature_method => $sigmethod, |
signature_method => $sigmethod, |
timestamp => time, |
timestamp => time, |
nonce => $nonce, |
nonce => $nonce, |
callback => 'about:blank', |
callback => $callback, |
extra_params => $paramsref, |
extra_params => $paramsref, |
version => '1.0', |
version => '1.0', |
); |
); |
$request->sign; |
$request->sign(); |
return $request->to_hash(); |
if ($post) { |
|
return $request->to_post_body(); |
|
} else { |
|
return $request->to_hash(); |
|
} |
} |
} |
|
|
# |
# |
Line 466 sub release_tool_lock {
|
Line 514 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 |
# LON-CAPA as LTI Provider |
# |
# |
# Use the part of the launch URL after /adm/lti to determine |
# Use the part of the launch URL after /adm/lti to determine |
Line 586 sub lti_provider_scope {
|
Line 675 sub lti_provider_scope {
|
# |
# |
|
|
sub get_roster { |
sub get_roster { |
my ($id,$url,$ckey,$secret) = @_; |
my ($cdom,$cnum,$ltinum,$keynum,$id,$url) = @_; |
my %ltiparams = ( |
my %ltiparams = ( |
lti_version => 'LTI-1p0', |
lti_version => 'LTI-1p0', |
lti_message_type => 'basic-lis-readmembershipsforcontext', |
lti_message_type => 'basic-lis-readmembershipsforcontext', |
ext_ims_lis_memberships_id => $id, |
ext_ims_lis_memberships_id => $id, |
); |
); |
my $hashref = &sign_params($url,$ckey,$secret,'',\%ltiparams); |
my %info = (); |
if (ref($hashref) eq 'HASH') { |
my ($status,$hashref) = |
|
&Apache::lonnet::sign_lti($cdom,$cnum,'','lti','roster',$url,$ltinum,$keynum,\%ltiparams,\%info); |
|
if (($status eq 'ok') && (ref($hashref) eq 'HASH')) { |
my $request=new HTTP::Request('POST',$url); |
my $request=new HTTP::Request('POST',$url); |
$request->content(join('&',map { |
$request->content(join('&',map { |
my $name = escape($_); |
my $name = escape($_); |
Line 651 sub get_roster {
|
Line 742 sub get_roster {
|
# |
# |
|
|
sub send_grade { |
sub send_grade { |
my ($id,$url,$ckey,$secret,$scoretype,$total,$possible) = @_; |
my ($cdom,$cnum,$crsdef,$type,$ltinum,$keynum,$id,$url,$scoretype,$sigmethod,$msgformat,$total,$possible) = @_; |
my $score; |
my $score; |
if ($possible > 0) { |
if ($possible > 0) { |
if ($scoretype eq 'ratio') { |
if ($scoretype eq 'ratio') { |
Line 664 sub send_grade {
|
Line 755 sub send_grade {
|
$score = sprintf("%.2f",$score); |
$score = sprintf("%.2f",$score); |
} |
} |
} |
} |
my $date = &Apache::loncommon::utc_string(time); |
if ($sigmethod eq '') { |
my %ltiparams = ( |
$sigmethod = 'HMAC-SHA1'; |
lti_version => 'LTI-1p0', |
} |
lti_message_type => 'basic-lis-updateresult', |
my $request; |
sourcedid => $id, |
if ($msgformat eq '1.0') { |
result_resultscore_textstring => $score, |
my $date = &Apache::loncommon::utc_string(time); |
result_resultscore_language => 'en-US', |
my %ltiparams = ( |
result_resultvaluesourcedid => $scoretype, |
lti_version => 'LTI-1p0', |
result_statusofresult => 'final', |
lti_message_type => 'basic-lis-updateresult', |
result_date => $date, |
sourcedid => $id, |
); |
result_resultscore_textstring => $score, |
my $hashref = &sign_params($url,$ckey,$secret,'',\%ltiparams); |
result_resultscore_language => 'en-US', |
if (ref($hashref) eq 'HASH') { |
result_resultvaluesourcedid => $scoretype, |
my $request=new HTTP::Request('POST',$url); |
result_statusofresult => 'final', |
$request->content(join('&',map { |
result_date => $date, |
my $name = escape($_); |
); |
"$name=" . ( ref($hashref->{$_}) eq 'ARRAY' |
my %info = ( |
? join("&$name=", map {escape($_) } @{$hashref->{$_}}) |
method => $sigmethod, |
: &escape($hashref->{$_}) ); |
); |
} keys(%{$hashref}))); |
my ($status,$hashref) = |
my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10); |
&Apache::lonnet::sign_lti($cdom,$cnum,$crsdef,$type,'grade',$url,$ltinum,$keynum, |
my $message=$response->status_line; |
\%ltiparams,\%info); |
|
if (($status eq 'ok') && (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}))); |
|
#FIXME Need to handle case where passback failed. |
|
} |
|
} else { |
|
srand( time() ^ ($$ + ($$ << 15)) ); # Seed rand. |
|
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 $reqmethod = 'POST'; |
|
my %info = ( |
|
body_hash => $bodyhash, |
|
method => $sigmethod, |
|
reqtype => 'consumer', |
|
reqmethod => $reqmethod, |
|
respfmt => 'to_authorization_header', |
|
); |
|
my %params; |
|
my ($status,$authheader) = |
|
&Apache::lonnet::sign_lti($cdom,$cnum,$crsdef,$type,'grade',$url,$ltinum,$keynum,\%params,\%info); |
|
if (($status eq 'ok') && ($authheader ne '')) { |
|
$request = HTTP::Request->new( |
|
$reqmethod, |
|
$url, |
|
[ |
|
'Authorization' => $authheader, |
|
'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. |
#FIXME Handle case where pass back of score to LTI Consumer failed. |
|
} |
} |
} |
} |
} |
|
|
|
sub setup_logout_callback { |
|
my ($cdom,$cnum,$crstool,$idx,$keynum,$uname,$udom,$server,$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 %info = ( |
|
respfmt => 'to_post_body', |
|
); |
|
my ($status,$post) = |
|
&Apache::lonnet::sign_lti($cdom,$cnum,$crstool,'lti','logout',$service_url,$idx, |
|
$keynum,\%ltiparams,\%info); |
|
if (($status eq 'ok') && ($post ne '')) { |
|
my $request=new HTTP::Request('POST',$service_url); |
|
$request->content($post); |
|
my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10); |
|
} |
|
} |
|
} |
|
return; |
|
} |
|
|
# |
# |
# LON-CAPA as LTI Provider |
# LON-CAPA as LTI Provider |
# |
# |
Line 915 sub enrolluser {
|
Line 1102 sub enrolluser {
|
|
|
sub batchaddroster { |
sub batchaddroster { |
my ($item) = @_; |
my ($item) = @_; |
return unless(ref($item) eq 'HASH'); |
return unless((ref($item) eq 'HASH') && |
return unless (ref($item->{'ltiref'}) eq 'HASH'); |
(ref($item->{'ltiref'}) eq 'HASH')); |
my ($cdom,$cnum) = split(/_/,$item->{'cid'}); |
my ($cdom,$cnum) = split(/_/,$item->{'cid'}); |
|
return if (($cdom eq '') || ($cnum eq '')); |
my $udom = $cdom; |
my $udom = $cdom; |
my $id = $item->{'id'}; |
my $id = $item->{'id'}; |
my $url = $item->{'url'}; |
my $url = $item->{'url'}; |
|
my $ltinum = $item->{'lti'}; |
|
my $keynum = $item->{'ltiref'}->{'cipher'}; |
my @intdoms; |
my @intdoms; |
my $intdomsref = $item->{'intdoms'}; |
my $intdomsref = $item->{'intdoms'}; |
if (ref($intdomsref) eq 'ARRAY') { |
if (ref($intdomsref) eq 'ARRAY') { |
@intdoms = @{$intdomsref}; |
@intdoms = @{$intdomsref}; |
} |
} |
my $uriscope = $item->{'uriscope'}; |
my $uriscope = $item->{'uriscope'}; |
my $ckey = $item->{'ltiref'}->{'key'}; |
|
my $secret = $item->{'ltiref'}->{'secret'}; |
|
my $section = $item->{'ltiref'}->{'section'}; |
my $section = $item->{'ltiref'}->{'section'}; |
$section =~ s/\W//g; |
$section =~ s/\W//g; |
if ($section eq 'none') { |
if ($section eq 'none') { |
Line 947 sub batchaddroster {
|
Line 1135 sub batchaddroster {
|
if (ref($item->{'possroles'}) eq 'ARRAY') { |
if (ref($item->{'possroles'}) eq 'ARRAY') { |
@possroles = @{$item->{'possroles'}}; |
@possroles = @{$item->{'possroles'}}; |
} |
} |
if (($ckey ne '') && ($secret ne '') && ($id ne '') && ($url ne '')) { |
if (($id ne '') && ($url ne '')) { |
my %data = &get_roster($id,$url,$ckey,$secret); |
my %data = &get_roster($cdom,$cnum,$ltinum,$keynum,$id,$url); |
if (keys(%data) > 0) { |
if (keys(%data) > 0) { |
my (%rulematch,%inst_results,%curr_rules,%got_rules,%alerts,%info); |
my (%rulematch,%inst_results,%curr_rules,%got_rules,%alerts,%info); |
my %coursehash = &Apache::lonnet::coursedescription($cdom.'_'.$cnum); |
my %coursehash = &Apache::lonnet::coursedescription($cdom.'_'.$cnum); |