--- loncom/lti/ltiutils.pm 2018/08/14 21:42:36 1.15
+++ loncom/lti/ltiutils.pm 2024/11/21 07:26:04 1.22
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
-# Utility functions for managing LON-CAPA LTI interactions
+# Utility functions for managing LON-CAPA LTI interactions
#
-# $Id: ltiutils.pm,v 1.15 2018/08/14 21:42:36 raeburn Exp $
+# $Id: ltiutils.pm,v 1.22 2024/11/21 07:26:04 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -31,7 +31,10 @@ package LONCAPA::ltiutils;
use strict;
use Net::OAuth;
use Digest::SHA;
+use Digest::MD5 qw(md5_hex);
+use Encode;
use UUID::Tiny ':std';
+use HTTP::Status;
use Apache::lonnet;
use Apache::loncommon;
use Apache::loncoursedata;
@@ -40,6 +43,7 @@ use Apache::lonenc();
use Apache::longroup();
use Apache::lonlocal;
use Math::Round();
+use LONCAPA::Lond;
use LONCAPA qw(:DEFAULT :match);
#
@@ -51,13 +55,13 @@ use LONCAPA qw(:DEFAULT :match);
# When LON-CAPA is operating as a Consumer, nonce checking
# occurs when a Tool Provider launched from an instance of
# an external tool in a LON-CAPA course makes a request to
-# (a) /adm/service/roster or (b) /adm/service/passback to,
-# respectively, retrieve a roster or store the grade for
+# (a) /adm/service/roster or (b) /adm/service/passback to,
+# 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:
+# 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.
#
@@ -95,8 +99,8 @@ sub check_nonce {
# LON-CAPA as LTI Consumer
#
# Determine the domain and the courseID of the LON-CAPA course
-# for which access is needed by a Tool Provider -- either to
-# retrieve a roster or store the grade for an instance of an
+# for which access is needed by a Tool Provider -- either to
+# retrieve a roster or store the grade for an instance of an
# external tool in the course.
#
@@ -141,8 +145,8 @@ sub get_loncapa_course {
#
# LON-CAPA as LTI Consumer
#
-# Determine the symb and (optionally) LON-CAPA user for an
-# instance of an external tool in a course -- either to
+# Determine the symb and (optionally) LON-CAPA user for an
+# instance of an external tool in a course -- either to
# to retrieve a roster or store a grade.
#
# Use the digested symb to lookup the real symb in exttools.db
@@ -154,7 +158,7 @@ sub get_tool_instance {
my ($cdom,$cnum,$digsymb,$diguser,$errors) = @_;
return unless (ref($errors) eq 'HASH');
my ($marker,$symb,$uname,$udom);
- my @keys = ($digsymb);
+ my @keys = ($digsymb);
if ($diguser) {
push(@keys,$diguser);
}
@@ -185,15 +189,15 @@ 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
+# 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
+# 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
+# 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).
@@ -208,11 +212,30 @@ sub get_tool_secret {
%{$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'};
+ my ($crsdef,$ltinum);
+ if ($idx =~ /^c(\d+)$/) {
+ $ltinum = $1;
+ $crsdef = 1;
+ 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'};
} else {
$errors->{11} = 1;
@@ -240,6 +263,8 @@ sub get_tool_secret {
# secret for the specific LTI Provider.
#
+# FIXME Move to Lond.pm and perform on course's homeserver
+
sub verify_request {
my ($oauthtype,$protocol,$hostname,$requri,$reqmethod,$consumer_secret,$params,
$authheaders,$errors) = @_;
@@ -285,7 +310,7 @@ sub verify_request {
sub verify_lis_item {
my ($sigrec,$context,$digsymb,$diguser,$cdom,$cnum,$toolsettings,$ltitools,$errors) = @_;
- return unless ((ref($toolsettings) eq 'HASH') && (ref($ltitools) eq 'HASH') &&
+ return unless ((ref($toolsettings) eq 'HASH') && (ref($ltitools) eq 'HASH') &&
(ref($errors) eq 'HASH'));
my ($has_action, $valid_for);
if ($context eq 'grade') {
@@ -306,7 +331,7 @@ sub verify_lis_item {
my $expected_sig;
if ($context eq 'grade') {
my $uniqid = $digsymb.':::'.$diguser.':::'.$cdom.'_'.$cnum;
- $expected_sig = (split(/:::/,&get_service_id($secret,$uniqid)))[0];
+ $expected_sig = (split(/:::/,&get_service_id($secret,$uniqid)))[0];
if ($expected_sig eq $sigrec) {
return 1;
} else {
@@ -314,7 +339,7 @@ sub verify_lis_item {
}
} elsif ($context eq 'roster') {
my $uniqid = $digsymb.':::'.$cdom.'_'.$cnum;
- $expected_sig = (split(/:::/,&get_service_id($secret,$uniqid)))[0];
+ $expected_sig = (split(/:::/,&get_service_id($secret,$uniqid)))[0];
if ($expected_sig eq $sigrec) {
return 1;
} else {
@@ -334,19 +359,25 @@ sub verify_lis_item {
# 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
+# tool in a LON-CAPA course, using the key and secret supplied
# by the Tool Provider.
-#
+#
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,
@@ -354,12 +385,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();
+ if ($post) {
+ return $request->to_post_body();
+ } else {
+ return $request->to_hash();
+ }
}
#
@@ -383,12 +418,12 @@ sub get_service_id {
# grade store). An existing secret past its expiration date
# will be stored as old<service name>secret, and a new secret
# <service name>secret will be stored.
-#
-# Secrets are specific to service name and to the tool instance
+#
+# 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
+# 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) = @_;
@@ -438,7 +473,7 @@ sub set_service_secret {
#
# LON-CAPA as LTI Consumer
#
-# Add a lock key to exttools.db for the instance of an external tool
+# Add a lock key to exttools.db for the instance of an external tool
# when generating and storing a service secret.
#
@@ -505,7 +540,7 @@ sub parse_grade_xml {
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") {
+ } elsif ("@state" eq "imsx_POXEnvelopeRequest imsx_POXBody replaceResultRequest resultRecord result resultScore textString") {
$data{$count}{score} = $text;
}
}, "dtext"],
@@ -641,14 +676,16 @@ sub lti_provider_scope {
#
sub get_roster {
- my ($id,$url,$ckey,$secret) = @_;
+ my ($cdom,$cnum,$ltinum,$keynum,$id,$url) = @_;
my %ltiparams = (
lti_version => 'LTI-1p0',
lti_message_type => 'basic-lis-readmembershipsforcontext',
ext_ims_lis_memberships_id => $id,
);
- my $hashref = &sign_params($url,$ckey,$secret,'',\%ltiparams);
- if (ref($hashref) eq 'HASH') {
+ my %info = ();
+ 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);
$request->content(join('&',map {
my $name = escape($_);
@@ -706,7 +743,7 @@ sub get_roster {
#
sub send_grade {
- my ($id,$url,$ckey,$secret,$scoretype,$sigmethod,$msgformat,$total,$possible) = @_;
+ my ($cdom,$cnum,$crsdef,$type,$ltinum,$keynum,$id,$url,$scoretype,$sigmethod,$msgformat,$total,$possible) = @_;
my $score;
if ($possible > 0) {
if ($scoretype eq 'ratio') {
@@ -716,13 +753,13 @@ sub send_grade {
$score = Math::Round::round($score);
} else {
$score = $total/$possible;
- $score = sprintf("%.2f",$score);
+ $score = sprintf("%.4f",$score);
}
}
if ($sigmethod eq '') {
$sigmethod = 'HMAC-SHA1';
}
- my $request;
+ my ($request,$sendit,$respcode,$result);
if ($msgformat eq '1.0') {
my $date = &Apache::loncommon::utc_string(time);
my %ltiparams = (
@@ -735,8 +772,13 @@ sub send_grade {
result_statusofresult => 'final',
result_date => $date,
);
- my $hashref = &sign_params($url,$ckey,$secret,$sigmethod,\%ltiparams);
- if (ref($hashref) eq 'HASH') {
+ my %info = (
+ method => $sigmethod,
+ );
+ my ($status,$hashref) =
+ &Apache::lonnet::sign_lti($cdom,$cnum,$crsdef,$type,'grade',$url,$ltinum,$keynum,
+ \%ltiparams,\%info);
+ if (($status eq 'ok') && (ref($hashref) eq 'HASH')) {
$request=new HTTP::Request('POST',$url);
$request->content(join('&',map {
my $name = escape($_);
@@ -744,10 +786,10 @@ sub send_grade {
? join("&$name=", map {escape($_) } @{$hashref->{$_}})
: &escape($hashref->{$_}) );
} keys(%{$hashref})));
+ $sendit = 1;
}
} 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"?>
@@ -761,15 +803,15 @@ sub send_grade {
<imsx_POXBody>
<replaceResultRequest>
<resultRecord>
- <sourcedGUID>
- <sourcedId>$id</sourcedId>
- </sourcedGUID>
- <result>
- <resultScore>
- <language>en</language>
- <textString>$score</textString>
- </resultScore>
- </result>
+ <sourcedGUID>
+ <sourcedId>$id</sourcedId>
+ </sourcedGUID>
+ <result>
+ <resultScore>
+ <language>en</language>
+ <textString>$score</textString>
+ </resultScore>
+ </result>
</resultRecord>
</replaceResultRequest>
</imsx_POXBody>
@@ -780,36 +822,71 @@ END
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->sign();
- $request = HTTP::Request->new(
- $gradereq->request_method,
- $gradereq->request_url,
- [
- 'Authorization' => $gradereq->to_authorization_header,
- 'Content-Type' => 'application/xml',
- ],
- $gradexml,
- );
+ 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,
+ );
+ $sendit = 1;
+ }
+ }
+ if ($sendit) {
+ my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10);
+ my $message=$response->status_line;
+ $respcode = $response->code;
+ $result = HTTP::Status::status_message($respcode);
}
- my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10);
- my $message=$response->status_line;
-#FIXME Handle case where pass back of score to LTI Consumer failed.
+ return ($sendit,$score,$respcode,$result);
+}
+
+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
#
-# Create a new user in LON-CAPA. If the domain's configuration
+# Create a new user in LON-CAPA. If the domain's configuration
# includes rules for format of "official" usernames, those rules
# will apply when determining if a user is to be created. In
# additional if institutional user information is available that
@@ -950,7 +1027,7 @@ sub create_passwd {
# in the Consumer, user privs will be added to the user's environment for
# the new role.
#
-# If this is a self-enroll case, a Course Coordinator role will only be assigned
+# If this is a self-enroll case, a Course Coordinator role will only be assigned
# if the current user is also the course owner.
#
@@ -994,8 +1071,8 @@ sub enrolluser {
# with LTI Instructor status.
#
# A list of users is obtained by a call to get_roster()
-# if the calling Consumer support the LTI extension:
-# Context Memberships Service.
+# if the calling Consumer support the LTI extension:
+# Context Memberships Service.
#
# If a user included in the retrieved list does not currently
# have a user account in LON-CAPA, an account will be created.
@@ -1031,20 +1108,21 @@ sub enrolluser {
sub batchaddroster {
my ($item) = @_;
- return unless(ref($item) eq 'HASH');
- return unless (ref($item->{'ltiref'}) eq 'HASH');
+ return unless((ref($item) eq 'HASH') &&
+ (ref($item->{'ltiref'}) eq 'HASH'));
my ($cdom,$cnum) = split(/_/,$item->{'cid'});
+ return if (($cdom eq '') || ($cnum eq ''));
my $udom = $cdom;
my $id = $item->{'id'};
my $url = $item->{'url'};
+ my $ltinum = $item->{'lti'};
+ my $keynum = $item->{'ltiref'}->{'cipher'};
my @intdoms;
my $intdomsref = $item->{'intdoms'};
if (ref($intdomsref) eq 'ARRAY') {
@intdoms = @{$intdomsref};
}
my $uriscope = $item->{'uriscope'};
- my $ckey = $item->{'ltiref'}->{'key'};
- my $secret = $item->{'ltiref'}->{'secret'};
my $section = $item->{'ltiref'}->{'section'};
$section =~ s/\W//g;
if ($section eq 'none') {
@@ -1063,8 +1141,8 @@ sub batchaddroster {
if (ref($item->{'possroles'}) eq 'ARRAY') {
@possroles = @{$item->{'possroles'}};
}
- if (($ckey ne '') && ($secret ne '') && ($id ne '') && ($url ne '')) {
- my %data = &get_roster($id,$url,$ckey,$secret);
+ if (($id ne '') && ($url ne '')) {
+ my %data = &get_roster($cdom,$cnum,$ltinum,$keynum,$id,$url);
if (keys(%data) > 0) {
my (%rulematch,%inst_results,%curr_rules,%got_rules,%alerts,%info);
my %coursehash = &Apache::lonnet::coursedescription($cdom.'_'.$cnum);
@@ -1241,7 +1319,7 @@ sub batchaddroster {
#
# Which LON-CAPA roles are assignable by the current user
# and how LTI roles map to LON-CAPA roles (as defined in
-# the domain configuration for the specific Consumer) are
+# the domain configuration for the specific Consumer) are
# factored in when compiling the list of available roles.
#
# Inputs: 3
@@ -1298,10 +1376,10 @@ sub get_lc_roles {
# LON-CAPA as LTI Provider
#
# Compares current start and dates for a user's role
-# with dates to apply for the same user/role to
+# with dates to apply for the same user/role to
# determine if there is a change between the current
# ones and the updated ones.
-#
+#
sub datechange_check {
my ($oldstart,$oldend,$startdate,$enddate) = @_;