version 1.11, 2018/05/28 23:26:04
|
version 1.17, 2019/07/18 18:28:46
|
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 UUID::Tiny ':std'; |
use UUID::Tiny ':std'; |
use Apache::lonnet; |
use Apache::lonnet; |
use Apache::loncommon; |
use Apache::loncommon; |
Line 38 use Apache::loncoursedata;
|
Line 39 use Apache::loncoursedata;
|
use Apache::lonuserutils; |
use Apache::lonuserutils; |
use Apache::lonenc(); |
use Apache::lonenc(); |
use Apache::longroup(); |
use Apache::longroup(); |
|
use Apache::lonlocal; |
use Math::Round(); |
use Math::Round(); |
use LONCAPA qw(:DEFAULT :match); |
use LONCAPA qw(:DEFAULT :match); |
|
|
Line 240 sub get_tool_secret {
|
Line 242 sub get_tool_secret {
|
# |
# |
|
|
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 275 sub verify_lis_item {
|
Line 291 sub verify_lis_item {
|
my ($has_action, $valid_for); |
my ($has_action, $valid_for); |
if ($context eq 'grade') { |
if ($context eq 'grade') { |
$has_action = $ltitools->{'passback'}; |
$has_action = $ltitools->{'passback'}; |
$valid_for = $ltitools->{'passbackvalid'} |
$valid_for = $ltitools->{'passbackvalid'} * 86400; # convert days to seconds |
} elsif ($context eq 'roster') { |
} elsif ($context eq 'roster') { |
$has_action = $ltitools->{'roster'}; |
$has_action = $ltitools->{'roster'}; |
$valid_for = $ltitools->{'rostervalid'}; |
$valid_for = $ltitools->{'rostervalid'}; |
Line 295 sub verify_lis_item {
|
Line 311 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 303 sub verify_lis_item {
|
Line 319 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 324 sub verify_lis_item {
|
Line 340 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 339 sub sign_params {
|
Line 361 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 381 sub set_service_secret {
|
Line 407 sub set_service_secret {
|
my $warning; |
my $warning; |
my ($needsnew,$oldsecret,$lifetime); |
my ($needsnew,$oldsecret,$lifetime); |
if ($name eq 'grade') { |
if ($name eq 'grade') { |
$lifetime = $ltitools->{'passbackvalid'} |
$lifetime = $ltitools->{'passbackvalid'} * 86400; # convert days to seconds |
} elsif ($name eq 'roster') { |
} elsif ($name eq 'roster') { |
$lifetime = $ltitools->{'rostervalid'}; |
$lifetime = $ltitools->{'rostervalid'}; |
} |
} |
if ($toolsettings->{$name} eq '') { |
if ($toolsettings->{$name.'secret'} eq '') { |
$needsnew = 1; |
$needsnew = 1; |
} elsif (($toolsettings->{$name.'date'} + $lifetime) < $now) { |
} elsif (($toolsettings->{$name.'secretdate'} + $lifetime) < $now) { |
$oldsecret = $toolsettings->{$name.'secret'}; |
$oldsecret = $toolsettings->{$name.'secret'}; |
$needsnew = 1; |
$needsnew = 1; |
} |
} |
Line 465 sub release_tool_lock {
|
Line 491 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 487 sub lti_provider_scope {
|
Line 554 sub lti_provider_scope {
|
$scope = 'map'; |
$scope = 'map'; |
$realuri = $tail; |
$realuri = $tail; |
} else { |
} else { |
my ($map,$resid,$url) = &Apache::lonnet::decode_symb($tail); |
my $symb = $tail; |
|
$symb =~ s{^/}{}; |
|
my ($map,$resid,$url) = &Apache::lonnet::decode_symb($symb); |
$realuri = &Apache::lonnet::clutter($url); |
$realuri = &Apache::lonnet::clutter($url); |
if ($url =~ /\.sequence$/) { |
if ($url =~ /\.sequence$/) { |
$scope = 'map'; |
$scope = 'map'; |
} else { |
} else { |
$scope = 'resource'; |
$scope = 'resource'; |
$realuri .= '?symb='.$tail; |
$realuri .= '?symb='.$symb; |
$passkey = $tail; |
$passkey = $symb; |
if ($getunenc) { |
if ($getunenc) { |
$unencsymb = $tail; |
$unencsymb = $symb; |
} |
} |
} |
} |
} |
} |
Line 506 sub lti_provider_scope {
|
Line 575 sub lti_provider_scope {
|
$scope = 'map'; |
$scope = 'map'; |
$realuri = $tail; |
$realuri = $tail; |
} else { |
} else { |
my ($map,$resid,$url) = &Apache::lonnet::decode_symb($tail); |
my $symb = $tail; |
|
$symb =~ s{^/?res/}{}; |
|
my ($map,$resid,$url) = &Apache::lonnet::decode_symb($symb); |
$realuri = &Apache::lonnet::clutter($url); |
$realuri = &Apache::lonnet::clutter($url); |
if ($url =~ /\.sequence$/) { |
if ($url =~ /\.sequence$/) { |
$scope = 'map'; |
$scope = 'map'; |
} else { |
} else { |
$scope = 'resource'; |
$scope = 'resource'; |
$realuri .= '?symb='.$tail; |
$realuri .= '?symb='.$symb; |
$passkey = $tail; |
$passkey = $symb; |
if ($getunenc) { |
if ($getunenc) { |
$unencsymb = $tail; |
$unencsymb = $symb; |
} |
} |
} |
} |
} |
} |
Line 561 sub lti_provider_scope {
|
Line 632 sub lti_provider_scope {
|
} elsif (($tail =~ m{^/$cdom/$cnum$}) || ($tail eq '')) { |
} elsif (($tail =~ m{^/$cdom/$cnum$}) || ($tail eq '')) { |
$scope = 'course'; |
$scope = 'course'; |
$realuri = '/adm/navmaps'; |
$realuri = '/adm/navmaps'; |
$passkey = $tail; |
$passkey = ''; |
} |
} |
if ($scope eq 'map') { |
if ($scope eq 'map') { |
$passkey = $realuri; |
$passkey = $realuri; |
Line 573 sub lti_provider_scope {
|
Line 644 sub lti_provider_scope {
|
} |
} |
} |
} |
|
|
|
# |
|
# LON-CAPA as LTI Provider |
|
# |
|
# Obtain a list of course personnel and students from |
|
# the LTI Consumer which launched this instance. |
|
# |
|
|
sub get_roster { |
sub get_roster { |
my ($id,$url,$ckey,$secret) = @_; |
my ($id,$url,$ckey,$secret) = @_; |
my %ltiparams = ( |
my %ltiparams = ( |
Line 631 sub get_roster {
|
Line 709 sub get_roster {
|
return; |
return; |
} |
} |
|
|
|
# |
|
# LON-CAPA as LTI Provider |
|
# |
|
# Passback a grade for a user to the LTI Consumer which originally |
|
# provided the lis_result_sourcedid |
|
# |
|
|
sub send_grade { |
sub send_grade { |
my ($id,$url,$ckey,$secret,$scoretype,$total,$possible) = @_; |
my ($id,$url,$ckey,$secret,$scoretype,$sigmethod,$msgformat,$total,$possible) = @_; |
my $score; |
my $score; |
if ($possible > 0) { |
if ($possible > 0) { |
if ($scoretype eq 'ratio') { |
if ($scoretype eq 'ratio') { |
Line 645 sub send_grade {
|
Line 730 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 $hashref = &sign_params($url,$ckey,$secret,\%ltiparams,$sigmethod); |
? join("&$name=", map {escape($_) } @{$hashref->{$_}}) |
if (ref($hashref) eq 'HASH') { |
: &escape($hashref->{$_}) ); |
$request=new HTTP::Request('POST',$url); |
} keys(%{$hashref}))); |
$request->content(join('&',map { |
my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10); |
my $name = escape($_); |
my $message=$response->status_line; |
"$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. |
#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_utf8($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; |
} |
} |
|
|
|
# |
|
# LON-CAPA as LTI Provider |
|
# |
|
# 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 |
|
# will be used when creating a new user account. |
|
# |
|
|
sub create_user { |
sub create_user { |
my ($ltiref,$uname,$udom,$domdesc,$data,$alerts,$rulematch,$inst_results, |
my ($ltiref,$uname,$udom,$domdesc,$data,$alerts,$rulematch,$inst_results, |
$curr_rules,$got_rules) = @_; |
$curr_rules,$got_rules) = @_; |
Line 768 sub create_user {
|
Line 947 sub create_user {
|
return $result; |
return $result; |
} |
} |
|
|
|
# |
|
# LON-CAPA as LTI Provider |
|
# |
|
# Create a password for a new user if the authentication |
|
# type to assign to new users created following LTI launch is |
|
# to be LON-CAPA "internal". |
|
# |
|
|
sub create_passwd { |
sub create_passwd { |
my $passwd = ''; |
my $passwd = ''; |
|
srand( time() ^ ($$ + ($$ << 15)) ); # Seed rand. |
my @letts = ("a".."z"); |
my @letts = ("a".."z"); |
for (my $i=0; $i<8; $i++) { |
for (my $i=0; $i<8; $i++) { |
my $lettnum = int(rand(2)); |
my $lettnum = int(rand(2)); |
Line 788 sub create_passwd {
|
Line 976 sub create_passwd {
|
return ($passwd); |
return ($passwd); |
} |
} |
|
|
|
# |
|
# LON-CAPA as LTI Provider |
|
# |
|
# Enroll a user in a LON-CAPA course, with the specified role and (optional) |
|
# section. If this is a self-enroll case, i.e., a user launched the LTI tool |
|
# 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 the current user is also the course owner. |
|
# |
|
|
sub enrolluser { |
sub enrolluser { |
my ($udom,$uname,$role,$cdom,$cnum,$sec,$start,$end) = @_; |
my ($udom,$uname,$role,$cdom,$cnum,$sec,$start,$end,$selfenroll) = @_; |
my $enrollresult; |
my $enrollresult; |
my $area = "/$cdom/$cnum"; |
my $area = "/$cdom/$cnum"; |
if (($role ne 'cc') && ($role ne 'co') && ($sec ne '')) { |
if (($role ne 'cc') && ($role ne 'co') && ($sec ne '')) { |
Line 801 sub enrolluser {
|
Line 1001 sub enrolluser {
|
$enrollresult = |
$enrollresult = |
&Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef, |
&Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef, |
undef,undef,$sec,$end,$start, |
undef,undef,$sec,$end,$start, |
'ltienroll',undef,$cdom.'_'.$cnum,undef, |
'ltienroll',undef,$cdom.'_'.$cnum, |
'ltienroll','',$instcid); |
$selfenroll,'ltienroll','',$instcid); |
} elsif ($role =~ /^(cc|in|ta|ep)$/) { |
} elsif ($role =~ /^(cc|in|ta|ep)$/) { |
$enrollresult = |
$enrollresult = |
&Apache::lonnet::assignrole($udom,$uname,$area,$role,$end,$start, |
&Apache::lonnet::assignrole($udom,$uname,$area,$role,$end,$start, |
undef,undef,'ltienroll'); |
undef,$selfenroll,'ltienroll'); |
|
} |
|
if ($enrollresult eq 'ok') { |
|
if ($selfenroll) { |
|
my (%userroles,%newrole,%newgroups); |
|
&Apache::lonnet::standard_roleprivs(\%newrole,$role,$cdom,$spec,$cnum, |
|
$area); |
|
&Apache::lonnet::set_userprivs(\%userroles,\%newrole,\%newgroups); |
|
$userroles{'user.role.'.$spec} = $start.'.'.$end; |
|
&Apache::lonnet::appenv(\%userroles,[$role,'cm']); |
|
} |
} |
} |
return $enrollresult; |
return $enrollresult; |
} |
} |
|
|
|
# |
|
# LON-CAPA as LTI Provider |
|
# |
|
# Batch addition of users following LTI launch by a user |
|
# 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 a user included in the retrieved list does not currently |
|
# have a user account in LON-CAPA, an account will be created. |
|
# |
|
# If a user already has an account, and the same role and |
|
# section assigned (currently active), then no change will |
|
# be made for that user. |
|
# |
|
# Information available for new users (besides username and) |
|
# role) may include: first name, last name, full name (from |
|
# which middle name will be extracted), permanent e-mail address, |
|
# and lis_result_sourcedid (for passback of grades). |
|
# |
|
# If grades are to be passed back, the passback url will be |
|
# the same as for the current user's session. |
|
# |
|
# The roles which may be assigned will be determined from the |
|
# LTI roles included in the retrieved roster, and the mapping |
|
# of LTI roles to LON-CAPA roles configured for this LTI Consumer |
|
# in the domain configuration. |
|
# |
|
# Course Coordinator roles will only be assigned if the current |
|
# user is also the course owner. |
|
# |
|
# The domain configuration for the corresponding Consumer can include |
|
# a section to assign to LTI users. If the roster includes students |
|
# any existing student roles with a different section will be expired, |
|
# and a role in the LTI section will be assigned. |
|
# |
|
# For non-student rules (excluding Course Coordinator) a role will be |
|
# assigned with the LTI section )or no section, if one is not rquired. |
|
# |
|
|
sub batchaddroster { |
sub batchaddroster { |
my ($item) = @_; |
my ($item) = @_; |
return unless(ref($item) eq 'HASH'); |
return unless(ref($item) eq 'HASH'); |
Line 1015 sub batchaddroster {
|
Line 1267 sub batchaddroster {
|
return; |
return; |
} |
} |
|
|
|
# |
|
# LON-CAPA as LTI Provider |
|
# |
|
# Gather a list of available LON-CAPA roles derived |
|
# from a comma separated list of LTI roles. |
|
# |
|
# 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 |
|
# factored in when compiling the list of available roles. |
|
# |
|
# Inputs: 3 |
|
# $rolestr - comma separated list of LTI roles. |
|
# $allowedroles - reference to array of assignable LC roles |
|
# $maproles - ref to HASH of mapping of LTI roles to LC roles |
|
# |
|
# Outputs: 2 |
|
# (a) reference to array of available LC roles. |
|
# (b) reference to array of LTI roles. |
|
# |
|
|
sub get_lc_roles { |
sub get_lc_roles { |
my ($rolestr,$allowedroles,$maproles) = @_; |
my ($rolestr,$allowedroles,$maproles) = @_; |
my (@ltiroles,@lcroles); |
my (@ltiroles,@lcroles); |
Line 1055 sub get_lc_roles {
|
Line 1328 sub get_lc_roles {
|
return (\@lcroles,\@ltiroles); |
return (\@lcroles,\@ltiroles); |
} |
} |
|
|
|
# |
|
# 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 |
|
# determine if there is a change between the current |
|
# ones and the updated ones. |
|
# |
|
|
sub datechange_check { |
sub datechange_check { |
my ($oldstart,$oldend,$startdate,$enddate) = @_; |
my ($oldstart,$oldend,$startdate,$enddate) = @_; |
my $datechange = 0; |
my $datechange = 0; |
Line 1073 sub datechange_check {
|
Line 1355 sub datechange_check {
|
return $datechange; |
return $datechange; |
} |
} |
|
|
|
# |
|
# LON-CAPA as LTI Provider |
|
# |
|
# Store the URL used by a specific LTI Consumer to process grades passed back |
|
# by an LTI Provider. |
|
# |
|
|
sub store_passbackurl { |
sub store_passbackurl { |
my ($ltinum,$pburl,$cdom,$cnum) = @_; |
my ($ltinum,$pburl,$cdom,$cnum) = @_; |
my %history = &Apache::lonnet::restore($ltinum,'passbackurl',$cdom,$cnum); |
my %history = &Apache::lonnet::restore($ltinum,'passbackurl',$cdom,$cnum); |