|
version 1.20, 2024/02/27 03:55:55
|
version 1.22, 2024/11/21 07:26:04
|
|
Line 1
|
Line 1
|
| # The LearningOnline Network with CAPA |
# The LearningOnline Network with CAPA |
| # Utility functions for managing LON-CAPA LTI interactions |
# Utility functions for managing LON-CAPA LTI interactions |
| # |
# |
| # $Id$ |
# $Id$ |
| # |
# |
|
Line 34 use Digest::SHA;
|
Line 34 use Digest::SHA;
|
| use Digest::MD5 qw(md5_hex); |
use Digest::MD5 qw(md5_hex); |
| use Encode; |
use Encode; |
| use UUID::Tiny ':std'; |
use UUID::Tiny ':std'; |
| |
use HTTP::Status; |
| use Apache::lonnet; |
use Apache::lonnet; |
| use Apache::loncommon; |
use Apache::loncommon; |
| use Apache::loncoursedata; |
use Apache::loncoursedata; |
|
Line 54 use LONCAPA qw(:DEFAULT :match);
|
Line 55 use LONCAPA qw(:DEFAULT :match);
|
| # When LON-CAPA is operating as a Consumer, nonce checking |
# When LON-CAPA is operating as a Consumer, nonce checking |
| # occurs when a Tool Provider launched from an instance of |
# occurs when a Tool Provider launched from an instance of |
| # an external tool in a LON-CAPA course makes a request to |
# an external tool in a LON-CAPA course makes a request to |
| # (a) /adm/service/roster or (b) /adm/service/passback to, |
# (a) /adm/service/roster or (b) /adm/service/passback to, |
| # respectively, retrieve a roster or store the grade for |
# respectively, retrieve a roster or store the grade for |
| # the original launch by a specific user. |
# the original launch by a specific user. |
| # |
# |
| # When LON-CAPA is operating as a Provider, nonce checking |
# When LON-CAPA is operating as a Provider, nonce checking |
| # occurs when a user in course context in another LMS (the |
# 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. |
# /adm/lti/ with LON-CAPA symb, map, or deep-link ID appended. |
| # |
# |
| |
|
|
Line 98 sub check_nonce {
|
Line 99 sub check_nonce {
|
| # LON-CAPA as LTI Consumer |
# LON-CAPA as LTI Consumer |
| # |
# |
| # Determine the domain and the courseID of the LON-CAPA course |
# Determine the domain and the courseID of the LON-CAPA course |
| # for which access is needed by a Tool Provider -- either to |
# for which access is needed by a Tool Provider -- either to |
| # retrieve a roster or store the grade for an instance of an |
# retrieve a roster or store the grade for an instance of an |
| # external tool in the course. |
# external tool in the course. |
| # |
# |
| |
|
|
Line 144 sub get_loncapa_course {
|
Line 145 sub get_loncapa_course {
|
| # |
# |
| # LON-CAPA as LTI Consumer |
# LON-CAPA as LTI Consumer |
| # |
# |
| # Determine the symb and (optionally) LON-CAPA user for an |
# Determine the symb and (optionally) LON-CAPA user for an |
| # instance of an external tool in a course -- either to |
# instance of an external tool in a course -- either to |
| # to retrieve a roster or store a grade. |
# to retrieve a roster or store a grade. |
| # |
# |
| # Use the digested symb to lookup the real symb in exttools.db |
# Use the digested symb to lookup the real symb in exttools.db |
|
Line 157 sub get_tool_instance {
|
Line 158 sub get_tool_instance {
|
| my ($cdom,$cnum,$digsymb,$diguser,$errors) = @_; |
my ($cdom,$cnum,$digsymb,$diguser,$errors) = @_; |
| return unless (ref($errors) eq 'HASH'); |
return unless (ref($errors) eq 'HASH'); |
| my ($marker,$symb,$uname,$udom); |
my ($marker,$symb,$uname,$udom); |
| my @keys = ($digsymb); |
my @keys = ($digsymb); |
| if ($diguser) { |
if ($diguser) { |
| push(@keys,$diguser); |
push(@keys,$diguser); |
| } |
} |
|
Line 188 sub get_tool_instance {
|
Line 189 sub get_tool_instance {
|
| # LON-CAPA as LTI Consumer |
# LON-CAPA as LTI Consumer |
| # |
# |
| # Retrieve data needed to validate a request from a Tool Provider |
# 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. |
# 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 |
# configuration or the Tool Provider ID stored in the |
| # exttool_$marker db file and compare the Consumer key with the |
# exttool_$marker db file and compare the Consumer key with the |
| # one in the POSTed data. |
# 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 |
# contents of the .db file (instance of tool in course) and the |
| # $ltitools hashref with the configuration for the tool (at |
# $ltitools hashref with the configuration for the tool (at |
| # domain level). |
# domain level). |
|
Line 309 sub verify_request {
|
Line 310 sub verify_request {
|
| |
|
| sub verify_lis_item { |
sub verify_lis_item { |
| my ($sigrec,$context,$digsymb,$diguser,$cdom,$cnum,$toolsettings,$ltitools,$errors) = @_; |
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')); |
(ref($errors) eq 'HASH')); |
| my ($has_action, $valid_for); |
my ($has_action, $valid_for); |
| if ($context eq 'grade') { |
if ($context eq 'grade') { |
|
Line 330 sub verify_lis_item {
|
Line 331 sub verify_lis_item {
|
| my $expected_sig; |
my $expected_sig; |
| if ($context eq 'grade') { |
if ($context eq 'grade') { |
| my $uniqid = $digsymb.':::'.$diguser.':::'.$cdom.'_'.$cnum; |
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) { |
if ($expected_sig eq $sigrec) { |
| return 1; |
return 1; |
| } else { |
} else { |
|
Line 338 sub verify_lis_item {
|
Line 339 sub verify_lis_item {
|
| } |
} |
| } elsif ($context eq 'roster') { |
} elsif ($context eq 'roster') { |
| my $uniqid = $digsymb.':::'.$cdom.'_'.$cnum; |
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) { |
if ($expected_sig eq $sigrec) { |
| return 1; |
return 1; |
| } else { |
} else { |
|
Line 358 sub verify_lis_item {
|
Line 359 sub verify_lis_item {
|
| # LON-CAPA as LTI Consumer |
# LON-CAPA as LTI Consumer |
| # |
# |
| # Sign a request used to launch an instance of an external |
# 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. |
# by the Tool Provider. |
| # |
# |
| |
|
| sub sign_params { |
sub sign_params { |
| my ($url,$key,$secret,$paramsref,$sigmethod,$type,$callback,$post) = @_; |
my ($url,$key,$secret,$paramsref,$sigmethod,$type,$callback,$post) = @_; |
|
Line 417 sub get_service_id {
|
Line 418 sub get_service_id {
|
| # grade store). An existing secret past its expiration date |
# grade store). An existing secret past its expiration date |
| # will be stored as old<service name>secret, and a new secret |
# will be stored as old<service name>secret, and a new secret |
| # <service name>secret will be stored. |
# <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). |
# (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. |
# domain configuration for the specific tool and the service. |
| # |
# |
| |
|
| sub set_service_secret { |
sub set_service_secret { |
| my ($cdom,$cnum,$marker,$name,$now,$toolsettings,$ltitools) = @_; |
my ($cdom,$cnum,$marker,$name,$now,$toolsettings,$ltitools) = @_; |
|
Line 472 sub set_service_secret {
|
Line 473 sub set_service_secret {
|
| # |
# |
| # LON-CAPA as LTI Consumer |
# 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. |
# when generating and storing a service secret. |
| # |
# |
| |
|
|
Line 539 sub parse_grade_xml {
|
Line 540 sub parse_grade_xml {
|
| my ($text) = @_; |
my ($text) = @_; |
| if ("@state" eq "imsx_POXEnvelopeRequest imsx_POXBody replaceResultRequest resultRecord sourcedGUID sourcedId") { |
if ("@state" eq "imsx_POXEnvelopeRequest imsx_POXBody replaceResultRequest resultRecord sourcedGUID sourcedId") { |
| $data{$count}{sourcedid} = $text; |
$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; |
$data{$count}{score} = $text; |
| } |
} |
| }, "dtext"], |
}, "dtext"], |
|
Line 758 sub send_grade {
|
Line 759 sub send_grade {
|
| if ($sigmethod eq '') { |
if ($sigmethod eq '') { |
| $sigmethod = 'HMAC-SHA1'; |
$sigmethod = 'HMAC-SHA1'; |
| } |
} |
| my $request; |
my ($request,$sendit,$respcode,$result); |
| if ($msgformat eq '1.0') { |
if ($msgformat eq '1.0') { |
| my $date = &Apache::loncommon::utc_string(time); |
my $date = &Apache::loncommon::utc_string(time); |
| my %ltiparams = ( |
my %ltiparams = ( |
|
Line 773 sub send_grade {
|
Line 774 sub send_grade {
|
| ); |
); |
| my %info = ( |
my %info = ( |
| method => $sigmethod, |
method => $sigmethod, |
| ); |
); |
| my ($status,$hashref) = |
my ($status,$hashref) = |
| &Apache::lonnet::sign_lti($cdom,$cnum,$crsdef,$type,'grade',$url,$ltinum,$keynum, |
&Apache::lonnet::sign_lti($cdom,$cnum,$crsdef,$type,'grade',$url,$ltinum,$keynum, |
| \%ltiparams,\%info); |
\%ltiparams,\%info); |
| if (($status eq 'ok') && (ref($hashref) eq 'HASH')) { |
if (($status eq 'ok') && (ref($hashref) eq 'HASH')) { |
| $request=new HTTP::Request('POST',$url); |
$request=new HTTP::Request('POST',$url); |
| $request->content(join('&',map { |
$request->content(join('&',map { |
|
Line 785 sub send_grade {
|
Line 786 sub send_grade {
|
| ? join("&$name=", map {escape($_) } @{$hashref->{$_}}) |
? join("&$name=", map {escape($_) } @{$hashref->{$_}}) |
| : &escape($hashref->{$_}) ); |
: &escape($hashref->{$_}) ); |
| } keys(%{$hashref}))); |
} keys(%{$hashref}))); |
| #FIXME Need to handle case where passback failed. |
$sendit = 1; |
| } |
} |
| } else { |
} else { |
| srand( time() ^ ($$ + ($$ << 15)) ); # Seed rand. |
srand( time() ^ ($$ + ($$ << 15)) ); # Seed rand. |
|
Line 802 sub send_grade {
|
Line 803 sub send_grade {
|
| <imsx_POXBody> |
<imsx_POXBody> |
| <replaceResultRequest> |
<replaceResultRequest> |
| <resultRecord> |
<resultRecord> |
| <sourcedGUID> |
<sourcedGUID> |
| <sourcedId>$id</sourcedId> |
<sourcedId>$id</sourcedId> |
| </sourcedGUID> |
</sourcedGUID> |
| <result> |
<result> |
| <resultScore> |
<resultScore> |
| <language>en</language> |
<language>en</language> |
| <textString>$score</textString> |
<textString>$score</textString> |
| </resultScore> |
</resultScore> |
| </result> |
</result> |
| </resultRecord> |
</resultRecord> |
| </replaceResultRequest> |
</replaceResultRequest> |
| </imsx_POXBody> |
</imsx_POXBody> |
|
Line 834 END
|
Line 835 END
|
| &Apache::lonnet::sign_lti($cdom,$cnum,$crsdef,$type,'grade',$url,$ltinum,$keynum,\%params,\%info); |
&Apache::lonnet::sign_lti($cdom,$cnum,$crsdef,$type,'grade',$url,$ltinum,$keynum,\%params,\%info); |
| if (($status eq 'ok') && ($authheader ne '')) { |
if (($status eq 'ok') && ($authheader ne '')) { |
| $request = HTTP::Request->new( |
$request = HTTP::Request->new( |
| $reqmethod, |
$reqmethod, |
| $url, |
$url, |
| [ |
[ |
| 'Authorization' => $authheader, |
'Authorization' => $authheader, |
| 'Content-Type' => 'application/xml', |
'Content-Type' => 'application/xml', |
| ], |
], |
| $gradexml, |
$gradexml, |
| ); |
); |
| my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10); |
$sendit = 1; |
| my $message=$response->status_line; |
|
| #FIXME Handle case where pass back of score to LTI Consumer failed. |
|
| } |
} |
| } |
} |
| |
if ($sendit) { |
| |
my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10); |
| |
my $message=$response->status_line; |
| |
$respcode = $response->code; |
| |
$result = HTTP::Status::status_message($respcode); |
| |
} |
| |
return ($sendit,$score,$respcode,$result); |
| } |
} |
| |
|
| sub setup_logout_callback { |
sub setup_logout_callback { |
|
Line 864 sub setup_logout_callback {
|
Line 870 sub setup_logout_callback {
|
| my %info = ( |
my %info = ( |
| respfmt => 'to_post_body', |
respfmt => 'to_post_body', |
| ); |
); |
| my ($status,$post) = |
my ($status,$post) = |
| &Apache::lonnet::sign_lti($cdom,$cnum,$crstool,'lti','logout',$service_url,$idx, |
&Apache::lonnet::sign_lti($cdom,$cnum,$crstool,'lti','logout',$service_url,$idx, |
| $keynum,\%ltiparams,\%info); |
$keynum,\%ltiparams,\%info); |
| if (($status eq 'ok') && ($post ne '')) { |
if (($status eq 'ok') && ($post ne '')) { |
|
Line 880 sub setup_logout_callback {
|
Line 886 sub setup_logout_callback {
|
| # |
# |
| # LON-CAPA as LTI Provider |
# 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 |
# includes rules for format of "official" usernames, those rules |
| # will apply when determining if a user is to be created. In |
# will apply when determining if a user is to be created. In |
| # additional if institutional user information is available that |
# additional if institutional user information is available that |
|
Line 1021 sub create_passwd {
|
Line 1027 sub create_passwd {
|
| # in the Consumer, user privs will be added to the user's environment for |
# in the Consumer, user privs will be added to the user's environment for |
| # the new role. |
# 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. |
# if the current user is also the course owner. |
| # |
# |
| |
|
|
Line 1065 sub enrolluser {
|
Line 1071 sub enrolluser {
|
| # with LTI Instructor status. |
# with LTI Instructor status. |
| # |
# |
| # A list of users is obtained by a call to get_roster() |
# A list of users is obtained by a call to get_roster() |
| # if the calling Consumer support the LTI extension: |
# if the calling Consumer support the LTI extension: |
| # Context Memberships Service. |
# Context Memberships Service. |
| # |
# |
| # If a user included in the retrieved list does not currently |
# If a user included in the retrieved list does not currently |
| # have a user account in LON-CAPA, an account will be created. |
# have a user account in LON-CAPA, an account will be created. |
|
Line 1313 sub batchaddroster {
|
Line 1319 sub batchaddroster {
|
| # |
# |
| # Which LON-CAPA roles are assignable by the current user |
# Which LON-CAPA roles are assignable by the current user |
| # and how LTI roles map to LON-CAPA roles (as defined in |
# 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. |
# factored in when compiling the list of available roles. |
| # |
# |
| # Inputs: 3 |
# Inputs: 3 |
|
Line 1370 sub get_lc_roles {
|
Line 1376 sub get_lc_roles {
|
| # LON-CAPA as LTI Provider |
# LON-CAPA as LTI Provider |
| # |
# |
| # Compares current start and dates for a user's role |
# 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 |
# determine if there is a change between the current |
| # ones and the updated ones. |
# ones and the updated ones. |
| # |
# |
| |
|
| sub datechange_check { |
sub datechange_check { |
| my ($oldstart,$oldend,$startdate,$enddate) = @_; |
my ($oldstart,$oldend,$startdate,$enddate) = @_; |
![[BACK]](/icons/back.gif){kind=icon}
Return to ltiutils.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / lti