--- loncom/lti/ltiutils.pm 2025/01/16 21:52:05 1.17.2.6
+++ loncom/lti/ltiutils.pm 2024/02/27 03:55:55 1.20
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Utility functions for managing LON-CAPA LTI interactions
#
-# $Id: ltiutils.pm,v 1.17.2.6 2025/01/16 21:52:05 raeburn Exp $
+# $Id: ltiutils.pm,v 1.20 2024/02/27 03:55:55 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -34,8 +34,6 @@ use Digest::SHA;
use Digest::MD5 qw(md5_hex);
use Encode;
use UUID::Tiny ':std';
-use HTTP::Status;
-use LWP::UserAgent();
use Apache::lonnet;
use Apache::loncommon;
use Apache::loncoursedata;
@@ -100,8 +98,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.
#
@@ -146,8 +144,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
@@ -159,7 +157,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);
}
@@ -190,15 +188,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).
@@ -311,7 +309,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') {
@@ -332,7 +330,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 {
@@ -340,7 +338,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 {
@@ -419,12 +417,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) = @_;
@@ -474,7 +472,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.
#
@@ -541,7 +539,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"],
@@ -694,9 +692,7 @@ sub get_roster {
? join("&$name=", map {escape($_) } @{$hashref->{$_}})
: &escape($hashref->{$_}) );
} keys(%{$hashref})));
- my $ua=new LWP::UserAgent;
- $ua->timeout(10);
- my $response=$ua->request($request);
+ my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10);
my $message=$response->status_line;
if (($response->is_success) && ($response->content ne '')) {
my %data = ();
@@ -762,7 +758,7 @@ sub send_grade {
if ($sigmethod eq '') {
$sigmethod = 'HMAC-SHA1';
}
- my ($request,$sendit,$respcode,$result);
+ my $request;
if ($msgformat eq '1.0') {
my $date = &Apache::loncommon::utc_string(time);
my %ltiparams = (
@@ -777,10 +773,10 @@ sub send_grade {
);
my %info = (
method => $sigmethod,
- );
+ );
my ($status,$hashref) =
&Apache::lonnet::sign_lti($cdom,$cnum,$crsdef,$type,'grade',$url,$ltinum,$keynum,
- \%ltiparams,\%info);
+ \%ltiparams,\%info);
if (($status eq 'ok') && (ref($hashref) eq 'HASH')) {
$request=new HTTP::Request('POST',$url);
$request->content(join('&',map {
@@ -789,7 +785,7 @@ sub send_grade {
? join("&$name=", map {escape($_) } @{$hashref->{$_}})
: &escape($hashref->{$_}) );
} keys(%{$hashref})));
- $sendit = 1;
+#FIXME Need to handle case where passback failed.
}
} else {
srand( time() ^ ($$ + ($$ << 15)) ); # Seed rand.
@@ -806,15 +802,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>
@@ -838,26 +834,19 @@ END
&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,
+ $reqmethod,
+ $url,
+ [
+ 'Authorization' => $authheader,
+ 'Content-Type' => 'application/xml',
+ ],
+ $gradexml,
);
- $sendit = 1;
+ my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10);
+ my $message=$response->status_line;
+#FIXME Handle case where pass back of score to LTI Consumer failed.
}
}
- if ($sendit) {
- my $ua=new LWP::UserAgent;
- $ua->timeout(10);
- my $response=$ua->request($request);
- my $message=$response->status_line;
- $respcode = $response->code;
- $result = HTTP::Status::status_message($respcode);
- }
- return ($sendit,$score,$respcode,$result);
}
sub setup_logout_callback {
@@ -875,15 +864,13 @@ sub setup_logout_callback {
my %info = (
respfmt => 'to_post_body',
);
- my ($status,$post) =
+ 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 $ua=new LWP::UserAgent;
- $ua->timeout(10);
my $request=new HTTP::Request('POST',$service_url);
$request->content($post);
- my $response=$ua->request($request);
+ my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10);
}
}
}
@@ -1078,8 +1065,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.
@@ -1383,10 +1370,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) = @_;