[LON-CAPA-cvs] cvs: doc /loncapafiles loncapafiles.lpml loncom loncapa_apache.conf loncom/interface lonexttool.pm loncom/lti ltiauth.pm ltiroster.pm ltiutils.pm
raeburn
raeburn at source.lon-capa.org
Thu Dec 7 10:36:51 EST 2017
raeburn Thu Dec 7 15:36:51 2017 EDT
Added files:
/loncom/lti ltiutils.pm ltiroster.pm
Modified files:
/loncom/lti ltiauth.pm
/loncom/interface lonexttool.pm
/loncom loncapa_apache.conf
/doc/loncapafiles loncapafiles.lpml
Log:
Bug 6754 LTI Integration
- ltiutils.pm contains common LTI routines (to facilitate re-use).
- &check_nonce() moved from ltiauth.pm to ltiutils.pm.
- &set_callback_secret() moved from lonexttool.pm to ltiutils.pm, and
renamed &set_service_secret().
- &sign_params(), &get_tool_lock(), and &release_tool_lock() moved from
lonexttool.pm to ltiutils.pm
- ltiroster.pm will service requests for course membership information
from an LTI Provider, where domain configuration for Tool permits this
service, and launch (by Instructor( included ext_ims_lis_memberships_id.
-------------- next part --------------
Index: loncom/lti/ltiauth.pm
diff -u loncom/lti/ltiauth.pm:1.1 loncom/lti/ltiauth.pm:1.2
--- loncom/lti/ltiauth.pm:1.1 Wed Dec 6 01:53:56 2017
+++ loncom/lti/ltiauth.pm Thu Dec 7 15:36:25 2017
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Basic LTI Authentication Module
#
-# $Id: ltiauth.pm,v 1.1 2017/12/06 01:53:56 raeburn Exp $
+# $Id: ltiauth.pm,v 1.2 2017/12/07 15:36:25 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -36,6 +36,7 @@
use Apache::lonnet;
use Apache::loncommon;
use Apache::lonacc;
+use LONCAPA::ltiutils;
sub handler {
my $r = shift;
@@ -240,13 +241,12 @@
$protocol = 'https';
}
- my $itemid;
- my $key = $params->{'oauth_consumer_key'};
- my @ltiroles;
+ my ($itemid,$key,$secret, at ltiroles);
+ $key = $params->{'oauth_consumer_key'};
if (ref($lti_by_key{$key}) eq 'ARRAY') {
foreach my $id (@{$lti_by_key{$key}}) {
if (ref($lti{$id}) eq 'HASH') {
- my $secret = $lti{$id}{'secret'};
+ $secret = $lti{$id}{'secret'};
my $request = Net::OAuth->request('request token')->from_hash($params,
request_url => $protocol.'://'.$hostname.$requri,
request_method => $env{'request.method'},
@@ -273,7 +273,8 @@
# Determine if nonce in POSTed data has expired.
# If unexpired, confirm it has not already been used.
#
- unless (&check_nonce($r,$params->{'oauth_nonce'},$params->{'oauth_timestamp'},$lti{$itemid}{'lifetime'},$cdom)) {
+ unless (&LONCAPA::ltiutils::check_nonce($params->{'oauth_nonce'},$params->{'oauth_timestamp'},
+ $lti{$itemid}{'lifetime'},$cdom,$r->dir_config('lonLTIDir'))) {
&invalid_request($r,7);
return OK;
}
@@ -609,35 +610,6 @@
return OK;
}
-sub check_nonce {
- my ($r,$nonce,$timestamp,$lifetime,$domain) = @_;
- if (($timestamp eq '') || ($timestamp =~ /^\D/) || ($lifetime eq '') || ($lifetime =~ /\D/) || ($domain eq '')) {
- return 0;
- }
- my $now = time;
- if (($timestamp) && ($timestamp < ($now - $lifetime))) {
- return 0;
- }
- if ($nonce eq '') {
- return 0;
- }
- my $lonltidir = $r->dir_config('lonLTIDir');
- if (-e "$lonltidir/$domain/$nonce") {
- return 0;
- } else {
- unless (-e "$lonltidir/$domain") {
- mkdir("$lonltidir/$domain",0755);
- }
- if (open(my $fh,'>',"$lonltidir/$domain/$nonce")) {
- print $fh $now;
- close($fh);
- } else {
- return 0;
- }
- }
- return 1;
-}
-
sub invalid_request {
my ($r,$num) = @_;
&Apache::loncommon::content_type($r,'text/html');
Index: loncom/interface/lonexttool.pm
diff -u loncom/interface/lonexttool.pm:1.8 loncom/interface/lonexttool.pm:1.9
--- loncom/interface/lonexttool.pm:1.8 Wed Dec 6 02:15:35 2017
+++ loncom/interface/lonexttool.pm Thu Dec 7 15:36:34 2017
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Launch External Tool Provider (LTI)
#
-# $Id: lonexttool.pm,v 1.8 2017/12/06 02:15:35 raeburn Exp $
+# $Id: lonexttool.pm,v 1.9 2017/12/07 15:36:34 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -43,14 +43,13 @@
use strict;
use Apache::Constants qw(:common :http);
-use Net::OAuth;
use Encode;
use Digest::SHA;
-use UUID::Tiny ':std';
use HTML::Entities;
use Apache::lonlocal;
use Apache::lonnet;
use Apache::loncommon;
+use LONCAPA::ltiutils;
sub handler {
my $r=shift;
@@ -114,14 +113,18 @@
} else {
my $now = time;
if ($toolhash{'passback'}) {
- unless (&set_callback_secret($cdom,$cnum,$marker,'grade',$now,
- \%toolsettings,\%toolhash) eq 'ok') {
+ if (&LONCAPA::ltiutils::set_service_secret($cdom,$cnum,$marker,'grade',$now,
+ \%toolsettings,\%toolhash) eq 'ok') {
+ $toolhash{'gradesecret'} = $toolsettings{'gradesecret'};
+ } else {
undef($launchok);
}
}
if ($toolhash{'roster'}) {
- &set_callback_secret($cdom,$cnum,$marker,'roster',$now,
- \%toolsettings,\%toolhash);
+ if (&LONCAPA::ltiutils::set_service_secret($cdom,$cnum,$marker,'roster',$now,
+ \%toolsettings,\%toolhash) eq 'ok') {
+ $toolhash{'rostersecret'} = $toolsettings{'rostersecret'};
+ }
}
my $submittext = &mt('Launch [_1]',$toolhash{'title'});
if (($toolhash{'key'} ne '') && ($toolhash{'secret'} ne '') &&
@@ -150,54 +153,6 @@
return OK;
}
-sub set_callback_secret {
- my ($cdom,$cnum,$marker,$name,$now,$toolsettings,$toolhash) = @_;
- return unless ((ref($toolsettings) eq 'HASH') && (ref($toolhash) eq 'HASH'));
- my $warning;
- my ($needsnew,$oldsecret,$lifetime);
- if ($name eq 'grade') {
- $lifetime = $toolhash->{'passbackvalid'}
- } elsif ($name eq 'roster') {
- $lifetime = $toolhash->{'rostervalid'};
- }
- if ($toolsettings->{$name} eq '') {
- $needsnew = 1;
- } elsif (($toolsettings->{$name.'date'} + $lifetime) < $now) {
- $oldsecret = $toolsettings->{$name.'secret'};
- $needsnew = 1;
- }
- if ($needsnew) {
- if (&get_tool_lock($cdom,$cnum,$marker,$now) eq 'ok') {
- my $secret = UUID::Tiny::create_uuid_as_string(UUID_V4);
- $toolhash->{$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);
- if ($delresult ne 'ok') {
- $warning = $delresult ;
- }
- if ($putres eq 'ok') {
- return 'ok';
- }
- } else {
- $warning = '<span class="LC_error">'.
- &mt('Could not obtain exclusive lock').
- '</span>';
- }
- } else {
- $toolhash->{$name.'secret'} = $toolsettings->{$name.'secret'};
- return 'ok';
- }
- return;
-}
-
sub lti_params {
my ($r,$cnum,$cdom,$idx,$submittext,$toolsref) = @_;
my ($version,$context_type,$msgtype,$toolname,$passback,$roster,$locale,
@@ -319,18 +274,16 @@
$ltiparams{'lis_outcome_service_url'} = $crsprotocol.'://'.$crshostname.'/adm/service/passback';
$ltiparams{'ext_ims_lis_basic_outcome_url'} = $ltiparams{'lis_outcome_service_url'};
if ($gradesecret) {
- my $result_sig =
- Digest::SHA::sha1_hex($gradesecret.':::'.$digest_symb.':::'.$digest_user.':::'.$env{'request.course.id'});
- $ltiparams{'lis_result_sourcedid'} =
- $result_sig.':::'.$digest_symb.':::'.$digest_user.':::'.$env{'request.course.id'};
+ my $uniqid = $digest_symb.':::'.$digest_user.':::'.$env{'request.course.id'};
+ $ltiparams{'lis_result_sourcedid'} = &LONCAPA::ltiutils::get_unique_callback($gradesecret,$uniqid);
}
}
if ($roster) {
if (&Apache::lonnet::allowed('opa',$env{'request.course.id'})) {
$ltiparams{'ext_ims_lis_memberships_url'} = $crsprotocol.'://'.$crshostname.'/adm/service/roster';
if ($rostersecret) {
- my $roster_sig = Digest::SHA::sha1_hex($rostersecret.':::'.$digest_symb.':::'.$env{'request.course.id'});
- $ltiparams{'ext_ims_lis_memberships_id'} = $roster_sig.':::'.$digest_symb.':::'.$env{'request.course.id'};
+ my $uniqid = $digest_symb.':::'.$env{'request.course.id'};
+ $ltiparams{'ext_ims_lis_memberships_id'} = &LONCAPA::ltiutils::get_unique_callback($rostersecret,$uniqid);
}
}
}
@@ -405,7 +358,7 @@
sub launch_html {
my ($url,$key,$secret,$submittext,$paramsref) = @_;
- my $hashref = &sign_params($url,$key,$secret,$paramsref);
+ my $hashref = &LONCAPA::ltiutils::sign_params($url,$key,$secret,$paramsref);
my $action = &HTML::Entities::encode($url,'<>&"');
my $form = <<"END";
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
@@ -439,57 +392,4 @@
return $form;
}
-sub sign_params {
- my ($url,$key,$secret,$paramsref) = @_;
- my $nonce = Digest::SHA::sha1_hex(sprintf("%06x%06x",rand(0xfffff0),rand(0xfffff0)));
-
- my $request = Net::OAuth->request("request token")->new(
- consumer_key => $key,
- consumer_secret => $secret,
- request_url => $url,
- request_method => 'POST',
- signature_method => 'HMAC-SHA1',
- timestamp => time,
- nonce => $nonce,
- callback => 'about:blank',
- extra_params => $paramsref,
- version => '1.0',
- );
- $request->sign;
- return $request->to_hash();
-}
-
-sub get_tool_lock {
- my ($cdom,$cnum,$marker,$now) = @_;
- # get lock for tool for which gradesecret is being set
- my $lockhash = {
- $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;
-}
-
-sub release_tool_lock {
- my ($cdom,$cnum,$marker) = @_;
- # remove lock
- my @del_lock = ($marker."\0".'lock');
- my $dellockoutcome=&Apache::lonnet::del('exttools',\@del_lock,$cdom,$cnum);
- if ($dellockoutcome ne 'ok') {
- return ('<div class="LC_error">'
- .&mt('Warning: failed to release lock for exttool: [_1].','<tt>'.$marker.'</tt>')
- .'</div>'
- );
- } else {
- return 'ok';
- }
-}
-
1;
Index: loncom/loncapa_apache.conf
diff -u loncom/loncapa_apache.conf:1.259 loncom/loncapa_apache.conf:1.260
--- loncom/loncapa_apache.conf:1.259 Thu Dec 7 15:21:25 2017
+++ loncom/loncapa_apache.conf Thu Dec 7 15:36:41 2017
@@ -2,7 +2,7 @@
## loncapa_apache.conf -- Apache HTTP LON-CAPA configuration file
##
-# $Id: loncapa_apache.conf,v 1.259 2017/12/07 15:21:25 raeburn Exp $
+# $Id: loncapa_apache.conf,v 1.260 2017/12/07 15:36:41 raeburn Exp $
#
# LON-CAPA Section (extensions to httpd.conf daemon configuration)
@@ -758,6 +758,11 @@
PerlHandler Apache::ltiauth
</LocationMatch>
+<Location /adm/service/roster>
+SetHandler perl-script
+PerlHandler Apache::ltiroster
+</Location>
+
<Location /adm/restrictedaccess>
PerlAccessHandler Apache::publiccheck
AuthType LONCAPA
Index: doc/loncapafiles/loncapafiles.lpml
diff -u doc/loncapafiles/loncapafiles.lpml:1.959 doc/loncapafiles/loncapafiles.lpml:1.960
--- doc/loncapafiles/loncapafiles.lpml:1.959 Wed Dec 6 01:54:14 2017
+++ doc/loncapafiles/loncapafiles.lpml Thu Dec 7 15:36:51 2017
@@ -2,7 +2,7 @@
"http://lpml.sourceforge.net/DTD/lpml.dtd">
<!-- loncapafiles.lpml -->
-<!-- $Id: loncapafiles.lpml,v 1.959 2017/12/06 01:54:14 raeburn Exp $ -->
+<!-- $Id: loncapafiles.lpml,v 1.960 2017/12/07 15:36:51 raeburn Exp $ -->
<!--
@@ -2531,7 +2531,7 @@
<target dist='default'>home/httpd/lib/perl/Apache/lonexttool.pm</target>
<categoryname>handler</categoryname>
<description>
-Handler to allow LON-CAPA to operate as an LTI Tool Consumer
+Handler to allow LON-CAPA to operate as an LTI Consumer
</description>
<status>works/unverified</status>
</file>
@@ -2545,6 +2545,24 @@
<status>works/unverified</status>
</file>
<file>
+<source>loncom/lti/ltiroster.pm</source>
+<target dist='default'>home/httpd/lib/perl/Apache/ltiroster.pm</target>
+<categoryname>handler</categoryname>
+<description>
+Handler to allow LON-CAPA to service roster requests, 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>
+<description>
+Common routines for LTI (Consumer or Provider)
+</description>
+<status>works/unverified</status>
+</file>
+<file>
<source>loncom/interface/lonpickcode.pm</source>
<target dist='default'>home/httpd/lib/perl/Apache/lonpickcode.pm</target>
<categoryname>handler</categoryname>
Index: loncom/lti/ltiutils.pm
+++ loncom/lti/ltiutils.pm
# The LearningOnline Network with CAPA
# Utility functions for managing LON-CAPA LTI interactions
#
# $Id: ltiutils.pm,v 1.1 2017/12/07 15:36:25 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 LONCAPA::ltiutils;
use strict;
use Net::OAuth;
use Digest::SHA;
use UUID::Tiny ':std';
use Apache::lonnet;
use Apache::loncommon;
use LONCAPA qw(:DEFAULT :match);
#
# LON-CAPA as LTI Consumer or LTI Provider
#
# Determine if a nonce in POSTed data has expired.
# If unexpired, confirm it has not already been used.
#
# 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
# 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:
# /adm/lti/ with LON-CAPA symb, map, or deep-link ID appended.
#
sub check_nonce {
my ($nonce,$timestamp,$lifetime,$domain,$ltidir) = @_;
if (($ltidir eq '') || ($timestamp eq '') || ($timestamp =~ /^\D/) ||
($lifetime eq '') || ($lifetime =~ /\D/) || ($domain eq '')) {
return;
}
my $now = time;
if (($timestamp) && ($timestamp < ($now - $lifetime))) {
return;
}
if ($nonce eq '') {
return;
}
if (-e "$ltidir/$domain/$nonce") {
return;
} else {
unless (-e "$ltidir/$domain") {
unless (mkdir("$ltidir/$domain",0755)) {
return;
}
}
if (open(my $fh,'>',"$ltidir/$domain/$nonce")) {
print $fh $now;
close($fh);
return 1;
}
}
return;
}
#
# 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$/, at 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.
#
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,);
unless ($request->verify()) {
$errors->{15} = 1;
return;
}
}
#
# 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'}
} 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 = &get_service_id($secret,$uniqid);
if ($expected_sig eq $sigrec) {
return 1;
} else {
$errors->{16} = 1;
}
} elsif ($context eq 'roster') {
my $uniqid = $digsymb.':::'.$cdom.'_'.$cnum;
$expected_sig = &get_service_id($secret,$uniqid);
if ($expected_sig eq $sigrec) {
return 1;
} else {
$errors->{17} = 1;
}
}
} else {
$errors->{18} = 1;
}
} else {
$errors->{19} = 1;
}
return;
}
#
# LON-CAPA as LTI Consumer
#
# Sign a request used to launch an instance of an external
# too in a LON-CAPA course, using the key and secret supplied
# by the Tool Provider.
#
sub sign_params {
my ($url,$key,$secret,$paramsref) = @_;
return unless (ref($paramsref) eq 'HASH');
my $nonce = Digest::SHA::sha1_hex(sprintf("%06x%06x",rand(0xfffff0),rand(0xfffff0)));
my $request = Net::OAuth->request("request token")->new(
consumer_key => $key,
consumer_secret => $secret,
request_url => $url,
request_method => 'POST',
signature_method => 'HMAC-SHA1',
timestamp => time,
nonce => $nonce,
callback => 'about:blank',
extra_params => $paramsref,
version => '1.0',
);
$request->sign;
return $request->to_hash();
}
#
# 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 old<service name>secret, and a new secret
# <service name>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'}
} elsif ($name eq 'roster') {
$lifetime = $ltitools->{'rostervalid'};
}
if ($toolsettings->{$name} eq '') {
$needsnew = 1;
} elsif (($toolsettings->{$name.'date'} + $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) = @_;
# 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';
}
}
1;
Index: loncom/lti/ltiroster.pm
+++ loncom/lti/ltiroster.pm
# The LearningOnline Network with CAPA
# LTI Consumer Module to respond to a course roster request.
#
# $Id: ltiroster.pm,v 1.1 2017/12/07 15:36:25 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::ltiroster;
use strict;
use Apache::Constants qw(:common :http);
use Encode;
use Digest::SHA;
use Apache::lonnet;
use Apache::loncommon;
use Apache::lonacc;
use Apache::loncoursedata;
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,\%errors);
return OK;
}
#
# Retrieve the signature, digested symb, and LON-CAPA courseID
# from the ext_ims_lis_memberships_id in the POSTed data
#
unless ($params->{'ext_ims_lis_memberships_id'}) {
$errors{2} = 1;
&invalid_request($r,\%errors);
return OK;
}
my ($rostersig,$digsymb,$cid) = split(/\Q:::\E/,$params->{'ext_ims_lis_memberships_id'});
unless ($rostersig && $digsymb && $cid) {
$errors{3} = 1;
&invalid_request($r,\%errors);
return OK;
}
my ($cdom,$cnum,$marker,$symb);
#
# 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) {
$errors{4} = 1;
&invalid_request($r,\%errors);
return OK;
}
#
# Use the digested symb to lookup the real symb in exttools.db
#
($marker,$symb) =
&LONCAPA::ltiutils::get_tool_instance($cdom,$cnum,$digsymb,undef,\%errors);
unless ($marker) {
$errors{5} = 1;
&invalid_request($r,\%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)) {
$errors{6} = 1;
&invalid_request($r,\%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'},
$nonce_lifetime,$cdom,$r->dir_config('lonLTIDir'))) {
$errors{7} = 1;
&invalid_request($r,\%errors);
return OK;
}
#
# Verify that the ext_ims_lis_memberships_id has not been tampered
# with, and the rostersecret used to create it is still valid.
#
unless (&LONCAPA::ltiutils::verify_lis_item($rostersig,'roster',$digsymb,undef,$cdom,$cnum,
\%toolsettings,\%ltitools,\%errors)) {
$errors{8} = 1;
&invalid_request($r,\%errors);
return OK;
}
#
# Retrieve users with active roles in course for all roles for which roles have been mapped
# in domain configuration for the Tool Provider requesting the roster.
#
my %maproles;
if (ref($ltitools{'roles'}) eq 'HASH') {
%maproles = %{$ltitools{'roles'}};
}
unless (keys(%maproles)) {
$errors{9} = 1;
&invalid_request($r,\%errors);
return OK;
}
my $crstype;
my @allroles = &Apache::lonuserutils::roles_by_context('course',0,$crstype);
my (%availableroles,$coursepersonnel,$includestudents,%userdata,
@needpersenv, at needstuenv,$needemail,$needfullname,$needuser,
$needroles,$needsresult,$gradesecret);
if ($ltitools{'passback'}) {
my $now = time;
if (&LONCAPA::ltiutils::set_service_secret($cdom,$cnum,$marker,'grade',$now,
\%toolsettings,\%ltitools) eq 'ok') {
if ($toolsettings{'gradesecret'} ne '') {
$needsresult = 1;
$gradesecret = $ltitools{'gradesecret'};
}
}
}
foreach my $role (@allroles) {
if (exists($maproles{$role})) {
$availableroles{$role} = 1;
if ($role eq 'st') {
$includestudents = 1;
} else {
$coursepersonnel = 1;
}
}
}
if (keys(%availableroles)) {
$needroles = 1;
}
if (ref($ltitools{'fields'}) eq 'HASH') {
foreach my $field (keys(%{$ltitools{'fields'}})) {
if (($field eq 'lastname') || ($field eq 'firstname')) {
push(@needstuenv,$field);
push(@needpersenv,$field);
} elsif ($field eq 'email') {
$needemail = 1;
push(@needpersenv,'permanentemail');
} elsif ($field eq 'fullname') {
$needfullname = 1;
} elsif ($field eq 'user') {
$needuser = 1;
}
}
}
my $statusidx = &Apache::loncoursedata::CL_STATUS();
my $emailidx = &Apache::loncoursedata::CL_PERMANENTEMAIL();
my %students;
if ($includestudents) {
my $classlist = &Apache::loncoursedata::get_classlist($cdom,$cnum);
if (ref($classlist) eq 'HASH') {
%students = %{$classlist};
}
}
&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-readmembershipsforcontext</lti_message_type>
<statusinfo>
<codemajor>Success</codemajor>
<severity>Status</severity>
<codeminor>fullsuccess</codeminor>
<description>Roster retrieved</description>
</statusinfo>
<memberships>
END
my %skipstu;
if ($coursepersonnel) {
my %personnel = &Apache::lonnet::get_my_roles($cnum,$cdom);
foreach my $key (sort(keys(%personnel))) {
my ($uname,$udom,$role) = split(/:/,$key);
if ($availableroles{$role}) {
$userdata{$uname.':'.$udom}{'ltiroles'}{$maproles{$role}} = 1;
}
}
foreach my $user (sort(keys(%userdata))) {
if (exists($students{$user})) {
$skipstu{$user} = 1;
}
$r->print(" <member>\n");
my ($uname,$udom) = split(/:/,$user);
my $digest_user = &Encode::decode_utf8($uname.':'.$udom);
$digest_user = &Digest::SHA::sha1_hex($digest_user);
$r->print(' <user_id>'.$digest_user.'</user_id>'."\n");
if (exists($students{$user})) {
if (ref($students{$user}) eq 'ARRAY') {
if ($students{$user}[$statusidx] eq 'Active') {
$userdata{$uname.':'.$udom}{'ltiroles'}{$maproles{'st'}} = 1;
}
}
}
if ($needroles) {
if (ref($userdata{$uname.':'.$udom}{'ltiroles'}) eq 'HASH') {
$r->print(' <roles>'.join(',',sort(keys(%{$userdata{$uname.':'.$udom}{'ltiroles'}}))).'</roles>'."\n");
} else {
$r->print(" <roles></roles>\n");
}
} else {
$r->print(" <roles></roles>\n");
}
if ($needuser) {
$r->print(' <person_sourcedid>'.$user.'</person_sourcedid>'."\n");
} else {
$r->print(" <person_sourcedid></person_sourcedid>\n");
}
my %userinfo;
if (@needpersenv) {
%userinfo = &Apache::lonnet::userenvironment($udom,$uname, at needpersenv);
}
foreach my $item ('firstname','lastname','permanentemail') {
my $info;
if ((@needpersenv) && (grep(/^\Q$item\E$/, at needpersenv))) {
$info = $userinfo{$item};
}
if ($item eq 'firstname') {
$r->print(' <person_name_given>'.$info.'</person_name_given>'."\n");
} elsif ($item eq 'lastname') {
$r->print(' <person_name_family>'.$info.'</person_name_family>'."\n");
} elsif ($item eq 'permanentemail') {
$r->print(' <person_contact_email_primary>'.$info.'</person_contact_email_primary>'."\n");
}
}
if ($needfullname) {
my $info = &Apache::loncommon::plainname($uname,$udom);
if ($info eq $uname.':'.$udom) {
$info = '';
}
$r->print(' <person_name_full>'.$info.'</person_name_full>'."\n");
} else {
$r->print(' <person_name_full></person_name_full>'."\n");
}
if ($needsresult) {
my $uniqid = $digsymb.':::'.$digest_user.':::'.$cid;
my $sourcedid = &LONCAPA::ltiutils::get_service_id($gradesecret,$uniqid);
$r->print(' <lis_result_sourcedid>'.$sourcedid.'</lis_result_sourcedid>'."\n");
} else {
$r->print(" <lis_result_sourcedid></lis_result_sourcedid>\n");
}
$r->print(" </member>\n");
}
}
if (($includestudents) && (keys(%students))) {
foreach my $user (keys(%students)) {
next if ($skipstu{$user});
if (ref($students{$user}) eq 'ARRAY') {
next unless ($students{$user}[$statusidx] eq 'Active');
$r->print(" <member>\n");
my ($uname,$udom) = split(/:/,$user);
my $digest_user = &Encode::decode_utf8($uname.':'.$udom);
$digest_user = &Digest::SHA::sha1_hex($digest_user);
$r->print(' <user_id>'.$digest_user.'</user_id>'."\n");
if ($needroles) {
$r->print(' <roles>'.$maproles{'st'}.'</roles>'."\n");
} else {
$r->print(" <roles></roles>\n");
}
if ($needuser) {
$r->print(' <person_sourcedid>'.$user.'</person_sourcedid>'."\n");
} else {
$r->print(" <person_sourcedid></person_sourcedid>\n");
}
my %userinfo;
if (@needstuenv) {
%userinfo = &Apache::lonnet::userenvironment($udom,$uname, at needstuenv);
}
foreach my $item ('firstname','lastname') {
my $info;
if ((@needstuenv) && (grep(/^\Q$item\E$/, at needstuenv))) {
$info = $userinfo{$item};
}
if ($item eq 'firstname') {
$r->print(' <person_name_given>'.$info.'</person_name_given>'."\n");
} elsif ($item eq 'lastname') {
$r->print(' <person_name_family>'.$info.'</person_name_family>'."\n");
}
}
if ($needemail) {
$r->print(' <person_contact_email_primary>'.$students{$user}[$emailidx].'</person_contact_email_primary>'."\n");
} else {
$r->print(' <person_contact_email_primary></person_contact_email_primary>'."\n");
}
if ($needfullname) {
my $info = &Apache::loncommon::plainname($uname,$udom);
if ($info eq $uname.':'.$udom) {
$info = '';
}
$r->print(' <person_name_full>'.$info.'</person_name_full>'."\n");
} else {
$r->print(' <person_name_full></person_name_full>'."\n");
}
if ($needsresult) {
my $uniqid = $digsymb.':::'.$digest_user.':::'.$cid;
my $sourcedid = &LONCAPA::ltiutils::get_service_id($gradesecret,$uniqid);
$r->print(' <lis_result_sourcedid>'.$sourcedid.'</lis_result_sourcedid>'."\n");
} else {
$r->print(" <lis_result_sourcedid></lis_result_sourcedid>\n");
}
$r->print(" </member>\n");
}
}
}
$r->print(<<"END");
</memberships>
</message_response>
END
return OK;
}
sub invalid_request {
my ($r,$errors) = @_;
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>
</message_response>
END
return;
}
1;
More information about the LON-CAPA-cvs
mailing list