--- loncom/lti/ltiutils.pm 2019/07/18 18:28:46 1.17 +++ loncom/lti/ltiutils.pm 2022/01/03 18:35:27 1.17.2.1 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Utility functions for managing LON-CAPA LTI interactions # -# $Id: ltiutils.pm,v 1.17 2019/07/18 18:28:46 raeburn Exp $ +# $Id: ltiutils.pm,v 1.17.2.1 2022/01/03 18:35:27 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -31,16 +31,8 @@ package LONCAPA::ltiutils; use strict; use Net::OAuth; use Digest::SHA; -use Digest::MD5 qw(md5_hex); -use UUID::Tiny ':std'; use Apache::lonnet; use Apache::loncommon; -use Apache::loncoursedata; -use Apache::lonuserutils; -use Apache::lonenc(); -use Apache::longroup(); -use Apache::lonlocal; -use Math::Round(); use LONCAPA qw(:DEFAULT :match); # @@ -95,148 +87,6 @@ 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 -# external tool in the course. -# - -sub get_loncapa_course { - my ($lonhost,$cid,$errors) = @_; - return unless (ref($errors) eq 'HASH'); - my ($cdom,$cnum); - if ($cid =~ /^($match_domain)_($match_courseid)$/) { - my ($posscdom,$posscnum) = ($1,$2); - my $cprimary_id = &Apache::lonnet::domain($posscdom,'primary'); - if ($cprimary_id eq '') { - $errors->{5} = 1; - return; - } else { - my @intdoms; - my $internet_names = &Apache::lonnet::get_internet_names($lonhost); - if (ref($internet_names) eq 'ARRAY') { - @intdoms = @{$internet_names}; - } - my $cintdom = &Apache::lonnet::internet_dom($cprimary_id); - if (($cintdom ne '') && (grep(/^\Q$cintdom\E$/,@intdoms))) { - $cdom = $posscdom; - } else { - $errors->{6} = 1; - return; - } - } - my $chome = &Apache::lonnet::homeserver($posscnum,$posscdom); - if ($chome =~ /(con_lost|no_host|no_such_host)/) { - $errors->{7} = 1; - return; - } else { - $cnum = $posscnum; - } - } else { - $errors->{8} = 1; - return; - } - return ($cdom,$cnum); -} - -# -# 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 -# to retrieve a roster or store a grade. -# -# Use the digested symb to lookup the real symb in exttools.db -# and the digested userID to lookup the real userID (if needed). -# and extract the exttool instance and symb. -# - -sub get_tool_instance { - my ($cdom,$cnum,$digsymb,$diguser,$errors) = @_; - return unless (ref($errors) eq 'HASH'); - my ($marker,$symb,$uname,$udom); - my @keys = ($digsymb); - if ($diguser) { - push(@keys,$diguser); - } - my %digesthash = &Apache::lonnet::get('exttools',\@keys,$cdom,$cnum); - if ($digsymb) { - $symb = $digesthash{$digsymb}; - if ($symb) { - my ($map,$id,$url) = split(/___/,$symb); - $marker = (split(m{/},$url))[3]; - $marker=~s/\D//g; - } else { - $errors->{9} = 1; - } - } - if ($diguser) { - if ($digesthash{$diguser} =~ /^($match_username):($match_domain)$/) { - ($uname,$udom) = ($1,$2); - } else { - $errors->{10} = 1; - } - return ($marker,$symb,$uname,$udom); - } else { - return ($marker,$symb); - } -} - -# -# 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 -# tool in a LON-CAPA course. -# -# 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 -# contents of the .db file (instance of tool in course) and the -# $ltitools hashref with the configuration for the tool (at -# domain level). -# - -sub get_tool_secret { - my ($key,$marker,$symb,$cdom,$cnum,$toolsettings,$ltitools,$errors) = @_; - return unless ((ref($toolsettings) eq 'HASH') && (ref($ltitools) eq 'HASH') && - (ref($errors) eq 'HASH')); - my ($consumer_secret,$nonce_lifetime); - if ($marker) { - %{$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'}; - $nonce_lifetime = $ltitools->{'lifetime'}; - } else { - $errors->{11} = 1; - return; - } - } else { - $errors->{12} = 1; - return; - } - } else { - $errors->{13} = 1; - return; - } - } else { - $errors->{14}; - return; - } - return ($consumer_secret,$nonce_lifetime); -} - -# -# LON-CAPA as LTI Consumer -# # Verify a signed request using the consumer_key and # secret for the specific LTI Provider. # @@ -271,69 +121,6 @@ sub verify_request { # # LON-CAPA as LTI Consumer # -# Verify that an item identifier (either roster request: -# ext_ims_lis_memberships_id, or grade store: -# lis_result_sourcedid) has not been tampered with, and -# the secret used to create the unique identifier has not -# expired. -# -# Prepending the current secret (if still valid), -# or the previous secret (if current one is no longer valid), -# to a string composed of the :::-separated components -# must generate the result signature in the lis item ID -# sent by the Tool Provider. -# - -sub verify_lis_item { - my ($sigrec,$context,$digsymb,$diguser,$cdom,$cnum,$toolsettings,$ltitools,$errors) = @_; - 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'} * 86400; # convert days to seconds - } elsif ($context eq 'roster') { - $has_action = $ltitools->{'roster'}; - $valid_for = $ltitools->{'rostervalid'}; - } - if ($has_action) { - my $secret; - if (($toolsettings->{$context.'secretdate'} + $valid_for) > time) { - $secret = $toolsettings->{$context.'secret'}; - } else { - $secret = $toolsettings->{'old'.$context.'secret'}; - } - if ($secret) { - my $expected_sig; - if ($context eq 'grade') { - my $uniqid = $digsymb.':::'.$diguser.':::'.$cdom.'_'.$cnum; - $expected_sig = (split(/:::/,&get_service_id($secret,$uniqid)))[0]; - if ($expected_sig eq $sigrec) { - return 1; - } else { - $errors->{18} = 1; - } - } elsif ($context eq 'roster') { - my $uniqid = $digsymb.':::'.$cdom.'_'.$cnum; - $expected_sig = (split(/:::/,&get_service_id($secret,$uniqid)))[0]; - if ($expected_sig eq $sigrec) { - return 1; - } else { - $errors->{19} = 1; - } - } - } else { - $errors->{20} = 1; - } - } else { - $errors->{21} = 1; - } - return; -} - -# -# 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 # by the Tool Provider. @@ -374,164 +161,6 @@ sub sign_params { } # -# LON-CAPA as LTI Consumer -# -# Generate a signature for a unique identifier (roster request: -# ext_ims_lis_memberships_id, or grade store: lis_result_sourcedid) -# - -sub get_service_id { - my ($secret,$id) = @_; - my $sig = Digest::SHA::sha1_hex($secret.':::'.$id); - return $sig.':::'.$id; -} - -# -# LON-CAPA as LTI Consumer -# -# Generate and store the time-limited secret used to create the -# signature in a service request identifier (roster request or -# 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 -# (and are stored in the exttool_$marker db file). -# 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) = @_; - return unless ((ref($toolsettings) eq 'HASH') && (ref($ltitools) eq 'HASH')); - my $warning; - my ($needsnew,$oldsecret,$lifetime); - if ($name eq 'grade') { - $lifetime = $ltitools->{'passbackvalid'} * 86400; # convert days to seconds - } elsif ($name eq 'roster') { - $lifetime = $ltitools->{'rostervalid'}; - } - if ($toolsettings->{$name.'secret'} eq '') { - $needsnew = 1; - } elsif (($toolsettings->{$name.'secretdate'} + $lifetime) < $now) { - $oldsecret = $toolsettings->{$name.'secret'}; - $needsnew = 1; - } - if ($needsnew) { - if (&get_tool_lock($cdom,$cnum,$marker,$name,$now) eq 'ok') { - my $secret = UUID::Tiny::create_uuid_as_string(UUID_V4); - $toolsettings->{$name.'secret'} = $secret; - my %secrethash = ( - $name.'secret' => $secret, - $name.'secretdate' => $now, - ); - if ($oldsecret ne '') { - $secrethash{'old'.$name.'secret'} = $oldsecret; - } - my $putres = &Apache::lonnet::put('exttool_'.$marker, - \%secrethash,$cdom,$cnum); - my $delresult = &release_tool_lock($cdom,$cnum,$marker,$name); - if ($delresult ne 'ok') { - $warning = $delresult ; - } - if ($putres eq 'ok') { - return 'ok'; - } - } else { - $warning = 'Could not obtain exclusive lock'; - } - } else { - return 'ok'; - } - return; -} - -# -# LON-CAPA as LTI Consumer -# -# Add a lock key to exttools.db for the instance of an external tool -# when generating and storing a service secret. -# - -sub get_tool_lock { - my ($cdom,$cnum,$marker,$name,$now) = @_; - # get lock for tool for which secret is being set - my $lockhash = { - $name."\0".$marker."\0".'lock' => $now.':'.$env{'user.name'}. - ':'.$env{'user.domain'}, - }; - my $tries = 0; - my $gotlock = &Apache::lonnet::newput('exttools',$lockhash,$cdom,$cnum); - - while (($gotlock ne 'ok') && $tries <3) { - $tries ++; - sleep(1); - $gotlock = &Apache::lonnet::newput('exttools',$lockhash,$cdom,$cnum); - } - return $gotlock; -} - -# -# LON-CAPA as LTI Consumer -# -# Remove a lock key from exttools.db for the instance of an external -# tool created when generating and storing a service secret. -# - -sub release_tool_lock { - my ($cdom,$cnum,$marker,$name) = @_; - # remove lock - my @del_lock = ($name."\0".$marker."\0".'lock'); - my $dellockoutcome=&Apache::lonnet::del('exttools',\@del_lock,$cdom,$cnum); - if ($dellockoutcome ne 'ok') { - return 'Warning: failed to release lock for exttool'; - } else { - return 'ok'; - } -} - -# -# 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 @@ -644,180 +273,6 @@ 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 %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 $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 (($response->is_success) && ($response->content ne '')) { - my %data = (); - my $count = 0; - my @state = (); - my @items = ('user_id','roles','person_sourcedid','person_name_given','person_name_family', - 'person_contact_email_primary','person_name_full','lis_result_sourcedid'); - my $p = HTML::Parser->new - ( - xml_mode => 1, - start_h => - [sub { - my ($tagname, $attr) = @_; - push(@state,$tagname); - if ("@state" eq "message_response memberships member") { - $count ++; - } - }, "tagname, attr"], - text_h => - [sub { - my ($text) = @_; - foreach my $item (@items) { - if ("@state" eq "message_response memberships member $item") { - $data{$count}{$item} = $text; - } - } - }, "dtext"], - end_h => - [sub { - my ($tagname) = @_; - pop @state; - }, "tagname"], - ); - $p->parse($response->content); - $p->eof; - return %data; - } - } - 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,$sigmethod,$msgformat,$total,$possible) = @_; - my $score; - if ($possible > 0) { - if ($scoretype eq 'ratio') { - $score = Math::Round::round($total).'/'.Math::Round::round($possible); - } elsif ($scoretype eq 'percentage') { - $score = (100.0*$total)/$possible; - $score = Math::Round::round($score); - } else { - $score = $total/$possible; - $score = sprintf("%.2f",$score); - } - } - 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 $hashref = &sign_params($url,$ckey,$secret,\%ltiparams,$sigmethod); - if (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}))); - } - } 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 = < - - - - V1.0 - $uniqmsgid - - - - - - - $id - - - - en - $score - - - - - - -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. -} - sub setup_logout_callback { my ($uname,$udom,$server,$ckey,$secret,$service_url,$idsdir,$protocol,$hostname) = @_; if ($service_url =~ m{^https?://[^/]+/}) { @@ -1024,252 +479,6 @@ sub enrolluser { # # 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'); - my ($cdom,$cnum) = split(/_/,$item->{'cid'}); - my $udom = $cdom; - my $id = $item->{'id'}; - my $url = $item->{'url'}; - 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') { - undef($section); - } elsif ($section ne '') { - my %curr_groups = - &Apache::longroup::coursegroups($cdom,$cnum); - if (exists($curr_groups{$section})) { - undef($section); - } - } - my (%maproles,@possroles); - if (ref($item->{'ltiref'}->{'maproles'}) eq 'HASH') { - %maproles = %{$item->{'ltiref'}->{'maproles'}}; - } - 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 (keys(%data) > 0) { - my (%rulematch,%inst_results,%curr_rules,%got_rules,%alerts,%info); - my %coursehash = &Apache::lonnet::coursedescription($cdom.'_'.$cnum); - my $start = $coursehash{'default_enrollment_start_date'}; - my $end = $coursehash{'default_enrollment_end_date'}; - my $domdesc = &Apache::lonnet::domain($udom,'description'); - my $roster = &Apache::loncoursedata::get_classlist($cdom,$cnum); - my $status = &Apache::loncoursedata::CL_STATUS; - my $cend = &Apache::loncoursedata::CL_END; - my $cstart = &Apache::loncoursedata::CL_START; - my $lockedtype=&Apache::loncoursedata::CL_LOCKEDTYPE; - my $sec=&Apache::loncoursedata::CL_SECTION; - my (@activestudents,@futurestudents,@excludedstudents,@localstudents,%currlist,%advroles); - if (grep(/^st$/,@possroles)) { - foreach my $user (keys(%{$roster})) { - if ($user =~ m/^(.+):$cdom$/) { - my $stuname = $1; - if ($roster->{$user}[$status] eq "Active") { - push(@activestudents,$stuname); - @{$currlist{$stuname}} = @{$roster->{$user}}; - push(@localstudents,$stuname); - } elsif (($roster->{$user}[$cstart] > time) && ($roster->{$user}[$cend] > time || - $roster->{$user}[$cend] == 0 || $roster->{$user}[$cend] eq '')) { - push(@futurestudents,$stuname); - @{$currlist{$stuname}} = @{$roster->{$user}}; - push(@localstudents,$stuname); - } elsif ($roster->{$user}[$lockedtype] == 1) { - push(@excludedstudents,$stuname); - } - } - } - } - if ((@possroles > 1) || ((@possroles == 1) && (!grep(/^st$/,@possroles)))) { - my %personnel = &Apache::lonnet::get_course_adv_roles($item->{'cid'},1); - foreach my $item (keys(%personnel)) { - my ($role,$currsec) = split(/:/,$item); - if ($currsec eq '') { - $currsec = 'none'; - } - foreach my $user (split(/,/,$personnel{$item})) { - push(@{$advroles{$user}{$role}},$currsec); - } - } - } - if (($end == 0) || ($end > time) || (@localstudents > 0)) { - my (%passback,$pbnum,$numadv); - $numadv = 0; - foreach my $i (sort { $a <=> $b } keys(%data)) { - if (ref($data{$i}) eq 'HASH') { - my $entry = $data{$i}; - my $user = $entry->{'person_sourcedid'}; - my $uname; - if ($user =~ /^($match_username):($match_domain)$/) { - $uname = $1; - my $possudom = $2; - if ($possudom ne $udom) { - my $uintdom = &Apache::lonnet::domain($possudom,'primary'); - if (($uintdom ne '') && (grep(/^\Q$uintdom\E$/,@intdoms))) { - $udom = $possudom; - } - } - } elsif ($uname =~ /^match_username$/) { - $uname = $user; - } else { - next; - } - my $uhome = &Apache::lonnet::homeserver($uname,$udom); - if ($uhome eq 'no_host') { - my %data; - $data{'permanentemail'} = $entry->{'person_contact_email_primary'}; - $data{'lastname'} = $entry->{'person_name_family'}; - $data{'firstname'} = $entry->{'person_name_given'}; - $data{'fullname'} = $entry->{'person_name_full'}; - my $addresult = - &create_user($item->{'ltiref'},$uname,$udom, - $domdesc,\%data,\%alerts,\%rulematch, - \%inst_results,\%curr_rules,\%got_rules); - next unless ($addresult eq 'ok'); - } - if ($env{'request.lti.passbackurl'}) { - if ($entry->{'lis_result_sourcedid'} ne '') { - unless ($pbnum) { - ($pbnum,my $error) = &store_passbackurl($env{'request.lti.login'}, - $env{'request.lti.passbackurl'}, - $cdom,$cnum); - if ($pbnum eq '') { - $pbnum = $env{'request.lti.passbackurl'}; - } - } - $passback{$uname."\0".$uriscope."\0".$env{'request.lti.sourcecrs'}."\0".$env{'request.lti.login'}} = - $pbnum."\0".$entry->{'lis_result_sourcedid'}; - } - } - my $rolestr = $entry->{'roles'}; - my ($lcrolesref) = &get_lc_roles($rolestr,\@possroles,\%maproles); - my @lcroles = @{$lcrolesref}; - if (@lcroles) { - if (grep(/^st$/,@lcroles)) { - my $addstu; - if (!grep(/^\Q$uname\E$/,@excludedstudents)) { - if (grep(/^\Q$uname\E$/,@localstudents)) { -# Check for section changes - if ($currlist{$uname}[$sec] ne $section) { - $addstu = 1; - &Apache::lonuserutils::modifystudent($udom,$uname,$cdom.'_'.$cnum, - undef,undef,'course'); - } elsif (grep(/^\Q$uname\E$/,@futurestudents)) { -# Check for access date changes for students with access starting in the future. - my $datechange = &datechange_check($currlist{$uname}[$cstart], - $currlist{$uname}[$cend], - $start,$end); - if ($datechange) { - $addstu = 1; - } - } - } else { - $addstu = 1; - } - } - unless ($addstu) { - pop(@lcroles); - } - } - my @okroles; - if (@lcroles) { - foreach my $role (@lcroles) { - unless (($role eq 'st') || (keys(%advroles) == 0)) { - if (exists($advroles{$uname.':'.$udom})) { - if ((ref($advroles{$uname.':'.$udom}) eq 'HASH') && - (ref($advroles{$uname.':'.$udom}{$role}) eq 'ARRAY')) { - if (($section eq '') || ($role eq 'cc') || ($role eq 'co')) { - next if (grep(/^none$/,@{$advroles{$uname.':'.$udom}{$role}})); - } else { - next if (grep(/^\Q$sec\E$/,@{$advroles{$uname.':'.$udom}{$role}})); - } - } - } - } - push(@okroles,$role); - } - } - if (@okroles) { - my $permanentemail = $entry->{'person_contact_email_primary'}; - my $lastname = $entry->{'person_name_family'}; - my $firstname = $entry->{'person_name_given'}; - foreach my $role (@okroles) { - my $enrollresult = &enrolluser($udom,$uname,$role,$cdom,$cnum, - $section,$start,$end); - if (($enrollresult eq 'ok') && ($role ne 'st')) { - $numadv ++; - } - } - } - } - } - } - if (keys(%passback)) { - &Apache::lonnet::put('nohist_lti_passback',\%passback,$cdom,$cnum); - } - if ($numadv) { - &Apache::lonnet::flushcourselogs(); - } - } - } - } - return; -} - -# -# LON-CAPA as LTI Provider -# # Gather a list of available LON-CAPA roles derived # from a comma separated list of LTI roles. # @@ -1328,82 +537,4 @@ 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; - unless ($oldstart eq $startdate) { - $datechange = 1; - } - if (!$datechange) { - if (!$oldend) { - if ($enddate) { - $datechange = 1; - } - } elsif ($oldend ne $enddate) { - $datechange = 1; - } - } - 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); - my ($pbnum,$version,$error); - if ($history{'version'}) { - $version = $history{'version'}; - for (my $i=1; $i<=$version; $i++) { - if ($history{$i.':pburl'} eq $pburl) { - $pbnum = $i; - last; - } - } - } else { - $version = 0; - } - if ($pbnum eq '') { - # get lock on passbackurl db - my $now = time; - my $lockhash = { - 'lock'."\0".$ltinum."\0".$now => $env{'user.name'}.':'.$env{'user.domain'}, - }; - my $tries = 0; - my $gotlock = &Apache::lonnet::newput('passbackurl',$lockhash,$cdom,$cnum); - while (($gotlock ne 'ok') && ($tries<3)) { - $tries ++; - sleep 1; - $gotlock = &Apache::lonnet::newput('passbackurl',$lockhash,$cdom.$cnum); - } - if ($gotlock eq 'ok') { - if (&Apache::lonnet::store_userdata({pburl => $pburl}, - $ltinum,'passbackurl',$cdom,$cnum) eq 'ok') { - $pbnum = 1+$version; - } - my $dellock = &Apache::lonnet::del('passbackurl',['lock'."\0".$ltinum."\0".$now],$cdom,$cnum); - unless ($dellock eq 'ok') { - $error = &mt('error: could not release lockfile'); - } - } else { - $error = &mt('error: could not obtain lockfile'); - } - } - return ($pbnum,$error); -} - 1;