--- loncom/interface/domainprefs.pm 2017/11/30 01:49:19 1.317
+++ loncom/interface/domainprefs.pm 2017/12/30 14:03:53 1.323
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to set domain-wide configuration settings
#
-# $Id: domainprefs.pm,v 1.317 2017/11/30 01:49:19 raeburn Exp $
+# $Id: domainprefs.pm,v 1.323 2017/12/30 14:03:53 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -219,13 +219,14 @@ sub handler {
'serverstatuses','requestcourses','helpsettings',
'coursedefaults','usersessions','loadbalancing',
'requestauthor','selfenrollment','inststatus',
- 'ltitools','ssl','trust'],$dom);
+ 'ltitools','ssl','trust','lti'],$dom);
+ my %encconfig =
+ &Apache::lonnet::get_dom('encconfig',['ltitools','lti'],$dom);
if (ref($domconfig{'ltitools'}) eq 'HASH') {
- my %encconfig =
- &Apache::lonnet::get_dom('encconfig',['ltitools'],$dom);
if (ref($encconfig{'ltitools'}) eq 'HASH') {
foreach my $id (keys(%{$domconfig{'ltitools'}})) {
- if (ref($domconfig{'ltitools'}{$id}) eq 'HASH') {
+ if ((ref($domconfig{'ltitools'}{$id}) eq 'HASH') &&
+ (ref($encconfig{'ltitools'}{$id}) eq 'HASH')) {
foreach my $item ('key','secret') {
$domconfig{'ltitools'}{$id}{$item} = $encconfig{'ltitools'}{$id}{$item};
}
@@ -233,12 +234,24 @@ sub handler {
}
}
}
+ if (ref($domconfig{'lti'}) eq 'HASH') {
+ if (ref($encconfig{'lti'}) eq 'HASH') {
+ foreach my $id (keys(%{$domconfig{'lti'}})) {
+ if ((ref($domconfig{'lti'}{$id}) eq 'HASH') &&
+ (ref($encconfig{'lti'}{$id}) eq 'HASH')) {
+ foreach my $item ('key','secret') {
+ $domconfig{'lti'}{$id}{$item} = $encconfig{'lti'}{$id}{$item};
+ }
+ }
+ }
+ }
+ }
my @prefs_order = ('rolecolors','login','defaults','quotas','autoenroll',
'autoupdate','autocreate','directorysrch','contacts',
'usercreation','selfcreation','usermodification','scantron',
'requestcourses','requestauthor','coursecategories',
'serverstatuses','helpsettings','coursedefaults',
- 'ltitools','selfenrollment','usersessions','ssl','trust');
+ 'ltitools','selfenrollment','usersessions','ssl','trust','lti');
my %existing;
if (ref($domconfig{'loadbalancing'}) eq 'HASH') {
%existing = %{$domconfig{'loadbalancing'}};
@@ -545,6 +558,14 @@ sub handler {
print => \&print_trust,
modify => \&modify_trust,
},
+ 'lti' =>
+ {text => 'LTI Provider',
+ help => 'Domain_Configuration_LTI_Provider',
+ header => [{col1 => 'Setting',
+ col2 => 'Value',}],
+ print => \&print_lti,
+ modify => \&modify_lti,
+ },
);
if (keys(%servers) > 1) {
$prefs{'login'} = { text => 'Log-in page options',
@@ -730,6 +751,8 @@ sub process_changes {
$output = &modify_ssl($dom,$lastactref,%domconfig);
} elsif ($action eq 'trust') {
$output = &modify_trust($dom,$lastactref,%domconfig);
+ } elsif ($action eq 'lti') {
+ $output = &modify_lti($r,$dom,$action,$lastactref,%domconfig);
}
return $output;
}
@@ -1065,7 +1088,7 @@ sub print_config_box {
$output .= &print_quotas($dom,$settings,\$rowtotal,$action);
} elsif (($action eq 'autoenroll') || ($action eq 'autocreate') ||
($action eq 'serverstatuses') || ($action eq 'loadbalancing') ||
- ($action eq 'ltitools')) {
+ ($action eq 'ltitools') || ($action eq 'lti')) {
$output .= $item->{'print'}->($dom,$settings,\$rowtotal);
} elsif ($action eq 'scantron') {
$output .= &print_scantronformat($r,$dom,$confname,$settings,\$rowtotal);
@@ -2586,7 +2609,10 @@ ENDSCRIPT
sub ltitools_javascript {
my ($settings) = @_;
- return unless(ref($settings) eq 'HASH');
+ my $togglejs = <itools_toggle_js();
+ unless (ref($settings) eq 'HASH') {
+ return $togglejs;
+ }
my (%ordered,$total,%jstext);
$total = 0;
foreach my $item (keys(%{$settings})) {
@@ -2604,7 +2630,7 @@ sub ltitools_javascript {
return <<"ENDSCRIPT";
+$togglejs
+
+ENDSCRIPT
+}
+
+sub ltitools_toggle_js {
+ return <<"ENDSCRIPT";
+
+
+ENDSCRIPT
+}
+
+sub lti_javascript {
+ my ($settings) = @_;
+ my $togglejs = <i_toggle_js();
+ unless (ref($settings) eq 'HASH') {
+ return $togglejs;
+ }
+ my (%ordered,$total,%jstext);
+ $total = 0;
+ foreach my $item (keys(%{$settings})) {
+ if (ref($settings->{$item}) eq 'HASH') {
+ my $num = $settings->{$item}{'order'};
+ $ordered{$num} = $item;
+ }
+ }
+ $total = scalar(keys(%{$settings}));
+ my @jsarray = ();
+ foreach my $item (sort {$a <=> $b } (keys(%ordered))) {
+ push(@jsarray,$ordered{$item});
+ }
+ my $jstext = ' var lti = Array('."'".join("','",@jsarray)."'".');'."\n";
+ return <<"ENDSCRIPT";
+
+
+$togglejs
+
+ENDSCRIPT
+}
+
+sub lti_toggle_js {
+ return <<"ENDSCRIPT";
+
+
ENDSCRIPT
}
@@ -3885,18 +4112,24 @@ sub print_ltitools {
for (my $i=0; $i<@items; $i++) {
$css_class = $itemcount%2?' class="LC_odd_row"':'';
my $item = $ordered{$items[$i]};
- my ($title,$key,$secret,$url,$imgsrc);
+ my ($title,$key,$secret,$url,$lifetime,$imgsrc,%sigsel);
if (ref($settings->{$item}) eq 'HASH') {
$title = $settings->{$item}->{'title'};
$url = $settings->{$item}->{'url'};
$key = $settings->{$item}->{'key'};
$secret = $settings->{$item}->{'secret'};
+ $lifetime = $settings->{$item}->{'lifetime'};
my $image = $settings->{$item}->{'image'};
if ($image ne '') {
$imgsrc = '';
}
+ if ($settings->{$item}->{'sigmethod'} eq 'HMAC-256') {
+ $sigsel{'HMAC-256'} = ' selected="selected"';
+ } else {
+ $sigsel{'HMAC-SHA1'} = ' selected="selected"';
+ }
}
- my $chgstr = ' onchange="javascript:reorderLTI(this.form,'."'ltitools_".$item."'".');"';
+ my $chgstr = ' onchange="javascript:reorderLTITools(this.form,'."'ltitools_".$item."'".');"';
$datatable .= '
'
.' | '.
''.
''.
'';
- foreach my $item ('label','title','target','linktext','explanation') {
+ foreach my $item ('label','title','target','linktext','explanation','append') {
$datatable .= ''.(' ' x2)."\n";
@@ -4195,8 +4469,10 @@ sub ltitools_names {
'title' => 'Title',
'version' => 'Version',
'msgtype' => 'Message Type',
+ 'sigmethod' => 'Signature Method',
'url' => 'URL',
'key' => 'Key',
+ 'lifetime' => 'Nonce lifetime (s)',
'secret' => 'Secret',
'icon' => 'Icon',
'user' => 'Username:domain',
@@ -4219,10 +4495,332 @@ sub ltitools_names {
'crstitle' => 'Course title',
'crslinktext' => 'Link Text',
'crsexplanation' => 'Explanation',
+ 'crsappend' => 'Provider URL',
);
return %lt;
}
+sub print_lti {
+ my ($dom,$settings,$rowtotal) = @_;
+ my $itemcount = 1;
+ my $maxnum = 0;
+ my $css_class;
+ my %ordered;
+ if (ref($settings) eq 'HASH') {
+ foreach my $item (keys(%{$settings})) {
+ if (ref($settings->{$item}) eq 'HASH') {
+ my $num = $settings->{$item}{'order'};
+ $ordered{$num} = $item;
+ }
+ }
+ }
+ my $maxnum = scalar(keys(%ordered));
+ my $datatable = <i_javascript($settings);
+ my %lt = <i_names();
+ if (keys(%ordered)) {
+ my @items = sort { $a <=> $b } keys(%ordered);
+ for (my $i=0; $i<@items; $i++) {
+ $css_class = $itemcount%2?' class="LC_odd_row"':'';
+ my $item = $ordered{$items[$i]};
+ my ($key,$secret,$lifetime,$consumer,$current);
+ if (ref($settings->{$item}) eq 'HASH') {
+ $key = $settings->{$item}->{'key'};
+ $secret = $settings->{$item}->{'secret'};
+ $lifetime = $settings->{$item}->{'lifetime'};
+ $consumer = $settings->{$item}->{'consumer'};
+ $current = $settings->{$item};
+ }
+ my $chgstr = ' onchange="javascript:reorderLTI(this.form,'."'lti_pos_".$item."'".');"';
+ $datatable .= ''
+ .''.(' 'x2).
+ ' | '.
+ ''.
+ ''.
+ ''.$lt{'consumer'}.
+ ': '.
+ (' 'x2).
+ ''.$lt{'version'}.': '.
+ (' 'x2).
+ ''.$lt{'lifetime'}.':'.
+ '
'.
+ ''.$lt{'key'}.
+ ': '.
+ (' 'x2).
+ ''.$lt{'secret'}.':'.
+ ''.
+ ''.
+ ''.
+ ''.<i_options($i,$current,%lt).' | ';
+ $itemcount ++;
+ }
+ }
+ $css_class = $itemcount%2?' class="LC_odd_row"':'';
+ my $chgstr = ' onchange="javascript:reorderLTI(this.form,'."'lti_pos_add'".');"';
+ $datatable .= ''."\n".
+ ''."\n".
+ ' '."\n".
+ ''.&mt('Add').' | '."\n".
+ ''.
+ ''.
+ ''.$lt{'consumer'}.
+ ': '."\n".
+ (' 'x2).
+ ''.$lt{'version'}.': '."\n".
+ (' 'x2).
+ ''.$lt{'lifetime'}.': '."\n".
+ '
'.
+ ''.$lt{'key'}.': '."\n".
+ (' 'x2).
+ ''.$lt{'secret'}.':'.
+ ' '."\n".
+ ''.<i_options('add',undef,%lt).
+ ' | '."\n".
+ ' '."\n";
+ $$rowtotal ++;
+ return $datatable;;
+}
+
+sub lti_names {
+ my %lt = &Apache::lonlocal::texthash(
+ 'version' => 'LTI Version',
+ 'url' => 'URL',
+ 'key' => 'Key',
+ 'lifetime' => 'Nonce lifetime (s)',
+ 'consumer' => 'LTI Consumer',
+ 'secret' => 'Secret',
+ 'email' => 'Email address',
+ 'sourcedid' => 'User ID',
+ 'other' => 'Other',
+ 'passback' => 'Can return grades to Consumer:',
+ 'roster' => 'Can retrieve roster from Consumer:',
+ );
+ return %lt;
+}
+
+sub lti_options {
+ my ($num,$current,%lt) = @_;
+ my (%checked,%rolemaps,$crssecsrc,$userfield,$cidfield);
+ $checked{'mapuser'}{'sourcedid'} = ' checked="checked"';
+ $checked{'mapcrs'}{'course_offering_sourcedid'} = ' checked="checked"';
+ $checked{'makecrs'}{'N'} = ' checked="checked"';
+ $checked{'mapcrstype'} = {};
+ $checked{'makeuser'} = {};
+ $checked{'selfenroll'} = {};
+ $checked{'crssec'} = {};
+ $checked{'crssecsrc'} = {};
+
+ my $userfieldsty = 'none';
+ my $crsfieldsty = 'none';
+ my $crssecfieldsty = 'none';
+ my $secsrcfieldsty = 'none';
+
+ if (ref($current) eq 'HASH') {
+ if (($current->{'mapuser'} ne '') && ($current->{'mapuser'} ne 'lis_person_sourcedid')) {
+ $checked{'mapuser'}{'sourcedid'} = '';
+ if ($current->{'mapuser'} eq 'lis_person_contact_email_primary') {
+ $checked{'mapuser'}{'email'} = ' checked="checked"';
+ } else {
+ $checked{'mapuser'}{'other'} = ' checked="checked"';
+ $userfield = $current->{'mapuser'};
+ $userfieldsty = 'inline-block';
+ }
+ }
+ if (($current->{'mapcrs'} ne '') && ($current->{'mapcrs'} ne 'course_offering_sourcedid')) {
+ $checked{'mapcrs'}{'course_offering_sourcedid'} = '';
+ if ($current->{'mapcrs'} eq 'context_id') {
+ $checked{'mapcrs'}{'context_id'} = ' checked="checked"';
+ } else {
+ $checked{'mapcrs'}{'other'} = ' checked="checked"';
+ $cidfield = $current->{'mapcrs'};
+ $crsfieldsty = 'inline-block';
+ }
+ }
+ if (ref($current->{'mapcrstype'}) eq 'ARRAY') {
+ foreach my $type (@{$current->{'mapcrstype'}}) {
+ $checked{'mapcrstype'}{$type} = ' checked="checked"';
+ }
+ }
+ if ($current->{'makecrs'}) {
+ $checked{'makecrs'}{'Y'} = ' checked="checked"';
+ }
+ if (ref($current->{'makeuser'}) eq 'ARRAY') {
+ foreach my $role (@{$current->{'makeuser'}}) {
+ $checked{'makeuser'}{$role} = ' checked="checked"';
+ }
+ }
+ if (ref($current->{'selfenroll'}) eq 'ARRAY') {
+ foreach my $role (@{$current->{'selfenroll'}}) {
+ $checked{'selfenroll'}{$role} = ' checked="checked"';
+ }
+ }
+ if (ref($current->{'maproles'}) eq 'HASH') {
+ %rolemaps = %{$current->{'maproles'}};
+ }
+ if ($current->{'section'} ne '') {
+ $checked{'crssec'}{'Y'} = ' checked="checked"';
+ $crssecfieldsty = 'inline-block';
+ if ($current->{'section'} eq 'course_section_sourcedid') {
+ $checked{'crssecsrc'}{'sourcedid'} = ' checked="checked"';
+ } else {
+ $checked{'crssecsrc'}{'other'} = ' checked="checked"';
+ $crssecsrc = $current->{'section'};
+ $secsrcfieldsty = 'inline-block';
+ }
+ } else {
+ $checked{'crssec'}{'N'} = ' checked="checked"';
+ }
+ } else {
+ $checked{'makecrs'}{'N'} = ' checked="checked"';
+ $checked{'crssec'}{'N'} = ' checked="checked"';
+ }
+ my @coursetypes = ('official','unofficial','community','textbook','placement');
+ my %coursetypetitles = &Apache::lonlocal::texthash (
+ official => 'Official',
+ unofficial => 'Unofficial',
+ community => 'Community',
+ textbook => 'Textbook',
+ placement => 'Placement Test',
+ );
+ my @ltiroles = qw(Learner Instructor ContentDeveloper TeachingAssistant Mentor Member Manager Administrator);
+ my @lticourseroles = qw(Learner Instructor TeachingAssistant Mentor);
+ my @courseroles = ('cc','in','ta','ep','st');
+ my $onclickuser = ' onclick="toggleLTI(this.form,'."'user','$num'".');"';
+ my $onclickcrs = ' onclick="toggleLTI(this.form,'."'crs','$num'".');"';
+ my $onclicksec = ' onclick="toggleLTI(this.form,'."'sec','$num'".');"';
+ my $onclicksecsrc = ' onclick="toggleLTI(this.form,'."'secsrc','$num'".')"';
+ my $output = ''.
+ ''.&mt('LON-CAPA username').': ';
+ foreach my $option ('sourcedid','email','other') {
+ $output .= ''.
+ ($option eq 'other' ? '' : (' 'x2) );
+ }
+ $output .= ' '.
+ ''.
+ ' '.
+ '';
+ foreach my $ltirole (@lticourseroles) {
+ my ($selected,$selectnone);
+ if ($rolemaps{$ltirole} eq '') {
+ $selectnone = ' selected="selected"';
+ }
+ $output .= ''.$ltirole.' '.
+ ' | ';
+ }
+ $output .= ' '.
+ '';
+ foreach my $ltirole (@ltiroles) {
+ $output .= ' ';
+ }
+ $output .= ''.
+ ''.
+ ''.
+ &mt('Unique course identifier').': ';
+ foreach my $option ('course_offering_sourcedid','context_id','other') {
+ $output .= ''.
+ ($option eq 'other' ? '' : (' 'x2) );
+ }
+ $output .= ' '.
+ ''.
+ ' '.
+ ''.&mt('LON-CAPA course type(s)').': ';
+ foreach my $type (@coursetypes) {
+ $output .= ''.
+ (' 'x2);
+ }
+ $output .= ''.
+ ''.
+ ''.&mt('Course created (if absent) on Instructor access').': '.
+ ''.(' 'x2).
+ ''.
+ ''.
+ '';
+ foreach my $lticrsrole (@lticourseroles) {
+ $output .= ' ';
+ }
+ $output .= ''.
+ ''.
+ ''.&mt('Assign users to sections').': '.
+ ''.(' 'x2).
+ ' '.
+ ''.
+ ''.
+ ' ';
+ foreach my $extra ('passback','roster') {
+ my $checkedon = '';
+ my $checkedoff = ' checked="checked"';
+ if (ref($current) eq 'HASH') {
+ if (($current->{$extra})) {
+ $checkedon = $checkedoff;
+ $checkedoff = '';
+ }
+ }
+ $output .= $lt{$extra}.' '.
+ ''.(' 'x2).
+ ' ';
+ }
+ $output .= '';
+# '';
+#
+# $output .= ''.
+# '';
+ return $output;
+}
+
sub print_coursedefaults {
my ($position,$dom,$settings,$rowtotal) = @_;
my ($css_class,$datatable,%checkedon,%checkedoff,%defaultchecked,@toggles);
@@ -10066,8 +10664,11 @@ sub modify_ltitools {
$allpos[$position] = $newid;
}
$changes{$newid} = 1;
- foreach my $item ('title','url','key','secret') {
+ foreach my $item ('title','url','key','secret','lifetime') {
$env{'form.ltitools_add_'.$item} =~ s/(`)/'/g;
+ if ($item eq 'lifetime') {
+ $env{'form.ltitools_add_'.$item} =~ s/[^\d.]//g;
+ }
if ($env{'form.ltitools_add_'.$item}) {
if (($item eq 'key') || ($item eq 'secret')) {
$encconfig{$newid}{$item} = $env{'form.ltitools_add_'.$item};
@@ -10082,6 +10683,11 @@ sub modify_ltitools {
if ($env{'form.ltitools_add_msgtype'} eq 'basic-lti-launch-request') {
$confhash{$newid}{'msgtype'} = $env{'form.ltitools_add_msgtype'};
}
+ if ($env{'form.ltitools_add_sigmethod'} eq 'HMAC-SHA256') {
+ $confhash{$newid}{'sigmethod'} = $env{'form.ltitools_add_sigmethod'};
+ } else {
+ $confhash{$newid}{'sigmethod'} = 'HMAC-SHA1';
+ }
foreach my $item ('width','height','linktext','explanation') {
$env{'form.ltitools_add_'.$item} =~ s/^\s+//;
$env{'form.ltitools_add_'.$item} =~ s/\s+$//;
@@ -10103,8 +10709,15 @@ sub modify_ltitools {
$confhash{$newid}{'display'}{'target'} = 'iframe';
}
foreach my $item ('passback','roster') {
- if ($env{'form.ltitools_add_'.$item}) {
+ if ($env{'form.ltitools_'.$item.'_add'}) {
$confhash{$newid}{$item} = 1;
+ if ($env{'form.ltitools_'.$item.'valid_add'} ne '') {
+ my $lifetime = $env{'form.ltitools_'.$item.'valid_add'};
+ $lifetime =~ s/^\s+|\s+$//g;
+ if ($lifetime =~ /^\d+\.?\d*$/) {
+ $confhash{$newid}{$item.'valid'} = $lifetime;
+ }
+ }
}
}
if ($env{'form.ltitools_add_image.filename'} ne '') {
@@ -10183,7 +10796,7 @@ sub modify_ltitools {
} else {
my $newpos = $env{'form.ltitools_'.$itemid};
$newpos =~ s/\D+//g;
- foreach my $item ('title','url') {
+ foreach my $item ('title','url','lifetime') {
$confhash{$itemid}{$item} = $env{'form.ltitools_'.$item.'_'.$i};
if ($domconfig{$action}{$itemid}{$item} ne $confhash{$itemid}{$item}) {
$changes{$itemid} = 1;
@@ -10201,6 +10814,18 @@ sub modify_ltitools {
if ($env{'form.ltitools_msgtype_'.$i} eq 'basic-lti-launch-request') {
$confhash{$itemid}{'msgtype'} = $env{'form.ltitools_msgtype_'.$i};
}
+ if ($env{'form.ltitools_sigmethod_'.$i} eq 'HMAC-SHA256') {
+ $confhash{$itemid}{'sigmethod'} = $env{'form.ltitools_sigmethod_'.$i};
+ } else {
+ $confhash{$itemid}{'sigmethod'} = 'HMAC-SHA1';
+ }
+ if ($domconfig{$action}{$itemid}{'sigmethod'} eq '') {
+ if ($confhash{$itemid}{'sigmethod'} ne 'HMAC-SHA1') {
+ $changes{$itemid} = 1;
+ }
+ } elsif ($domconfig{$action}{$itemid}{'sigmethod'} ne $confhash{$itemid}{'sigmethod'}) {
+ $changes{$itemid} = 1;
+ }
foreach my $size ('width','height') {
$env{'form.ltitools_'.$size.'_'.$i} =~ s/^\s+//;
$env{'form.ltitools_'.$size.'_'.$i} =~ s/\s+$//;
@@ -10254,13 +10879,23 @@ sub modify_ltitools {
foreach my $extra ('passback','roster') {
if ($env{'form.ltitools_'.$extra.'_'.$i}) {
$confhash{$itemid}{$extra} = 1;
+ if ($env{'form.ltitools_'.$extra.'valid_'.$i} ne '') {
+ my $lifetime = $env{'form.ltitools_'.$extra.'valid_add'};
+ $lifetime =~ s/^\s+|\s+$//g;
+ if ($lifetime =~ /^\d+\.?\d*$/) {
+ $confhash{$itemid}{$extra.'valid'} = $lifetime;
+ }
+ }
}
if ($domconfig{$action}{$itemid}{$extra} ne $confhash{$itemid}{$extra}) {
$changes{$itemid} = 1;
}
+ if ($domconfig{$action}{$itemid}{$extra.'valid'} ne $confhash{$itemid}{$extra.'valid'}) {
+ $changes{$itemid} = 1;
+ }
}
my @courseconfig = &Apache::loncommon::get_env_multiple('form.ltitools_courseconfig_'.$i);
- foreach my $item ('label','title','target','linktext','explanation') {
+ foreach my $item ('label','title','target','linktext','explanation','append') {
if (grep(/^\Q$item\E$/,@courseconfig)) {
$confhash{$itemid}{'crsconf'}{$item} = 1;
if (ref($domconfig{$action}{$itemid}{'crsconf'}) eq 'HASH') {
@@ -10437,7 +11072,7 @@ sub modify_ltitools {
$resulttext .= '';
my $position = $pos + 1;
$resulttext .= '- '.&mt('Order: [_1]',$position).'
';
- foreach my $item ('version','msgtype','url') {
+ foreach my $item ('version','msgtype','sigmethod','url','lifetime') {
if ($confhash{$itemid}{$item} ne '') {
$resulttext .= '- '.$lt{$item}.': '.$confhash{$itemid}{$item}.'
';
}
@@ -10451,7 +11086,7 @@ sub modify_ltitools {
$resulttext .= ('*'x$num).'';
}
$resulttext .= '- '.&mt('Configurable in course:');
- my @possconfig = ('label','title','target','linktext','explanation');
+ my @possconfig = ('label','title','target','linktext','explanation','append');
my $numconfig = 0;
if (ref($confhash{$itemid}{'crsconf'}) eq 'HASH') {
foreach my $item (@possconfig) {
@@ -10469,6 +11104,15 @@ sub modify_ltitools {
$resulttext .= '
- '.$lt{$item}.' ';
if ($confhash{$itemid}{$item}) {
$resulttext .= &mt('Yes');
+ if ($confhash{$itemid}{$item.'valid'}) {
+ if ($item eq 'passback') {
+ $resulttext .= ' '.&mt('valid for at least [quant,_1,day] after launch',
+ $confhash{$itemid}{$item.'valid'});
+ } else {
+ $resulttext .= ' '.&mt('valid for at least [quant,_1,second] after launch',
+ $confhash{$itemid}{$item.'valid'});
+ }
+ }
} else {
$resulttext .= &mt('No');
}
@@ -10622,6 +11266,422 @@ sub get_ltitools_id {
} else {
$error = 'nolock';
}
+ return ($id,$error);
+}
+
+sub modify_lti {
+ my ($r,$dom,$action,$lastactref,%domconfig) = @_;
+ my %domdefaults = &Apache::lonnet::get_domain_defaults($dom,1);
+ my ($newid,@allpos,%changes,%confhash,%encconfig,$errors,$resulttext);
+ my (%posslti,%posslticrs,%posscrstype);
+ my @courseroles = ('cc','in','ta','ep','st');
+ my @ltiroles = qw(Learner Instructor ContentDeveloper TeachingAssistant Mentor Member Manager Administrator);
+ my @lticourseroles = qw(Instructor TeachingAssistant Mentor Learner);
+ my @coursetypes = ('official','unofficial','community','textbook','placement');
+ my %coursetypetitles = &Apache::lonlocal::texthash (
+ official => 'Official',
+ unofficial => 'Unofficial',
+ community => 'Community',
+ textbook => 'Textbook',
+ placement => 'Placement Test',
+ );
+ my %lt = <i_names();
+ map { $posslti{$_} = 1; } @ltiroles;
+ map { $posslticrs{$_} = 1; } @lticourseroles;
+ map { $posscrstype{$_} = 1; } @coursetypes;
+
+ my (@items,%deletions,%itemids);
+ if ($env{'form.lti_add'}) {
+ my $consumer = $env{'form.lti_consumer_add'};
+ $consumer =~ s/(`)/'/g;
+ ($newid,my $error) = &get_lti_id($dom,$consumer);
+ if ($newid) {
+ $itemids{'add'} = $newid;
+ push(@items,'add');
+ $changes{$newid} = 1;
+ } else {
+ my $error = &mt('Failed to acquire unique ID for new LTI configuration');
+ $errors .= '
- '.$error.'
';
+ }
+ }
+ if (ref($domconfig{$action}) eq 'HASH') {
+ my @todelete = &Apache::loncommon::get_env_multiple('form.lti_del');
+ if (@todelete) {
+ map { $deletions{$_} = 1; } @todelete;
+ }
+ my $maxnum = $env{'form.lti_maxnum'};
+ for (my $i=0; $i<=$maxnum; $i++) {
+ my $itemid = $env{'form.lti_id_'.$i};
+ $itemid =~ s/\D+//g;
+ if (ref($domconfig{$action}{$itemid}) eq 'HASH') {
+ if ($deletions{$itemid}) {
+ $changes{$itemid} = $domconfig{$action}{$itemid}{'consumer'};
+ } else {
+ push(@items,$i);
+ $itemids{$i} = $itemid;
+ }
+ }
+ }
+ }
+ foreach my $idx (@items) {
+ my $itemid = $itemids{$idx};
+ next unless ($itemid);
+ my $position = $env{'form.lti_pos_'.$idx};
+ $position =~ s/\D+//g;
+ if ($position ne '') {
+ $allpos[$position] = $itemid;
+ }
+ foreach my $item ('consumer','key','secret','lifetime') {
+ my $formitem = 'form.lti_'.$item.'_'.$idx;
+ $env{$formitem} =~ s/(`)/'/g;
+ if ($item eq 'lifetime') {
+ $env{$formitem} =~ s/[^\d.]//g;
+ }
+ if ($env{$formitem} ne '') {
+ if (($item eq 'key') || ($item eq 'secret')) {
+ $encconfig{$itemid}{$item} = $env{$formitem};
+ } else {
+ $confhash{$itemid}{$item} = $env{$formitem};
+ unless (($idx eq 'add') || ($changes{$itemid})) {
+ if ($domconfig{$action}{$itemid}{$item} ne $confhash{$itemid}{$item}) {
+ $changes{$itemid} = 1;
+ }
+ }
+ }
+ }
+ }
+ if ($env{'form.lti_version_'.$idx} eq 'LTI-1p0') {
+ $confhash{$itemid}{'version'} = $env{'form.lti_version_'.$idx};
+ }
+ if ($env{'form.lti_mapuser_'.$idx} eq 'sourcedid') {
+ $confhash{$itemid}{'mapuser'} = 'lis_person_sourcedid';
+ } elsif ($env{'form.lti_mapuser_'.$idx} eq 'email') {
+ $confhash{$itemid}{'mapuser'} = 'lis_person_contact_email_primary';
+ } elsif ($env{'form.lti_mapuser_'.$idx} eq 'other') {
+ my $mapuser = $env{'form.lti_customuser_'.$idx};
+ $mapuser =~ s/(`)/'/g;
+ $mapuser =~ s/^\s+|\s+$//g;
+ $confhash{$itemid}{'mapuser'} = $mapuser;
+ }
+ foreach my $ltirole (@lticourseroles) {
+ my $possrole = $env{'form.lti_maprole_'.$ltirole.'_'.$idx};
+ if (grep(/^\Q$possrole\E$/,@courseroles)) {
+ $confhash{$itemid}{'maproles'}{$ltirole} = $possrole;
+ }
+ }
+ my @possmakeuser = &Apache::loncommon::get_env_multiple('form.lti_makeuser_'.$idx);
+ my @makeuser;
+ foreach my $ltirole (sort(@possmakeuser)) {
+ if ($posslti{$ltirole}) {
+ push(@makeuser,$ltirole);
+ }
+ }
+ $confhash{$itemid}{'makeuser'} = \@makeuser;
+ if (($env{'form.lti_mapcrs_'.$idx} eq 'course_offering_sourcedid') ||
+ ($env{'form.lti_mapcrs_'.$idx} eq 'context_id')) {
+ $confhash{$itemid}{'mapcrs'} = $env{'form.lti_mapcrs_'.$idx};
+ } elsif ($env{'form.lti_mapcrs_'.$idx} eq 'other') {
+ my $mapcrs = $env{'form.lti_mapcrsfield_'.$idx};
+ $mapcrs =~ s/(`)/'/g;
+ $mapcrs =~ s/^\s+|\s+$//g;
+ $confhash{$itemid}{'mapcrs'} = $mapcrs;
+ }
+ my @posstypes = &Apache::loncommon::get_env_multiple('form.lti_mapcrstype_'.$idx);
+ my @crstypes;
+ foreach my $type (sort(@posstypes)) {
+ if ($posscrstype{$type}) {
+ push(@crstypes,$type);
+ }
+ }
+ $confhash{$itemid}{'mapcrstype'} = \@crstypes;
+ if ($env{'form.lti_makecrs_'.$idx}) {
+ $confhash{$itemid}{'makecrs'} = 1;
+ }
+ my @possenroll = &Apache::loncommon::get_env_multiple('form.lti_selfenroll_'.$idx);
+ my @selfenroll;
+ foreach my $type (sort(@possenroll)) {
+ if ($posslticrs{$type}) {
+ push(@selfenroll,$type);
+ }
+ }
+ $confhash{$itemid}{'selfenroll'} = \@selfenroll;
+ if ($env{'form.lti_crssec_'.$idx}) {
+ if ($env{'form.lti_crssecsrc_'.$idx} eq 'course_section_sourcedid') {
+ $confhash{$itemid}{'section'} = $env{'form.lti_crssecsrc_'.$idx};
+ } elsif ($env{'form.lti_crssecsrc_'.$idx} eq 'other') {
+ my $section = $env{'form.lti_customsection_'.$idx};
+ $section =~ s/(`)/'/g;
+ $section =~ s/^\s+|\s+$//g;
+ if ($section ne '') {
+ $confhash{$itemid}{'section'} = $section;
+ }
+ }
+ }
+ foreach my $field ('passback','roster') {
+ if ($env{'form.lti_'.$field.'_'.$idx}) {
+ $confhash{$itemid}{$field} = 1;
+ }
+ }
+ unless (($idx eq 'add') || ($changes{$itemid})) {
+ foreach my $field ('mapuser','mapcrs','section','passback','roster') {
+ if ($domconfig{$action}{$itemid}{$field} ne $confhash{$itemid}{$field}) {
+ $changes{$itemid} = 1;
+ }
+ }
+ foreach my $field ('makeuser','mapcrstype','selfenroll') {
+ unless ($changes{$itemid}) {
+ if (ref($domconfig{$action}{$itemid}{$field}) eq 'ARRAY') {
+ if (ref($confhash{$itemid}{$field}) eq 'ARRAY') {
+ my @diffs = &Apache::loncommon::compare_arrays($domconfig{$action}{$itemid}{$field},
+ $confhash{$itemid}{$field});
+ if (@diffs) {
+ $changes{$itemid} = 1;
+ }
+ } elsif (@{$domconfig{$action}{$itemid}{$field}} > 0) {
+ $changes{$itemid} = 1;
+ }
+ } elsif (ref($confhash{$itemid}{$field}) eq 'ARRAY') {
+ if (@{$confhash{$itemid}{$field}} > 0) {
+ $changes{$itemid} = 1;
+ }
+ }
+ }
+ }
+ unless ($changes{$itemid}) {
+ if (ref($domconfig{$action}{$itemid}{'maproles'}) eq 'HASH') {
+ if (ref($confhash{$itemid}{'maproles'}) eq 'HASH') {
+ foreach my $ltirole (keys(%{$domconfig{$action}{$itemid}{'maproles'}})) {
+ if ($domconfig{$action}{$itemid}{'maproles'}{$ltirole} ne
+ $confhash{$itemid}{'maproles'}{$ltirole}) {
+ $changes{$itemid} = 1;
+ last;
+ }
+ }
+ unless ($changes{$itemid}) {
+ foreach my $ltirole (keys(%{$confhash{$itemid}{'maproles'}})) {
+ if ($confhash{$itemid}{'maproles'}{$ltirole} ne
+ $domconfig{$action}{$itemid}{'maproles'}{$ltirole}) {
+ $changes{$itemid} = 1;
+ last;
+ }
+ }
+ }
+ } elsif (keys(%{$domconfig{$action}{$itemid}{'maproles'}}) > 0) {
+ $changes{$itemid} = 1;
+ }
+ } elsif (ref($confhash{$itemid}{'maproles'}) eq 'HASH') {
+ unless ($changes{$itemid}) {
+ if (keys(%{$confhash{$itemid}{'maproles'}}) > 0) {
+ $changes{$itemid} = 1;
+ }
+ }
+ }
+ }
+ }
+ }
+ if (@allpos > 0) {
+ my $idx = 0;
+ foreach my $itemid (@allpos) {
+ if ($itemid ne '') {
+ $confhash{$itemid}{'order'} = $idx;
+ if (ref($domconfig{$action}) eq 'HASH') {
+ if (ref($domconfig{$action}{$itemid}) eq 'HASH') {
+ if ($domconfig{$action}{$itemid}{'order'} ne $idx) {
+ $changes{$itemid} = 1;
+ }
+ }
+ }
+ $idx ++;
+ }
+ }
+ }
+ my %ltihash = (
+ $action => { %confhash }
+ );
+ my $putresult = &Apache::lonnet::put_dom('configuration',\%ltihash,
+ $dom);
+ if ($putresult eq 'ok') {
+ my %ltienchash = (
+ $action => { %encconfig }
+ );
+ &Apache::lonnet::put_dom('encconfig',\%ltienchash,$dom);
+ if (keys(%changes) > 0) {
+ my $cachetime = 24*60*60;
+ my %ltiall = %confhash;
+ foreach my $id (keys(%ltiall)) {
+ if (ref($encconfig{$id}) eq 'HASH') {
+ foreach my $item ('key','secret') {
+ $ltiall{$id}{$item} = $encconfig{$id}{$item};
+ }
+ }
+ }
+ &Apache::lonnet::do_cache_new('lti',$dom,\%ltiall,$cachetime);
+ if (ref($lastactref) eq 'HASH') {
+ $lastactref->{'lti'} = 1;
+ }
+ $resulttext = &mt('Changes made:').'';
+ my %bynum;
+ foreach my $itemid (sort(keys(%changes))) {
+ my $position = $confhash{$itemid}{'order'};
+ $bynum{$position} = $itemid;
+ }
+ foreach my $pos (sort { $a <=> $b } keys(%bynum)) {
+ my $itemid = $bynum{$pos};
+ if (ref($confhash{$itemid}) ne 'HASH') {
+ $resulttext .= '- '.&mt('Deleted: [_1]',$changes{$itemid}).'
';
+ } else {
+ $resulttext .= '- '.$confhash{$itemid}{'consumer'}.'
';
+ my $position = $pos + 1;
+ $resulttext .= '- '.&mt('Order: [_1]',$position).'
';
+ foreach my $item ('version','lifetime') {
+ if ($confhash{$itemid}{$item} ne '') {
+ $resulttext .= '- '.$lt{$item}.': '.$confhash{$itemid}{$item}.'
';
+ }
+ }
+ if ($encconfig{$itemid}{'key'} ne '') {
+ $resulttext .= '- '.$lt{'key'}.': '.$encconfig{$itemid}{'key'}.'
';
+ }
+ if ($encconfig{$itemid}{'secret'} ne '') {
+ $resulttext .= '- '.$lt{'secret'}.': ';
+ my $num = length($encconfig{$itemid}{'secret'});
+ $resulttext .= ('*'x$num).'
';
+ }
+ if ($confhash{$itemid}{'mapuser'}) {
+ my $shownmapuser;
+ if ($confhash{$itemid}{'mapuser'} eq 'lis_person_sourcedid') {
+ $shownmapuser = $lt{'sourcedid'}.' (lis_person_sourcedid)';
+ } elsif ($confhash{$itemid}{'mapuser'} eq 'lis_person_contact_email_primary') {
+ $shownmapuser = $lt{'email'}.' (lis_person_contact_email_primary)';
+ } else {
+ $shownmapuser = &mt('Other').' ('.$confhash{$itemid}{'mapuser'}.')';
+ }
+ $resulttext .= '- '.&mt('LON-CAPA username').': '.$shownmapuser.'
';
+ }
+ if (ref($confhash{$itemid}{'maproles'}) eq 'HASH') {
+ my $rolemaps;
+ foreach my $role (@ltiroles) {
+ if ($confhash{$itemid}{'maproles'}{$role}) {
+ $rolemaps .= (' 'x2).$role.'='.
+ &Apache::lonnet::plaintext($confhash{$itemid}{'maproles'}{$role},
+ 'Course').',';
+ }
+ }
+ if ($rolemaps) {
+ $rolemaps =~ s/,$//;
+ $resulttext .= '- '.&mt('Role mapping:').$rolemaps.'
';
+ }
+ }
+ if (ref($confhash{$itemid}{'makeuser'}) eq 'ARRAY') {
+ if (@{$confhash{$itemid}{'makeuser'}} > 0) {
+ $resulttext .= '- '.&mt('Following roles may create user accounts: [_1]',
+ join(', ',@{$confhash{$itemid}{'makeuser'}})).'
';
+ } else {
+ $resulttext .= '- '.&mt('User account creation not permitted.').'
';
+ }
+ }
+ if ($confhash{$itemid}{'mapcrs'}) {
+ $resulttext .= '- '.&mt('Unique course identifier').': '.$confhash{$itemid}{'mapcrs'}.'
';
+ }
+ if (ref($confhash{$itemid}{'mapcrstype'}) eq 'ARRAY') {
+ if (@{$confhash{$itemid}{'mapcrstype'}} > 0) {
+ $resulttext .= '- '.&mt('Mapping for the following LON-CAPA course types: [_1]',
+ join(', ',map { $coursetypetitles{$_}; } @coursetypes)).
+ '
';
+ } else {
+ $resulttext .= '- '.&mt('No mapping to LON-CAPA courses').'
';
+ }
+ }
+ if ($confhash{$itemid}{'makecrs'}) {
+ $resulttext .= '- '.&mt('Instructor may create course (if absent).').'
';
+ } else {
+ $resulttext .= '- '.&mt('Instructor may not create course (if absent).').'
';
+ }
+ if (ref($confhash{$itemid}{'selfenroll'}) eq 'ARRAY') {
+ if (@{$confhash{$itemid}{'selfenroll'}} > 0) {
+ $resulttext .= '- '.&mt('Self-enrollment for following roles: [_1]',
+ join(', ',@{$confhash{$itemid}{'selfenroll'}})).
+ '
';
+ } else {
+ $resulttext .= '- '.&mt('Self-enrollment not permitted').'
';
+ }
+ }
+ if ($confhash{$itemid}{'section'}) {
+ if ($confhash{$itemid}{'section'} eq 'course_section_sourcedid') {
+ $resulttext .= '- '.&mt('User section from standard field:').
+ ' (course_section_sourcedid)'.'
';
+ } else {
+ $resulttext .= '- '.&mt('User section from:').' '.
+ $confhash{$itemid}{'section'}.'
';
+ }
+ } else {
+ $resulttext .= '- '.&mt('No section assignment').'
';
+ }
+ foreach my $item ('passback','roster') {
+ $resulttext .= '- '.$lt{$item}.' ';
+ if ($confhash{$itemid}{$item}) {
+ $resulttext .= &mt('Yes');
+ } else {
+ $resulttext .= &mt('No');
+ }
+ $resulttext .= '
';
+ }
+ $resulttext .= ' ';
+ }
+ }
+ $resulttext .= ' ';
+ } else {
+ $resulttext = &mt('No changes made.');
+ }
+ } else {
+ $errors .= '- '.&mt('Failed to save changes').'
';
+ }
+ if ($errors) {
+ $resulttext .= &mt('The following errors occurred: ').'';
+ }
+ return $resulttext;
+}
+
+sub get_lti_id {
+ my ($domain,$consumer) = @_;
+ # get lock on lti db
+ my $lockhash = {
+ lock => $env{'user.name'}.
+ ':'.$env{'user.domain'},
+ };
+ my $tries = 0;
+ my $gotlock = &Apache::lonnet::newput_dom('lti',$lockhash,$domain);
+ my ($id,$error);
+
+ while (($gotlock ne 'ok') && ($tries<10)) {
+ $tries ++;
+ sleep (0.1);
+ $gotlock = &Apache::lonnet::newput_dom('lti',$lockhash,$domain);
+ }
+ if ($gotlock eq 'ok') {
+ my %currids = &Apache::lonnet::dump_dom('lti',$domain);
+ if ($currids{'lock'}) {
+ delete($currids{'lock'});
+ if (keys(%currids)) {
+ my @curr = sort { $a <=> $b } keys(%currids);
+ if ($curr[-1] =~ /^\d+$/) {
+ $id = 1 + $curr[-1];
+ }
+ } else {
+ $id = 1;
+ }
+ if ($id) {
+ unless (&Apache::lonnet::newput_dom('lti',{ $id => $consumer },$domain) eq 'ok') {
+ $error = 'nostore';
+ }
+ } else {
+ $error = 'nonumber';
+ }
+ }
+ my $dellockoutcome = &Apache::lonnet::del_dom('lti',['lock'],$domain);
+ } else {
+ $error = 'nolock';
+ }
return ($id,$error);
}
|