[LON-CAPA-cvs] cvs: loncom /auth lonroles.pm /lonnet/perl lonnet.pm /lti ltiauth.pm ltiutils.pm
raeburn
raeburn at source.lon-capa.org
Mon May 28 19:26:22 EDT 2018
raeburn Mon May 28 23:26:22 2018 EDT
Modified files:
/loncom/lti ltiutils.pm ltiauth.pm
/loncom/auth lonroles.pm
/loncom/lonnet/perl lonnet.pm
Log:
- Bug 6754 LON-CAPA as LTI Provider
- Support LTI Extension: Context Memberships Service, whereby launch of
Consumer can trigger Provider to request course roster.
- Code moved from ltiauth.pm to routines in ltiutils.pm:
&get_lc_roles(), &create_user() and &enrolluser(); &create_passwd() routine
also moved.
- Code moved from &parse_roster() to &get_roster() in ltiutils.pm.
- New routines: &batchaddroster(), &datechange_check(), &store_passbackurl()
added to support roster updates, (including saving user-specific values
for: lis_result_sourcedid, used for passback of grades to Consumer.
-------------- next part --------------
Index: loncom/lti/ltiutils.pm
diff -u loncom/lti/ltiutils.pm:1.10 loncom/lti/ltiutils.pm:1.11
--- loncom/lti/ltiutils.pm:1.10 Tue May 15 04:59:22 2018
+++ loncom/lti/ltiutils.pm Mon May 28 23:26:04 2018
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Utility functions for managing LON-CAPA LTI interactions
#
-# $Id: ltiutils.pm,v 1.10 2018/05/15 04:59:22 raeburn Exp $
+# $Id: ltiutils.pm,v 1.11 2018/05/28 23:26:04 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -34,6 +34,10 @@
use UUID::Tiny ':std';
use Apache::lonnet;
use Apache::loncommon;
+use Apache::loncoursedata;
+use Apache::lonuserutils;
+use Apache::lonenc();
+use Apache::longroup();
use Math::Round();
use LONCAPA qw(:DEFAULT :match);
@@ -569,6 +573,64 @@
}
}
+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;
+}
+
sub send_grade {
my ($id,$url,$ckey,$secret,$scoretype,$total,$possible) = @_;
my $score;
@@ -609,4 +671,450 @@
}
}
+sub create_user {
+ my ($ltiref,$uname,$udom,$domdesc,$data,$alerts,$rulematch,$inst_results,
+ $curr_rules,$got_rules) = @_;
+ return unless (ref($ltiref) eq 'HASH');
+ my $checkhash = { "$uname:$udom" => { 'newuser' => 1, }, };
+ my $checks = { 'username' => 1, };
+ my ($lcauth,$lcauthparm);
+ &Apache::loncommon::user_rule_check($checkhash,$checks,$alerts,$rulematch,
+ $inst_results,$curr_rules,$got_rules);
+ my ($userchkmsg,$lcauth,$lcauthparm);
+ my $allowed = 1;
+ if (ref($alerts->{'username'}) eq 'HASH') {
+ if (ref($alerts->{'username'}{$udom}) eq 'HASH') {
+ if ($alerts->{'username'}{$udom}{$uname}) {
+ if (ref($curr_rules->{$udom}) eq 'HASH') {
+ $userchkmsg =
+ &Apache::loncommon::instrule_disallow_msg('username',$domdesc,1).
+ &Apache::loncommon::user_rule_formats($udom,$domdesc,
+ $curr_rules->{$udom}{'username'},
+ 'username');
+ }
+ $allowed = 0;
+ }
+ }
+ }
+ if ($allowed) {
+ if (ref($rulematch->{$uname.':'.$udom}) eq 'HASH') {
+ my $matchedrule = $rulematch->{$uname.':'.$udom}{'username'};
+ my ($rules,$ruleorder) =
+ &Apache::lonnet::inst_userrules($udom,'username');
+ if (ref($rules) eq 'HASH') {
+ if (ref($rules->{$matchedrule}) eq 'HASH') {
+ $lcauth = $rules->{$matchedrule}{'authtype'};
+ $lcauthparm = $rules->{$matchedrule}{'authparm'};
+ }
+ }
+ }
+ if ($lcauth eq '') {
+ $lcauth = $ltiref->{'lcauth'};
+ if ($lcauth eq 'internal') {
+ $lcauthparm = &create_passwd();
+ } else {
+ $lcauthparm = $ltiref->{'lcauthparm'};
+ }
+ }
+ } else {
+ return 'notallowed';
+ }
+ my @userinfo = ('firstname','middlename','lastname','generation','permanentemail','id');
+ my (%useinstdata,%info);
+ if (ref($ltiref->{'instdata'}) eq 'ARRAY') {
+ map { $useinstdata{$_} = 1; } @{$ltiref->{'instdata'}};
+ }
+ foreach my $item (@userinfo) {
+ if (($useinstdata{$item}) && (ref($inst_results->{$uname.':'.$udom}) eq 'HASH') &&
+ ($inst_results->{$uname.':'.$udom}{$item} ne '')) {
+ $info{$item} = $inst_results->{$uname.':'.$udom}{$item};
+ } else {
+ if ($item eq 'permanentemail') {
+ if ($data->{'permanentemail'} =~/^[^\@]+\@[^@]+$/) {
+ $info{$item} = $data->{'permanentemail'};
+ }
+ } elsif (($item eq 'firstname') || ($item eq 'lastname')) {
+ $info{$item} = $data->{$item};
+ }
+ }
+ }
+ if (($info{'middlename'} eq '') && ($data->{'fullname'} ne '')) {
+ unless ($useinstdata{'middlename'}) {
+ my $fullname = $data->{'fullname'};
+ if ($info{'firstname'}) {
+ $fullname =~ s/^\s*\Q$info{'firstname'}\E\s*//i;
+ }
+ if ($info{'lastname'}) {
+ $fullname =~ s/\s*\Q$info{'lastname'}\E\s*$//i;
+ }
+ if ($fullname ne '') {
+ $fullname =~ s/^\s+|\s+$//g;
+ if ($fullname ne '') {
+ $info{'middlename'} = $fullname;
+ }
+ }
+ }
+ }
+ if (ref($inst_results->{$uname.':'.$udom}{'inststatus'}) eq 'ARRAY') {
+ my @inststatuses = @{$inst_results->{$uname.':'.$udom}{'inststatus'}};
+ $info{'inststatus'} = join(':',map { &escape($_); } @inststatuses);
+ }
+ my $result =
+ &Apache::lonnet::modifyuser($udom,$uname,$info{'id'},
+ $lcauth,$lcauthparm,$info{'firstname'},
+ $info{'middlename'},$info{'lastname'},
+ $info{'generation'},undef,undef,
+ $info{'permanentemail'},$info{'inststatus'});
+ return $result;
+}
+
+sub create_passwd {
+ my $passwd = '';
+ my @letts = ("a".."z");
+ for (my $i=0; $i<8; $i++) {
+ my $lettnum = int(rand(2));
+ my $item = '';
+ if ($lettnum) {
+ $item = $letts[int(rand(26))];
+ my $uppercase = int(rand(2));
+ if ($uppercase) {
+ $item =~ tr/a-z/A-Z/;
+ }
+ } else {
+ $item = int(rand(10));
+ }
+ $passwd .= $item;
+ }
+ return ($passwd);
+}
+
+sub enrolluser {
+ my ($udom,$uname,$role,$cdom,$cnum,$sec,$start,$end) = @_;
+ my $enrollresult;
+ my $area = "/$cdom/$cnum";
+ if (($role ne 'cc') && ($role ne 'co') && ($sec ne '')) {
+ $area .= '/'.$sec;
+ }
+ my $spec = $role.'.'.$area;
+ my $instcid;
+ if ($role eq 'st') {
+ $enrollresult =
+ &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,
+ undef,undef,$sec,$end,$start,
+ 'ltienroll',undef,$cdom.'_'.$cnum,undef,
+ 'ltienroll','',$instcid);
+ } elsif ($role =~ /^(cc|in|ta|ep)$/) {
+ $enrollresult =
+ &Apache::lonnet::assignrole($udom,$uname,$area,$role,$end,$start,
+ undef,undef,'ltienroll');
+ }
+ return $enrollresult;
+}
+
+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, at 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, at futurestudents, at excludedstudents, at localstudents,%currlist,%advroles);
+ if (grep(/^st$/, at 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$/, at 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$/, at 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$/, at lcroles)) {
+ my $addstu;
+ if (!grep(/^\Q$uname\E$/, at excludedstudents)) {
+ if (grep(/^\Q$uname\E$/, at 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$/, at 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;
+}
+
+sub get_lc_roles {
+ my ($rolestr,$allowedroles,$maproles) = @_;
+ my (@ltiroles, at lcroles);
+ my @ltiroleorder = ('Instructor','TeachingAssistant','Mentor','Learner');
+ if ($rolestr =~ /,/) {
+ my @possltiroles = split(/\s*,\s*/,$rolestr);
+ foreach my $ltirole (@ltiroleorder) {
+ if (grep(/^\Q$ltirole\E$/, at possltiroles)) {
+ push(@ltiroles,$ltirole);
+ }
+ }
+ } else {
+ my $singlerole = $rolestr;
+ $singlerole =~ s/^\s|\s+$//g;
+ if ($singlerole ne '') {
+ if (grep(/^\Q$singlerole\E$/, at ltiroleorder)) {
+ @ltiroles = ($singlerole);
+ }
+ }
+ }
+ if (@ltiroles) {
+ my %possroles;
+ map { $possroles{$maproles->{$_}} = 1; } @ltiroles;
+ if (keys(%possroles) > 0) {
+ if (ref($allowedroles) eq 'ARRAY') {
+ foreach my $item (@{$allowedroles}) {
+ if (($item eq 'co') || ($item eq 'cc')) {
+ if ($possroles{'cc'}) {
+ push(@lcroles,$item);
+ }
+ } elsif ($possroles{$item}) {
+ push(@lcroles,$item);
+ }
+ }
+ }
+ }
+ }
+ return (\@lcroles,\@ltiroles);
+}
+
+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;
+}
+
+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;
Index: loncom/lti/ltiauth.pm
diff -u loncom/lti/ltiauth.pm:1.12 loncom/lti/ltiauth.pm:1.13
--- loncom/lti/ltiauth.pm:1.12 Mon May 14 20:10:15 2018
+++ loncom/lti/ltiauth.pm Mon May 28 23:26:04 2018
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Basic LTI Authentication Module
#
-# $Id: ltiauth.pm,v 1.12 2018/05/14 20:10:15 raeburn Exp $
+# $Id: ltiauth.pm,v 1.13 2018/05/28 23:26:04 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -434,35 +434,14 @@
#
my (@ltiroles, at lcroles);
-
my @lcroleorder = ('cc','in','ta','ep','st');
- my @ltiroleorder = ('Instructor','TeachingAssistant','Mentor','Learner');
- if ($params->{'roles'} =~ /,/) {
- my @possltiroles = split(/\s*,\s*/,$params->{'roles'});
- foreach my $ltirole (@ltiroleorder) {
- if (grep(/^\Q$ltirole\E$/, at possltiroles)) {
- push(@ltiroles,$ltirole);
- }
- }
- } else {
- my $singlerole = $params->{'roles'};
- $singlerole =~ s/^\s|\s+$//g;
- if (grep(/^\Q$singlerole\E$/, at ltiroleorder)) {
- @ltiroles = ($singlerole);
- }
+ my ($lcrolesref,$ltirolesref) = &LONCAPA::ltiutils::get_lc_roles($params->{'roles'},
+ \@lcroleorder);
+ if (ref($lcrolesref) eq 'ARRAY') {
+ @lcroles = @{$lcrolesref};
}
- if (@ltiroles) {
- if (ref($lti{$itemid}{maproles}) eq 'HASH') {
- my %possroles;
- map { $possroles{$lti{$itemid}{maproles}{$_}} = 1; } @ltiroles;
- if (keys(%possroles) > 0) {
- foreach my $item (@lcroleorder) {
- if ($possroles{$item}) {
- push(@lcroles,$item);
- }
- }
- }
- }
+ if (ref($ltirolesref) eq 'ARRAY') {
+ @ltiroles = @{$ltirolesref};
}
#
@@ -485,102 +464,21 @@
}
}
if ($selfcreate) {
- my (%rulematch,%inst_results,%curr_rules,%got_rules,%alerts,%info);
- my $checkhash = { "$uname:$udom" => { 'newuser' => 1, }, };
- my $checks = { 'username' => 1, };
- &Apache::loncommon::user_rule_check($checkhash,$checks,\%alerts,\%rulematch,
- \%inst_results,\%curr_rules,\%got_rules);
- my ($userchkmsg,$lcauth,$lcauthparm);
- my $allowed = 1;
- if (ref($alerts{'username'}) eq 'HASH') {
- if (ref($alerts{'username'}{$udom}) eq 'HASH') {
- my $domdesc =
- &Apache::lonnet::domain($udom,'description');
- if ($alerts{'username'}{$udom}{$uname}) {
- if (ref($curr_rules{$udom}) eq 'HASH') {
- $userchkmsg =
- &Apache::loncommon::instrule_disallow_msg('username',$domdesc,1).
- &Apache::loncommon::user_rule_formats($udom,$domdesc,
- $curr_rules{$udom}{'username'},
- 'username');
- }
- $allowed = 0;
- }
- }
- }
- if ($allowed) {
- if (ref($rulematch{$uname.':'.$udom}) eq 'HASH') {
- my $matchedrule = $rulematch{$uname.':'.$udom}{'username'};
- my ($rules,$ruleorder) =
- &Apache::lonnet::inst_userrules($udom,'username');
- if (ref($rules) eq 'HASH') {
- if (ref($rules->{$matchedrule}) eq 'HASH') {
- $lcauth = $rules->{$matchedrule}{'authtype'};
- $lcauthparm = $rules->{$matchedrule}{'authparm'};
- }
- }
- }
- if ($lcauth eq '') {
- $lcauth = $lti{$itemid}{'lcauth'};
- if ($lcauth eq 'internal') {
- $lcauthparm = &create_passwd();
- } else {
- $lcauthparm = $lti{$itemid}{'lcauthparm'};
- }
- }
- } else {
- &invalid_request($r,12);
- }
- my @userinfo = ('firstname','middlename','lastname','generation',
- 'permanentemail','id');
- my %useinstdata;
- if (ref($lti{$itemid}{'instdata'}) eq 'ARRAY') {
- map { $useinstdata{$_} = 1; } @{$lti{$itemid}{'instdata'}};
- }
- foreach my $item (@userinfo) {
- if (($useinstdata{$item}) && (ref($inst_results{$uname.':'.$udom}) eq 'HASH') &&
- ($inst_results{$uname.':'.$udom}{$item} ne '')) {
- $info{$item} = $inst_results{$uname.':'.$udom}{$item};
- } else {
- if ($item eq 'permanentemail') {
- if ($env{'form.lis_person_contact_email_primary'} =~/^[^\@]+\@[^@]+$/) {
- $info{$item} = $env{'form.lis_person_contact_email_primary'};
- }
- } elsif ($item eq 'firstname') {
- $info{$item} = $env{'form.lis_person_name_given'};
- } elsif ($item eq 'lastname') {
- $info{$item} = $env{'form.lis_person_name_family'};
- }
- }
- }
- if (($info{'middlename'} eq '') && ($env{'form.lis_person_name_full'} ne '')) {
- unless ($useinstdata{'middlename'}) {
- my $fullname = $env{'form.lis_person_name_full'};
- if ($info{'firstname'}) {
- $fullname =~ s/^\s*\Q$info{'firstname'}\E\s*//i;
- }
- if ($info{'lastname'}) {
- $fullname =~ s/\s*\Q$info{'lastname'}\E\s*$//i;
- }
- if ($fullname ne '') {
- $fullname =~ s/^\s+|\s+$//g;
- if ($fullname ne '') {
- $info{'middlename'} = $fullname;
- }
- }
- }
- }
- if (ref($inst_results{$uname.':'.$udom}{'inststatus'}) eq 'ARRAY') {
- my @inststatuses = @{$inst_results{$uname.':'.$udom}{'inststatus'}};
- $info{'inststatus'} = join(':',map { &escape($_); } @inststatuses);
- }
+ my (%rulematch,%inst_results,%curr_rules,%got_rules,%alerts);
+ my $domdesc = &Apache::lonnet::domain($udom,'description');
+ my %data = (
+ 'permanentemail' => $env{'form.lis_person_contact_email_primary'},
+ 'firstname' => $env{'form.lis_person_name_given'},
+ 'lastname' => $env{'form.lis_person_name_family'},
+ 'fullname' => $env{'form.lis_person_name_full'},
+ );
my $result =
- &Apache::lonnet::modifyuser($udom,$uname,$info{'id'},
- $lcauth,$lcauthparm,$info{'firstname'},
- $info{'middlename'},$info{'lastname'},
- $info{'generation'},undef,undef,
- $info{'permanentemail'},$info{'inststatus'});
- if ($result eq 'ok') {
+ &LONCAPA::ltiutils::create_user($lti{$itemid},$uname,$udom,
+ $domdesc,\%data,\%alerts,\%rulematch,
+ \%inst_results,\%curr_rules,%got_rules);
+ if ($result eq 'notallowed') {
+ &invalid_request($r,12);
+ } elsif ($result eq 'ok') {
if (($ltiroles[0] eq 'Instructor') && ($lcroles[0] eq 'cc') && ($lti{$itemid}{'mapcrs'}) &&
($lti{$itemid}{'makecrs'})) {
unless (&Apache::lonnet::usertools_access($uname,$udom,'lti','reload','requestcourses')) {
@@ -763,23 +661,7 @@
my %coursehash = &Apache::lonnet::coursedescription($cdom.'_'.$cnum);
my $start = $coursehash{'default_enrollment_start_date'};
my $end = $coursehash{'default_enrollment_end_date'};
- my $area = "/$cdom/$cnum";
- if (($role ne 'cc') && ($role ne 'co') && ($sec ne '')) {
- $area .= '/'.$sec;
- }
- my $spec = $role.'.'.$area;
- my $instcid;
- if ($role eq 'st') {
- $enrollresult =
- &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,undef,
- undef,undef,$sec,$end,$start,
- 'ltienroll',undef,$cdom.'_'.$cnum,1,
- 'ltienroll','',$instcid);
- } elsif ($role =~ /^(cc|in|ta|ep)$/) {
- $enrollresult =
- &Apache::lonnet::assignrole($udom,$uname,$area,$role,$end,$start,
- undef,1,'ltienroll');
- }
+ my $enrollresult = &LONCAPA::ltiutils::enrolluser($role,$cdom,$cnum,$sec,$start,$end);
if ($enrollresult eq 'ok') {
my (%userroles,%newrole,%newgroups);
&Apache::lonnet::standard_roleprivs(\%newrole,$role,$cdom,$spec,$cnum,
@@ -996,24 +878,4 @@
return;
}
-sub create_passwd {
- my $passwd = '';
- my @letts = ("a".."z");
- for (my $i=0; $i<8; $i++) {
- my $lettnum = int(rand(2));
- my $item = '';
- if ($lettnum) {
- $item = $letts[int(rand(26))];
- my $uppercase = int(rand(2));
- if ($uppercase) {
- $item =~ tr/a-z/A-Z/;
- }
- } else {
- $item = int(rand(10));
- }
- $passwd .= $item;
- }
- return ($passwd);
-}
-
1;
Index: loncom/auth/lonroles.pm
diff -u loncom/auth/lonroles.pm:1.337 loncom/auth/lonroles.pm:1.338
--- loncom/auth/lonroles.pm:1.337 Sat Apr 28 00:57:58 2018
+++ loncom/auth/lonroles.pm Mon May 28 23:26:12 2018
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# User Roles Screen
#
-# $Id: lonroles.pm,v 1.337 2018/04/28 00:57:58 raeburn Exp $
+# $Id: lonroles.pm,v 1.338 2018/05/28 23:26:12 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -145,6 +145,8 @@
use LONCAPA qw(:DEFAULT :match);
use HTML::Entities;
+my $registered_cleanup;
+my $rosterupdates;
sub redirect_user {
my ($r,$title,$url,$msg) = @_;
@@ -228,6 +230,8 @@
$update = $then;
}
+ $registered_cleanup=0;
+ @{$rosterupdates}=();
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
# -------------------------------------------------- Check if setting hot list
@@ -649,6 +653,10 @@
$cdom.'_'.$cnum);
}
}
+ if (($env{'request.lti.login'}) &&
+ ($env{'request.lti.rosterid'} || $env{'request.lti.passbackid'})) {
+ &process_lti($r,$cdom,$cnum);
+ }
$r->internal_redirect($dest);
}
return OK;
@@ -670,6 +678,10 @@
if (($ferr) && ($tadv)) {
&error_page($r,$ferr,$furl);
} else {
+ if (($env{'request.lti.login'}) &&
+ ($env{'request.lti.rosterid'} || $env{'request.lti.passbackid'})) {
+ &process_lti($r,$cdom,$cnum);
+ }
# Check to see if the user is a CC entering a course
# for the first time
if ((($role eq 'cc') || ($role eq 'co'))
@@ -3094,6 +3106,84 @@
$output.'</fieldset></div><br clear="all" />';
}
+sub process_lti {
+ my ($r,$cdom,$cnum) = @_;
+ my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
+ my $uriscope = &LONCAPA::ltiutils::lti_provider_scope($env{'request.lti.uri'},
+ $cdom,$cnum);
+ my $lonhost = $r->dir_config('lonHostID');
+ my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
+ if ($env{'request.lti.rosterid'} &&
+ $env{'request.lti.rosterurl'}) {
+ if (ref($lti{$env{'request.lti.login'}}) eq 'HASH') {
+ if ($lti{$env{'request.lti.login'}}{'roster'}) {
+ my @lcroles = ('in','ta','ep','st');
+ my @possibleroles;
+ foreach my $role (@lcroles) {
+ if (&Apache::lonnet::allowed('c'.$role,"$cdom/$cnum")) {
+ push(@possibleroles,$role);
+ }
+ }
+ my $owner = $env{'course.'.$cdom.'_'.$cnum.'.internal.courseowner'};
+ if ($owner eq $env{'user.name'}.':'.$env{'user.domain'}) {
+ my $crstype = &Apache::loncommon::course_type($cdom.'_'.$cnum);
+ if ($crstype eq 'Community') {
+ unshift(@possibleroles,'co');
+ } else {
+ unshift(@possibleroles,'cc');
+ }
+ }
+ if (@possibleroles) {
+ push(@{$rosterupdates},{cid => $cdom.'_'.$cnum,
+ lti => $env{'request.lti.login'},
+ ltiref => $lti{$env{'request.lti.login'}},
+ id => $env{'request.lti.rosterid'},
+ url => $env{'request.lti.rosterurl'},
+ sourcecrs => $env{'request.lti.sourcecrs'},
+ uriscope => $uriscope,
+ possroles => \@possibleroles,
+ intdoms => $internet_names,
+ });
+ unless ($registered_cleanup) {
+ my $handlers = $r->get_handlers('PerlCleanupHandler');
+ $r->set_handlers('PerlCleanupHandler' =>
+ [\<ienroll,@{$handlers}]);
+ $registered_cleanup=1;
+ }
+ }
+ }
+ }
+ }
+ if ($env{'request.lti.passbackid'} &&
+ $env{'request.lti.passbackurl'}) {
+ if (ref($lti{$env{'request.lti.login'}}) eq 'HASH') {
+ if ($lti{$env{'request.lti.login'}}{'passback'}) {
+ my ($pbnum,$error) =
+ &LONCAPA::ltiutils::store_passbackurl($env{'request.lti.login'},
+ $env{'request.lti.passbackurl'},
+ $cdom,$cnum);
+ if ($pbnum eq '') {
+ $pbnum = $env{'request.lti.passbackurl'};
+ }
+ &Apache::lonnet::put('nohist_'.$cdom.'_'.$cnum.'_passback',
+ {"$uriscope\0$env{'request.lti.sourcecrs'}\0$env{'request.lti.login'}" =>
+ "$pbnum\0$env{'request.lti.passbackid'}"});
+ }
+ }
+ }
+ return;
+}
+
+sub ltienroll {
+ if (ref($rosterupdates) eq 'ARRAY') {
+ foreach my $item (@{$rosterupdates}) {
+ if (ref($item) eq 'HASH') {
+ &LONCAPA::ltiutils::batchaddroster($item);
+ }
+ }
+ }
+}
+
1;
__END__
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1376 loncom/lonnet/perl/lonnet.pm:1.1377
--- loncom/lonnet/perl/lonnet.pm:1.1376 Tue May 1 14:28:41 2018
+++ loncom/lonnet/perl/lonnet.pm Mon May 28 23:26:21 2018
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1376 2018/05/01 14:28:41 raeburn Exp $
+# $Id: lonnet.pm,v 1.1377 2018/05/28 23:26:21 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -9290,7 +9290,7 @@
}
if ($refused) {
my ($cdom,$cnum) = ($cwosec =~ m{^/?($match_domain)/($match_courseid)$});
- if (!$selfenroll && $context eq 'course') {
+ if (!$selfenroll && (($context eq 'course') || ($context eq 'ltienroll' && $env{'request.lti.login'}))) {
my %crsenv;
if ($role eq 'cc' || $role eq 'co') {
%crsenv = &userenvironment($cdom,$cnum,('internal.courseowner'));
@@ -9313,7 +9313,7 @@
} elsif (($selfenroll == 1) && ($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
if ($role eq 'st') {
$refused = '';
- } elsif (($context eq 'ltienroll') && ($env{'request.lti'})) {
+ } elsif (($context eq 'ltienroll') && ($env{'request.lti.login'})) {
$refused = '';
}
} elsif ($context eq 'requestcourses') {
More information about the LON-CAPA-cvs
mailing list