[LON-CAPA-cvs] cvs: doc /loncapafiles loncapafiles.lpml loncom loncapa_apache.conf loncom/lti ltipassback.pm
raeburn
raeburn at source.lon-capa.org
Fri Dec 8 20:37:16 EST 2017
raeburn Sat Dec 9 01:37:16 2017 EDT
Added files:
/loncom/lti ltipassback.pm
Modified files:
/loncom loncapa_apache.conf
/doc/loncapafiles loncapafiles.lpml
Log:
- Bug 6754 LON-CAPA as LTI Consumer
- Providers can pass scores back to LTI 1.0 Extension (Outcomes Service).
-------------- next part --------------
Index: loncom/loncapa_apache.conf
diff -u loncom/loncapa_apache.conf:1.260 loncom/loncapa_apache.conf:1.261
--- loncom/loncapa_apache.conf:1.260 Thu Dec 7 15:36:41 2017
+++ loncom/loncapa_apache.conf Sat Dec 9 01:37:09 2017
@@ -2,7 +2,7 @@
## loncapa_apache.conf -- Apache HTTP LON-CAPA configuration file
##
-# $Id: loncapa_apache.conf,v 1.260 2017/12/07 15:36:41 raeburn Exp $
+# $Id: loncapa_apache.conf,v 1.261 2017/12/09 01:37:09 raeburn Exp $
#
# LON-CAPA Section (extensions to httpd.conf daemon configuration)
@@ -758,6 +758,11 @@
PerlHandler Apache::ltiauth
</LocationMatch>
+<Location /adm/service/passback>
+SetHandler perl-script
+PerlHandler Apache::ltipassback
+</Location>
+
<Location /adm/service/roster>
SetHandler perl-script
PerlHandler Apache::ltiroster
Index: doc/loncapafiles/loncapafiles.lpml
diff -u doc/loncapafiles/loncapafiles.lpml:1.960 doc/loncapafiles/loncapafiles.lpml:1.961
--- doc/loncapafiles/loncapafiles.lpml:1.960 Thu Dec 7 15:36:51 2017
+++ doc/loncapafiles/loncapafiles.lpml Sat Dec 9 01:37:15 2017
@@ -2,7 +2,7 @@
"http://lpml.sourceforge.net/DTD/lpml.dtd">
<!-- loncapafiles.lpml -->
-<!-- $Id: loncapafiles.lpml,v 1.960 2017/12/07 15:36:51 raeburn Exp $ -->
+<!-- $Id: loncapafiles.lpml,v 1.961 2017/12/09 01:37:15 raeburn Exp $ -->
<!--
@@ -2554,6 +2554,16 @@
<status>works/unverified</status>
</file>
<file>
+<source>loncom/lti/ltipassback.pm</source>
+<target dist='default'>home/httpd/lib/perl/Apache/ltipassback.pm</target>
+<categoryname>handler</categoryname>
+<description>
+Handler to allow LON-CAPA to service pass back of scores from a Tool Provider,
+as an LTI Consumer.
+</description>
+<status>works/unverified</status>
+</file>
+<file>
<source>loncom/lti/ltiutils.pm</source>
<target dist='default'>home/httpd/lib/perl/LONCAPA/ltiutils.pm</target>
<categoryname>system file</categoryname>
Index: loncom/lti/ltipassback.pm
+++ loncom/lti/ltipassback.pm
# The LearningOnline Network with CAPA
# LTI Consumer Module to receive grades passed back by Provider
#
# $Id: ltipassback.pm,v 1.1 2017/12/09 01:36:59 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
package Apache::ltipassback;
use strict;
use Apache::Constants qw(:common :http);
use Apache::lonnet;
use Apache::loncommon;
use Apache::lonacc;
use LONCAPA::ltiutils;
sub handler {
my $r = shift;
my %errors;
#
# Retrieve data POSTed by LTI Provider
#
&Apache::lonacc::get_posted_cgi($r);
my $params = {};
foreach my $key (sort(keys(%env))) {
if ($key =~ /^form\.(.+)$/) {
$params->{$1} = $env{$key};
}
}
unless (keys(%{$params})) {
$errors{1} = 1;
&invalid_request($r,$params,\%errors);
return OK;
}
unless ($params->{'oauth_consumer_key'} &&
$params->{'oauth_nonce'} &&
$params->{'oauth_timestamp'} &&
$params->{'oauth_version'} &&
$params->{'oauth_signature'} &&
$params->{'oauth_signature_method'}) {
$errors{2} = 1;
&invalid_request($r,$params,\%errors);
return OK;
}
#
# Retrieve the signature, digested symb, digested user, and LON-CAPA
# courseID from the sourcedid in the POSTed data
#
unless ($params->{'sourcedid'}) {
$errors{3} = 1;
&invalid_request($r,$params,\%errors);
return OK;
}
my ($resultsig,$digsymb,$diguser,$cid) = split(/\Q:::\E/,$params->{'sourcedid'});
unless ($resultsig && $digsymb && $diguser && $cid) {
$errors{4} = 1;
&invalid_request($r,$params,\%errors);
return OK;
}
my ($cdom,$cnum,$marker,$symb,$uname,$udom);
#
# Determine the domain and the courseID of the LON-CAPA course to which the
# launch of LON-CAPA should provide access.
#
($cdom,$cnum) = &LONCAPA::ltiutils::get_loncapa_course($r->dir_config('lonHostID'),
$cid,\%errors);
unless ($cdom && $cnum) {
&invalid_request($r,$params,\%errors);
return OK;
}
#
# Use the digested symb to lookup the real symb in exttools.db
#
($marker,$symb,$uname,$udom) =
&LONCAPA::ltiutils::get_tool_instance($cdom,$cnum,$digsymb,$diguser,\%errors);
unless ($marker) {
&invalid_request($r,$params,\%errors);
return OK;
}
#
# Retrieve the Consumer key and Consumer secret from the domain configuration
# for the Tool Provider ID stored in the exttool_$marker.db
#
my (%toolsettings,%ltitools);
my ($consumer_secret,$nonce_lifetime) =
&LONCAPA::ltiutils::get_tool_secret($params->{'oauth_consumer_key'},
$marker,$symb,$cdom,$cnum,
\%toolsettings,\%ltitools,\%errors);
#
# Verify the signed request using the consumer_key and
# secret for the specific LTI Provider.
#
my $protocol = 'http';
if ($ENV{'SERVER_PORT'} == 443) {
$protocol = 'https';
}
unless (LONCAPA::ltiutils::verify_request($params,$protocol,$r->hostname,$r->uri,
$env{'request.method'},$consumer_secret,
\%errors)) {
&invalid_request($r,$params,\%errors);
return OK;
}
#
# Determine if nonce in POSTed data has expired.
# If unexpired, confirm it has not already been used.
unless (&LONCAPA::ltiutils::check_nonce($params->{'oauth_nonce'},$params->{'oauth_timestamp'},
$ltitools{'lifetime'},$cdom,$r->dir_config('lonLTIDir'))) {
$errors{15} = 1;
&invalid_request($r,$params,\%errors);
return OK;
}
#
# Verify that the sourcedid has not been tampered with,
# and the gradesecret used to create it is still valid.
#
unless (&LONCAPA::ltiutils::verify_lis_item($resultsig,'grade',$digsymb,$diguser,$cdom,
$cnum,\%toolsettings,\%ltitools,\%errors)) {
&invalid_request($r,$params,\%errors);
return OK;
}
#
# Does the user have an active role in the course which maps to one of
# the supported LTI roles
#
if (($uname ne '') && ($udom ne '')) {
my %maproles;
if (ref($ltitools{'roles'}) eq 'HASH') {
%maproles = %{$ltitools{'roles'}};
}
unless (keys(%maproles)) {
$errors{20} = 1;
&invalid_request($r,$params,\%errors);
return OK;
}
my ($crstype,$hasrole);
my @allroles = &Apache::lonuserutils::roles_by_context('course',0,$crstype);
my (%availableroles,$coursepersonnel,$includestudents,%users);
foreach my $role (@allroles) {
if (exists($maproles{$role})) {
$availableroles{$role} = 1;
if ($role eq 'st') {
$includestudents = 1;
} else {
$coursepersonnel = 1;
}
}
}
if (keys(%availableroles)) {
my $courseurl = "/$cdom/$cnum";
my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname,$courseurl);
if (keys(%roleshash)) {
my $now = time;
foreach my $key (keys(%roleshash)) {
if ($key =~ m{^\Q$courseurl\E(|/\w+)_(\w+)$}) {
my ($secgroup,$rolecode) = ($1,$2);
next if ($rolecode eq 'gr');
next unless ($availableroles{$rolecode});
my ($dummy,$end,$start)=split(/\_/,$roleshash{$key});
next if (defined($end) && $end && ($now > $end));
next if (defined($start) && $start && ($now < $start));
$hasrole = 1;
last;
}
}
}
}
unless ($hasrole) {
$errors{21} = 1;
&invalid_request($r,$params,\%errors);
return OK;
}
} else {
$errors{22} = 1;
&invalid_request($r,$params,\%errors);
return OK;
}
#
# Store result if one was sent in a valid format.
#
my ($result,$resulttype,$lang,$pcf);
if (exists($params->{'result_resultvaluesourcedid'})) {
$resulttype = 'decimal';
} else {
$resulttype = $params->{'result_resultvaluesourcedid'};
$resulttype =~ s/(^\s+|\s+)$//g;
}
$result = $params->{'result_resultscore_textstring'};
$result =~ s/(^\s+|\s+)$//g;
my $posslang = $params->{'result_resultscore_language'};
$posslang =~ s/(^\s+|\s+)$//g;
if ($posslang =~ /^\w+(|\-\w+(|\-w+))$/) {
$lang = $posslang;
}
if (($resulttype eq 'ratio') || ($resulttype eq 'decimal') || ($resulttype eq 'percentage')) {
if ($resulttype eq 'ratio') {
my ($numerator,$denominator) = split(/\s*\/\s*/,$result,2);
$numerator =~ s/(^\s+|\s+)$//g;
$denominator =~ s/(^\s+|\s+)$//g;
if (($numerator =~ /^\d+$/) && ($denominator =~ /^\d+$/) && ($denominator !=0)) {
eval {
$pcf = $numerator/$denominator;
};
}
if ($@) {
$errors{22} = 1;
&invalid_request($r,$params,\%errors);
return OK;
}
} elsif ($resulttype eq 'decimal') {
if (($result ne '') && ($result =~ /^\d*\.?\d*$/)) {
if ($result eq '.') {
$result = 0;
}
if (($result >= 0) && ($result <= 1)) {
$pcf = $result;
}
}
} elsif ($resulttype eq 'percentage') {
if ($result =~ /^(\d+)\s*\%?$/) {
my $percent = $1;
if (($percent >= 0) && ($percent <= 100)) {
$pcf = $percent/100.0;
}
}
}
if ($pcf ne '') {
my %newrecord=();
my $reckey = 'resource.0.solved';
my %record = &Apache::lonnet::restore($symb,$cdom.'_'.$cnum,$udom,$uname);
if ($record{'resource.0.awarded'} ne $pcf) {
$newrecord{'resource.0.awarded'} = $pcf;
}
if ($pcf == 0) {
if ($record{$reckey} ne 'incorrect_by_override') {
$newrecord{$reckey} = 'incorrect_by_override';
}
} else {
if ($record{$reckey} ne 'correct_by_override') {
$newrecord{$reckey} = 'correct_by_override';
}
}
if (%newrecord) {
my $result = &Apache::lonnet::cstore(\%newrecord,$symb,$cdom.'_'.$cnum,
$udom,$uname);
if (($result eq 'ok') || ($result eq 'con_delayed')) {
&success($r,$params->{'sourcedid'},$resulttype,$result,$lang);
} else {
$errors{23} = 1;
&invalid_request($r,$params,\%errors);
}
}
} else {
$errors{24} = 1;
&invalid_request($r,$params,\%errors);
}
} else {
$errors{25} = 1;
&invalid_request($r,$params,\%errors);
}
return OK;
}
sub success {
my ($r,$sourcedid,$scoretype,$score,$lang) = @_;
my $date = &Apache::loncommon::utc_string(time);
&Apache::loncommon::content_type($r,'text/xml');
$r->send_http_header;
if ($r->header_only) {
return;
}
$r->print(<<"END");
<?xml version="1.0" encoding="UTF-8" ?>
<message_response>
<lti_message_type>basic-lis-updateresult</lti_message_type>
<statusinfo>
<codemajor>Success</codemajor>
<severity>Status</severity>
<codeminor>fullsuccess</codeminor>
<description>Grade updated</description>
</statusinfo>
<result>
<sourcedid>$sourcedid</sourcedid>
<date>$date</date>
<resultscore>
<resultvaluesourcedid>$scoretype</resultvaluesourcedid>
<textstring>$score</textstring>
<language>$lang</language>
</resultscore>
</result>
</message_response>
END
return;
}
sub invalid_request {
my ($r,$params,$errors) = @_;
my $date = &Apache::loncommon::utc_string(time);
my ($scoretype,$score,$lang);
if (ref($params) eq 'HASH') {
if ($params->{'result_resultvaluesourcedid'} =~ /^\s*(decimal|percentage|ratio)\s*$/) {
$scoretype = $1;
}
if ($scoretype eq 'decimal') {
if ($params->{'result_resultscore_textstring'} =~ /^\s*(\d*\.?\d*)\s*$/) {
$score = $1;
}
} elsif ($scoretype eq 'ratio') {
if ($params->{'result_resultscore_textstring'} =~ m{^\s*(\d+)\s*/\s*(\d+)\s*$}) {
$score = $1.'/'.$2;
}
} elsif ($scoretype eq 'percentage') {
if ($params->{'result_resultscore_textstring'} =~ /^\s*(\d+)\s*(\%?)\s*$/) {
$score = $1.$2;
}
}
my $posslang = $params->{'result_resultscore_language'};
$posslang =~ s/(^\s+|\s+)$//g;
if ($posslang =~ /^\w+(|\-\w+(|\-w+))$/) {
$lang = $posslang;
}
}
my $errormsg;
if (ref($errors) eq 'HASH') {
$errormsg = join(',',keys(%{$errors}));
}
&Apache::loncommon::content_type($r,'text/xml');
$r->send_http_header;
if ($r->header_only) {
return;
}
$r->print(<<"END");
<message_response>
<lti_message_type>basic-lis-updateresult</lti_message_type>
<statusinfo>
<codemajor>Failure</codemajor>
<severity>Error</severity>
<codeminor>$errormsg</codeminor>
</statusinfo>
<result>
<sourcedid>$params->{'sourcedid'}</sourcedid>
<statusofresult>interim</statusofresult>
<date>$date</date>
<resultscore>
<resultvaluesourcedid>$scoretype</resultvaluesourcedid>
<textstring>$score</textstring>
<language>$lang</language>
</resultscore>
</result>
</message_response>
END
return;
}
1;
More information about the LON-CAPA-cvs
mailing list