--- loncom/lti/ltiutils.pm 2018/05/28 23:26:04 1.11 +++ loncom/lti/ltiutils.pm 2024/02/27 04:04:06 1.21 @@ -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.11 2018/05/28 23:26:04 raeburn Exp $ +# $Id: ltiutils.pm,v 1.21 2024/02/27 04:04:06 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -31,6 +31,8 @@ package LONCAPA::ltiutils; use strict; use Net::OAuth; use Digest::SHA; +use Digest::MD5 qw(md5_hex); +use Encode; use UUID::Tiny ':std'; use Apache::lonnet; use Apache::loncommon; @@ -38,7 +40,9 @@ use Apache::loncoursedata; use Apache::lonuserutils; use Apache::lonenc(); use Apache::longroup(); +use Apache::lonlocal; use Math::Round(); +use LONCAPA::Lond; use LONCAPA qw(:DEFAULT :match); # @@ -50,13 +54,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. # @@ -94,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. # @@ -140,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 @@ -153,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); } @@ -184,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). @@ -207,11 +211,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; @@ -239,13 +262,29 @@ 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 ($params,$protocol,$hostname,$requri,$reqmethod,$consumer_secret,$errors) = @_; - return unless (ref($errors) eq 'HASH'); - my $request = Net::OAuth->request('request token')->from_hash($params, - request_url => $protocol.'://'.$hostname.$requri, - request_method => $reqmethod, - consumer_secret => $consumer_secret,); + my ($oauthtype,$protocol,$hostname,$requri,$reqmethod,$consumer_secret,$params, + $authheaders,$errors) = @_; + unless (ref($errors) eq 'HASH') { + $errors->{15} = 1; + return; + } + 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()) { $errors->{15} = 1; return; @@ -270,12 +309,12 @@ 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') { $has_action = $ltitools->{'passback'}; - $valid_for = $ltitools->{'passbackvalid'} + $valid_for = $ltitools->{'passbackvalid'} * 86400; # convert days to seconds } elsif ($context eq 'roster') { $has_action = $ltitools->{'roster'}; $valid_for = $ltitools->{'rostervalid'}; @@ -291,26 +330,26 @@ 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 { - $errors->{17} = 1; + $errors->{18} = 1; } } 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 { - $errors->{18} = 1; + $errors->{19} = 1; } } } else { - $errors->{19} = 1; + $errors->{20} = 1; } } else { - $errors->{20} = 1; + $errors->{21} = 1; } return; } @@ -319,19 +358,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, @@ -339,12 +384,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(); + $request->sign(); + if ($post) { + return $request->to_post_body(); + } else { + return $request->to_hash(); + } } # @@ -368,12 +417,12 @@ sub get_service_id { # grade store). An existing secret past its expiration date # will be stored as oldsecret, and a new secret # 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) = @_; @@ -381,13 +430,13 @@ sub set_service_secret { my $warning; my ($needsnew,$oldsecret,$lifetime); if ($name eq 'grade') { - $lifetime = $ltitools->{'passbackvalid'} + $lifetime = $ltitools->{'passbackvalid'} * 86400; # convert days to seconds } elsif ($name eq 'roster') { $lifetime = $ltitools->{'rostervalid'}; } - if ($toolsettings->{$name} eq '') { + if ($toolsettings->{$name.'secret'} eq '') { $needsnew = 1; - } elsif (($toolsettings->{$name.'date'} + $lifetime) < $now) { + } elsif (($toolsettings->{$name.'secretdate'} + $lifetime) < $now) { $oldsecret = $toolsettings->{$name.'secret'}; $needsnew = 1; } @@ -423,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. # @@ -465,6 +514,47 @@ 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 # # Use the part of the launch URL after /adm/lti to determine @@ -487,16 +577,18 @@ sub lti_provider_scope { $scope = 'map'; $realuri = $tail; } 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); if ($url =~ /\.sequence$/) { $scope = 'map'; } else { $scope = 'resource'; - $realuri .= '?symb='.$tail; - $passkey = $tail; + $realuri .= '?symb='.$symb; + $passkey = $symb; if ($getunenc) { - $unencsymb = $tail; + $unencsymb = $symb; } } } @@ -506,16 +598,18 @@ sub lti_provider_scope { $scope = 'map'; $realuri = $tail; } 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); if ($url =~ /\.sequence$/) { $scope = 'map'; } else { $scope = 'resource'; - $realuri .= '?symb='.$tail; - $passkey = $tail; + $realuri .= '?symb='.$symb; + $passkey = $symb; if ($getunenc) { - $unencsymb = $tail; + $unencsymb = $symb; } } } @@ -561,7 +655,7 @@ sub lti_provider_scope { } elsif (($tail =~ m{^/$cdom/$cnum$}) || ($tail eq '')) { $scope = 'course'; $realuri = '/adm/navmaps'; - $passkey = $tail; + $passkey = ''; } if ($scope eq 'map') { $passkey = $realuri; @@ -573,15 +667,24 @@ 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 { - 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($_); @@ -631,8 +734,15 @@ sub get_roster { 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 { - my ($id,$url,$ckey,$secret,$scoretype,$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') { @@ -642,35 +752,141 @@ sub send_grade { $score = Math::Round::round($score); } else { $score = $total/$possible; - $score = sprintf("%.2f",$score); + $score = sprintf("%.4f",$score); } } - my $date = &Apache::loncommon::utc_string(time); - my %ltiparams = ( - lti_version => 'LTI-1p0', - lti_message_type => 'basic-lis-updateresult', - sourcedid => $id, - result_resultscore_textstring => $score, - result_resultscore_language => 'en-US', - result_resultvaluesourcedid => $scoretype, - result_statusofresult => 'final', - result_date => $date, - ); - my $hashref = &sign_params($url,$ckey,$secret,\%ltiparams); - if (ref($hashref) eq 'HASH') { - my $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}))); - my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10); - my $message=$response->status_line; + if ($sigmethod eq '') { + $sigmethod = 'HMAC-SHA1'; + } + my $request; + if ($msgformat eq '1.0') { + my $date = &Apache::loncommon::utc_string(time); + my %ltiparams = ( + lti_version => 'LTI-1p0', + lti_message_type => 'basic-lis-updateresult', + sourcedid => $id, + result_resultscore_textstring => $score, + result_resultscore_language => 'en-US', + result_resultvaluesourcedid => $scoretype, + result_statusofresult => 'final', + result_date => $date, + ); + 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($_); + "$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 = < + + + + V1.0 + $uniqmsgid + + + + + + + $id + + + + en + $score + + + + + + +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. + } + } +} + +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 +# 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 { my ($ltiref,$uname,$udom,$domdesc,$data,$alerts,$rulematch,$inst_results, $curr_rules,$got_rules) = @_; @@ -768,8 +984,17 @@ sub create_user { 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 { my $passwd = ''; + srand( time() ^ ($$ + ($$ << 15)) ); # Seed rand. my @letts = ("a".."z"); for (my $i=0; $i<8; $i++) { my $lettnum = int(rand(2)); @@ -788,8 +1013,20 @@ sub create_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 { - my ($udom,$uname,$role,$cdom,$cnum,$sec,$start,$end) = @_; + my ($udom,$uname,$role,$cdom,$cnum,$sec,$start,$end,$selfenroll) = @_; my $enrollresult; my $area = "/$cdom/$cnum"; if (($role ne 'cc') && ($role ne 'co') && ($sec ne '')) { @@ -801,32 +1038,85 @@ sub enrolluser { $enrollresult = &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef, undef,undef,$sec,$end,$start, - 'ltienroll',undef,$cdom.'_'.$cnum,undef, - 'ltienroll','',$instcid); + 'ltienroll',undef,$cdom.'_'.$cnum, + $selfenroll,'ltienroll','',$instcid); } elsif ($role =~ /^(cc|in|ta|ep)$/) { $enrollresult = &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; } +# +# 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 { 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') { @@ -845,8 +1135,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); @@ -1015,6 +1305,27 @@ sub batchaddroster { 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 { my ($rolestr,$allowedroles,$maproles) = @_; my (@ltiroles,@lcroles); @@ -1055,6 +1366,15 @@ sub get_lc_roles { 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 { my ($oldstart,$oldend,$startdate,$enddate) = @_; my $datechange = 0; @@ -1073,6 +1393,13 @@ sub datechange_check { 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 { my ($ltinum,$pburl,$cdom,$cnum) = @_; my %history = &Apache::lonnet::restore($ltinum,'passbackurl',$cdom,$cnum);