--- loncom/interface/courseprefs.pm 2022/01/16 23:34:19 1.49.2.28.2.2
+++ loncom/interface/courseprefs.pm 2022/04/06 15:03:29 1.49.2.28.2.10
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to set configuration settings for a course
#
-# $Id: courseprefs.pm,v 1.49.2.28.2.2 2022/01/16 23:34:19 raeburn Exp $
+# $Id: courseprefs.pm,v 1.49.2.28.2.10 2022/04/06 15:03:29 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -52,12 +52,16 @@ This module is used for configuration of
=item process_changes()
+=item process_linkprot()
+
=item get_sec_str()
=item check_clone()
=item store_changes()
+=item store_linkprot()
+
=item update_env()
=item display_disallowed()
@@ -220,6 +224,7 @@ use Apache::lonparmset;
use Apache::courseclassifier;
use Apache::lonlocal;
use LONCAPA qw(:DEFAULT :match);
+use Crypt::CBC;
my $registered_cleanup;
my $modified_courses;
@@ -365,14 +370,28 @@ sub handler {
}
my %values=&Apache::lonnet::dump('environment',$cdom,$cnum);
- my %courselti=&Apache::lonnet::dump('lti',$cdom,$cnum,undef,undef,undef,1);
- if ($courselti{'lock'}) {
- delete($courselti{'lock'});
+ my %linkprot=&Apache::lonnet::dump('lti',$cdom,$cnum,undef,undef,undef,1);
+ my %ltienc = &Apache::lonnet::dump('nohist_ltienc',$cdom,$cnum,undef,undef,undef,1);
+ foreach my $id (keys(%linkprot)) {
+ if (ref($linkprot{$id}) eq 'HASH') {
+ if (ref($ltienc{$id}) eq 'HASH') {
+ $values{'linkprot'}{$id} = { %{$linkprot{$id}}, %{$ltienc{$id}} };
+ } else {
+ $values{'linkprot'}{$id} = $linkprot{$id};
+ }
+ }
+ unless ($phase eq 'process') {
+ if (ref($values{'linkprot'}{$id}) eq 'HASH') {
+ delete($values{'linkprot'}{$id}{'secret'});
+ }
+ }
+ }
+ if ($linkprot{'lock'}) {
+ delete($linkprot{'lock'});
}
- $values{'linkprotection'} = \%courselti;
my @prefs_order = ('courseinfo','localization','feedback','discussion',
'classlists','appearance','grading','printouts',
- 'menuitems','linkprotection','spreadsheet','bridgetasks',
+ 'menuitems','linkprot','spreadsheet','bridgetasks',
'other');
my %prefs = (
@@ -549,7 +568,7 @@ sub handler {
menucollections => 'Menu collections',
},
},
- 'linkprotection' =>
+ 'linkprot' =>
{
text => 'Link protection',
help => 'Course_Prefs_Linkprotection',
@@ -567,10 +586,14 @@ sub handler {
);
if (($phase eq 'process') && ($parm_permission->{'process'})) {
my @allitems = &get_allitems(%prefs);
- &Apache::lonconfigsettings::make_changes($r,$cdom,$phase,$context,
- \@prefs_order,\%prefs,\%values,
- $cnum,undef,\@allitems,
- 'coursepref',$parm_permission);
+ my $result = &Apache::lonconfigsettings::make_changes($r,$cdom,$phase,$context,
+ \@prefs_order,\%prefs,\%values,
+ $cnum,undef,\@allitems,
+ 'coursepref',$parm_permission);
+ if ((ref($result) eq 'HASH') && (keys(%{$result}))) {
+ $r->rflush();
+ &devalidate_remote_courseprefs($cdom,$cnum,$result);
+ }
} elsif (($phase eq 'display') && ($parm_permission->{'display'})) {
my $noedit;
if (ref($parm_permission) eq 'HASH') {
@@ -581,7 +604,7 @@ sub handler {
my $jscript = &get_jscript($cid,$cdom,$phase,$crstype,\%values,$noedit);
my @allitems = &get_allitems(%prefs);
&Apache::lonconfigsettings::display_settings($r,$cdom,$phase,$context,
- \@prefs_order,\%prefs,\%values,undef,$jscript,\@allitems,$crstype,
+ \@prefs_order,\%prefs,\%values,$cnum,$jscript,\@allitems,$crstype,
'coursepref',$parm_permission);
} else {
&Apache::lonconfigsettings::display_choices($r,$phase,$context,
@@ -634,7 +657,7 @@ sub get_allitems {
}
sub print_config_box {
- my ($r,$cdom,$phase,$action,$item,$settings,$allitems,$crstype,$parm_permission) = @_;
+ my ($r,$cdom,$cnum,$phase,$action,$item,$settings,$allitems,$crstype,$parm_permission) = @_;
my $ordered = $item->{'ordered'};
my $itemtext = $item->{'itemtext'};
my $noedit;
@@ -762,8 +785,8 @@ sub print_config_box {
$output .= &print_bridgetasks($cdom,$settings,$ordered,$itemtext,\$rowtotal,$crstype,$noedit);
} elsif ($action eq 'menuitems') {
$output .= &print_menuitems('bottom',$cdom,$settings,$itemtext,\$rowtotal,$crstype,$noedit);
- } elsif ($action eq 'linkprotection') {
- $output .= &print_linkprotection($cdom,$settings,\$rowtotal,$crstype,$noedit);
+ } elsif ($action eq 'linkprot') {
+ $output .= &print_linkprotection($cdom,$cnum,$settings,\$rowtotal,$crstype,$noedit,'course');
} elsif ($action eq 'other') {
$output .= &print_other($cdom,$settings,$allitems,\$rowtotal,$crstype,$noedit);
}
@@ -776,8 +799,8 @@ sub print_config_box {
}
sub process_changes {
- my ($cdom,$cnum,$action,$values,$item,$changes,$allitems,$disallowed,$crstype) = @_;
- my (%newvalues,%courselti,$errors);
+ my ($cdom,$cnum,$action,$values,$item,$changes,$allitems,$disallowed,$crstype,$lastactref) = @_;
+ my (%newvalues,$errors);
if (ref($item) eq 'HASH') {
if (ref($changes) eq 'HASH') {
my @ordered;
@@ -794,14 +817,11 @@ sub process_changes {
}
}
}
- } elsif ($action eq 'linkprotection') {
- if (ref($values->{'linkprotection'}) eq 'HASH') {
- foreach my $id (keys(%{$values->{'linkprotection'}})) {
+ } elsif ($action eq 'linkprot') {
+ if (ref($values->{$action}) eq 'HASH') {
+ foreach my $id (keys(%{$values->{$action}})) {
if ($id =~ /^\d+$/) {
push(@ordered,$id);
- unless (ref($values->{'linkprotection'}->{$id}) eq 'HASH') {
- $courselti{$id} = '';
- }
}
}
}
@@ -946,76 +966,9 @@ sub process_changes {
} elsif ($values->{'menucollections'}) {
$changes->{'menucollections'} = '';
}
- } elsif ($action eq 'linkprotection') {
- my %menutitles = <imenu_titles();
- my (@items,%deletions,%itemids,%haschanges);
- if ($env{'form.linkprot_add'}) {
- my $name = $env{'form.linkprot_name_add'};
- $name =~ s/(`)/'/g;
- my ($newid,$error) = &get_courselti_id($cdom,$cnum,$name);
- if ($newid) {
- $itemids{'add'} = $newid;
- push(@items,'add');
- $haschanges{$newid} = 1;
- } else {
- $errors .= ''.
- &mt('Failed to acquire unique ID for link protection').
- ' ';
- }
- }
- if (ref($values->{'linkprotection'}) eq 'HASH') {
- my @todelete = &Apache::loncommon::get_env_multiple('form.linkprot_del');
- my $maxnum = $env{'form.linkprot_maxnum'};
- for (my $i=0; $i<=$maxnum; $i++) {
- my $itemid = $env{'form.linkprot_id_'.$i};
- $itemid =~ s/\D+//g;
- if ($itemid) {
- if (ref($values->{'linkprotection'}->{$itemid}) eq 'HASH') {
- push(@items,$i);
- $itemids{$i} = $itemid;
- if ((@todelete > 0) && (grep(/^$i$/,@todelete))) {
- $deletions{$itemid} = $values->{'linkprotection'}->{$itemid}->{'name'};
- }
- }
- }
- }
- }
- foreach my $idx (@items) {
- my $itemid = $itemids{$idx};
- next unless ($itemid);
- if (exists($deletions{$itemid})) {
- $courselti{$itemid} = $deletions{$itemid};
- $haschanges{$itemid} = 1;
- next;
- }
- my %current;
- if (ref($values->{'linkprotection'}) eq 'HASH') {
- if (ref($values->{'linkprotection'}->{$itemid}) eq 'HASH') {
- foreach my $key (keys(%{$values->{'linkprotection'}->{$itemid}})) {
- $current{$key} = $values->{'linkprotection'}->{$itemid}->{$key};
- }
- }
- }
- foreach my $inner ('name','key','secret','lifetime','version') {
- my $formitem = 'form.linkprot_'.$inner.'_'.$idx;
- $env{$formitem} =~ s/(`)/'/g;
- if ($inner eq 'lifetime') {
- $env{$formitem} =~ s/[^\d.]//g;
- }
- unless ($idx eq 'add') {
- if ($current{$inner} ne $env{$formitem}) {
- $haschanges{$itemid} = 1;
- }
- }
- if ($env{$formitem} ne '') {
- $courselti{$itemid}{$inner} = $env{$formitem};
- }
- }
- }
- if (keys(%haschanges)) {
- foreach my $entry (keys(%haschanges)) {
- $changes->{$entry} = $courselti{$entry};
- }
+ } elsif ($action eq 'linkprot') {
+ if (ref($values) eq 'HASH') {
+ $errors = &process_linkprot($cdom,$cnum,$values->{$action},$changes,'course',$lastactref);
}
} else {
foreach my $entry (@ordered) {
@@ -1476,23 +1429,241 @@ sub process_changes {
return $errors;
}
-sub get_courselti_id {
- my ($cdom,$cnum,$name) = @_;
- # get lock on lti db in course
+sub process_linkprot {
+ my ($cdom,$cnum,$values,$changes,$context,$lastactref) = @_;
+ my ($home,$dest,$ltiauth,$privkey,$privnum,$cipher,$errors,%linkprot);
+ if (ref($values) eq 'HASH') {
+ foreach my $id (keys(%{$values})) {
+ if ($id =~ /^\d+$/) {
+ unless (ref($values->{$id}) eq 'HASH') {
+ $linkprot{$id} = '';
+ }
+ }
+ }
+ }
+ my %domdefs = &Apache::lonnet::get_domain_defaults($cdom);
+ my @ids=&Apache::lonnet::current_machine_ids();
+ if ($context eq 'domain') {
+ $home = &Apache::lonnet::domain($cdom,'primary');
+ } else {
+ $home = &Apache::lonnet::homeserver($cnum,$cdom);
+ }
+ if ((($context eq 'domain') && ($domdefs{'linkprotenc_dom'})) ||
+ (($context eq 'course') && ($domdefs{'linkprotenc_crs'}))) {
+ unless (($home eq 'no_host') || ($home eq '')) {
+ if (grep(/^\Q$home\E$/,@ids)) {
+ if (ref($domdefs{'privhosts'}) eq 'ARRAY') {
+ if (grep(/^\Q$home\E$/,@{$domdefs{'privhosts'}})) {
+ my %privhash = &Apache::lonnet::restore_dom('lti','private',$cdom,$home,1);
+ $privkey = $privhash{'key'};
+ $privnum = $privhash{'version'};
+ if (($privnum) && ($privkey ne '')) {
+ $cipher = Crypt::CBC->new({'key' => $privkey,
+ 'cipher' => 'DES'});
+ }
+ }
+ }
+ }
+ }
+ }
+ if ($context eq 'domain') {
+ $dest = '/adm/domainprefs';
+ $ltiauth = 1;
+ } else {
+ $dest = '/adm/courseprefs';
+ if (exists($env{'course.'.$env{'request.course.id'}.'.internal.ltiauth'})) {
+ $ltiauth = $env{'course.'.$env{'request.course.id'}.'.internal.ltiauth'};
+ } else {
+ my %domdefs = &Apache::lonnet::get_domain_defaults($cdom);
+ $ltiauth = $domdefs{'crsltiauth'};
+ }
+ }
+ my $switchserver = &check_switchserver($cdom,$cnum,$context,$dest);
+ my (@items,%deletions,%itemids,%haschanges);
+ if ($env{'form.linkprot_add'}) {
+ my $name = $env{'form.linkprot_name_add'};
+ $name =~ s/(`)/'/g;
+ my ($newid,$error) = &get_linkprot_id($cdom,$cnum,$name,$context);
+ if ($newid) {
+ $itemids{'add'} = $newid;
+ push(@items,'add');
+ $haschanges{$newid} = 1;
+ } else {
+ $errors .= ''.
+ &mt('Failed to acquire unique ID for link protection').
+ ' ';
+ }
+ }
+ if (ref($values) eq 'HASH') {
+ my @todelete = &Apache::loncommon::get_env_multiple('form.linkprot_del');
+ my $maxnum = $env{'form.linkprot_maxnum'};
+ for (my $i=0; $i<$maxnum; $i++) {
+ my $itemid = $env{'form.linkprot_id_'.$i};
+ $itemid =~ s/\D+//g;
+ if ($itemid) {
+ if (ref($values->{$itemid}) eq 'HASH') {
+ push(@items,$i);
+ $itemids{$i} = $itemid;
+ if ((@todelete > 0) && (grep(/^$i$/,@todelete))) {
+ $deletions{$itemid} = $values->{$itemid}->{'name'};
+ }
+ }
+ }
+ }
+ }
+ foreach my $idx (@items) {
+ my $itemid = $itemids{$idx};
+ next unless ($itemid);
+ if (exists($deletions{$itemid})) {
+ $linkprot{$itemid} = $deletions{$itemid};
+ $haschanges{$itemid} = 1;
+ next;
+ }
+ my %current;
+ if (ref($values) eq 'HASH') {
+ if (ref($values->{$itemid}) eq 'HASH') {
+ foreach my $key (keys(%{$values->{$itemid}})) {
+ $current{$key} = $values->{$itemid}->{$key};
+ }
+ }
+ }
+ foreach my $inner ('name','lifetime','version') {
+ my $formitem = 'form.linkprot_'.$inner.'_'.$idx;
+ $env{$formitem} =~ s/(`)/'/g;
+ if ($inner eq 'lifetime') {
+ $env{$formitem} =~ s/[^\d.]//g;
+ }
+ unless ($idx eq 'add') {
+ if ($current{$inner} ne $env{$formitem}) {
+ $haschanges{$itemid} = 1;
+ }
+ }
+ if ($env{$formitem} ne '') {
+ $linkprot{$itemid}{$inner} = $env{$formitem};
+ }
+ }
+ if ($ltiauth) {
+ my $reqitem = 'form.linkprot_requser_'.$idx;
+ $env{$reqitem} =~ s/(`)/'/g;
+ unless ($idx eq 'add') {
+ if ((!$current{'requser'} && $env{$reqitem}) ||
+ ($current{'requser'} && !$env{$reqitem})) {
+ $haschanges{$itemid} = 1;
+ }
+ }
+ if ($env{$reqitem} == 1) {
+ $linkprot{$itemid}{'requser'} = $env{$reqitem};
+ foreach my $inner ('mapuser','notstudent') {
+ my $formitem = 'form.linkprot_'.$inner.'_'.$idx;
+ $env{$formitem} =~ s/(`)/'/g;
+ if ($inner eq 'mapuser') {
+ if ($env{$formitem} eq 'other') {
+ my $mapuser = $env{'form.linkprot_customuser_'.$idx};
+ $mapuser =~ s/(`)/'/g;
+ $mapuser =~ s/^\s+|\s+$//g;
+ if ($mapuser ne '') {
+ $linkprot{$itemid}{$inner} = $mapuser;
+ } else {
+ delete($linkprot{$itemid}{'requser'});
+ last;
+ }
+ } elsif ($env{$formitem} eq 'sourcedid') {
+ $linkprot{$itemid}{$inner} = 'lis_person_sourcedid';
+ } elsif ($env{$formitem} eq 'email') {
+ $linkprot{$itemid}{$inner} = 'lis_person_contact_email_primary';
+ }
+ } else {
+ $linkprot{$itemid}{$inner} = $env{$formitem};
+ }
+ unless ($idx eq 'add') {
+ if ($current{$inner} ne $linkprot{$itemid}{$inner}) {
+ $haschanges{$itemid} = 1;
+ }
+ }
+ }
+ }
+ }
+ unless ($switchserver) {
+ my $keyitem = 'form.linkprot_key_'.$idx;
+ $env{$keyitem} =~ s/(`)/'/g;
+ unless ($idx eq 'add') {
+ if ($current{'key'} ne $env{$keyitem}) {
+ $haschanges{$itemid} = 1;
+ }
+ }
+ if ($env{$keyitem} ne '') {
+ $linkprot{$itemid}{'key'} = $env{$keyitem};
+ }
+ my $secretitem = 'form.linkprot_secret_'.$idx;
+ $env{$secretitem} =~ s/(`)/'/g;
+ if ($current{'usable'}) {
+ if ($env{'form.linkprot_changesecret_'.$idx}) {
+ if ($env{$secretitem} ne '') {
+ if ($privnum && $cipher) {
+ $linkprot{$itemid}{'secret'} = $cipher->encrypt_hex($env{$secretitem});
+ $linkprot{$itemid}{'cipher'} = $privnum;
+ } else {
+ $linkprot{$itemid}{'secret'} = $env{$secretitem};
+ }
+ $haschanges{$itemid} = 1;
+ }
+ } else {
+ $linkprot{$itemid}{'secret'} = $current{'secret'};
+ $linkprot{$itemid}{'cipher'} = $current{'cipher'};
+ }
+ } elsif ($env{$secretitem} ne '') {
+ if ($privnum && $cipher) {
+ $linkprot{$itemid}{'secret'} = $cipher->encrypt_hex($env{$secretitem});
+ $linkprot{$itemid}{'cipher'} = $privnum;
+ } else {
+ $linkprot{$itemid}{'secret'} = $env{$secretitem};
+ }
+ $haschanges{$itemid} = 1;
+ }
+ }
+ }
+ if (keys(%haschanges)) {
+ foreach my $entry (keys(%haschanges)) {
+ $changes->{$entry} = $linkprot{$entry};
+ }
+ if (ref($lastactref) eq 'HASH') {
+ $lastactref->{'courselti'} = 1;
+ }
+ }
+ return $errors;
+}
+
+sub get_linkprot_id {
+ my ($cdom,$cnum,$name,$context) = @_;
+ # get lock on lti db in course or linkprot db in domain
my $lockhash = {
lock => $env{'user.name'}.
':'.$env{'user.domain'},
};
my $tries = 0;
- my $gotlock = &Apache::lonnet::newput('lti',$lockhash,$cdom,$cnum);
+ my $gotlock;
+ if ($context eq 'domain') {
+ $gotlock = &Apache::lonnet::newput_dom('linkprot',$lockhash,$cdom);
+ } else {
+ $gotlock = &Apache::lonnet::newput('lti',$lockhash,$cdom,$cnum);
+ }
my ($id,$error);
while (($gotlock ne 'ok') && ($tries<10)) {
$tries ++;
sleep (0.1);
- $gotlock = &Apache::lonnet::newput('lti',$lockhash,$cdom,$cnum);
+ if ($context eq 'domain') {
+ $gotlock = &Apache::lonnet::newput_dom('linkprot',$lockhash,$cdom);
+ } else {
+ $gotlock = &Apache::lonnet::newput('lti',$lockhash,$cdom,$cnum);
+ }
}
if ($gotlock eq 'ok') {
- my %currids = &Apache::lonnet::dump('lti',$cdom,$cnum,undef,undef,undef,1);
+ my %currids;
+ if ($context eq 'domain') {
+ %currids = &Apache::lonnet::dump_dom('linkprot',$cdom);
+ } else {
+ %currids = &Apache::lonnet::dump('lti',$cdom,$cnum,undef,undef,undef,1);
+ }
if ($currids{'lock'}) {
delete($currids{'lock'});
if (keys(%currids)) {
@@ -1506,14 +1677,25 @@ sub get_courselti_id {
$id = 1;
}
if ($id) {
- unless (&Apache::lonnet::newput('lti',{ $id => $name },$cdom,$cnum) eq 'ok') {
- $error = 'nostore';
+ if ($context eq 'domain') {
+ unless (&Apache::lonnet::newput_dom('linkprot',{ $id => $name },$cdom) eq 'ok') {
+ $error = 'nostore';
+ }
+ } else {
+ unless (&Apache::lonnet::newput('lti',{ $id => $name },$cdom,$cnum) eq 'ok') {
+ $error = 'nostore';
+ }
}
} else {
$error = 'nonumber';
}
}
- my $dellockoutcome = &Apache::lonnet::del('lti',['lock'],$cdom,$cnum);
+ my $dellockoutcome;
+ if ($context eq 'domain') {
+ $dellockoutcome = &Apache::lonnet::del_dom('linkprot',['lock'],$cdom);
+ } else {
+ $dellockoutcome = &Apache::lonnet::del('lti',['lock'],$cdom,$cnum);
+ }
} else {
$error = 'nolock';
}
@@ -1564,10 +1746,10 @@ sub store_changes {
my ($chome,$output);
my (%storehash,@delkeys,@need_env_update,@oldcloner,%oldlinkprot);
if ((ref($values) eq 'HASH') && (ref($changes) eq 'HASH')) {
- if (ref($values->{'linkprotection'}) eq 'HASH') {
- %oldlinkprot = %{$values->{'linkprotection'}};
+ if (ref($values->{'linkprot'}) eq 'HASH') {
+ %oldlinkprot = %{$values->{'linkprot'}};
}
- delete($values->{'linkprotection'});
+ delete($values->{'linkprot'});
%storehash = %{$values};
} else {
if ($crstype eq 'Community') {
@@ -1580,7 +1762,7 @@ sub store_changes {
my ($numchanges,$skipstore);
if (ref($changes) eq 'HASH') {
$numchanges = scalar(keys(%{$changes}));
- if (($numchanges == 1) && (exists($changes->{'linkprotection'}))) {
+ if (($numchanges == 1) && (exists($changes->{'linkprot'}))) {
$skipstore = 1;
} elsif (!$numchanges) {
if ($crstype eq 'Community') {
@@ -1603,7 +1785,7 @@ sub store_changes {
if (grep(/^\Q$item\E$/,@{$actions})) {
$output .= '
'.&mt($prefs->{$item}{'text'}).' ';
if (ref($changes->{$item}) eq 'HASH') {
- if ((keys(%{$changes->{$item}}) > 0) || ($item eq 'linkprotection')) {
+ if (keys(%{$changes->{$item}}) > 0) {
$output .= &mt('Changes made:').'';
if ($item eq 'other') {
foreach my $key (sort(keys(%{$changes->{$item}}))) {
@@ -1616,41 +1798,8 @@ sub store_changes {
"'$storehash{$key}'")).'';
}
}
- } elsif ($item eq 'linkprotection') {
- if (&Apache::lonnet::put('lti',$changes->{'linkprotection'},$cdom,$cnum,1) eq 'ok') {
- my $hashid=$cdom.'_'.$cnum;
- &Apache::lonnet::devalidate_cache_new('courselti',$hashid);
- foreach my $itemid (sort { $a <=> $b } %{$changes->{'linkprotection'}}) {
- if (ref($changes->{'linkprotection'}->{$itemid}) eq 'HASH') {
- my %values = %{$changes->{'linkprotection'}->{$itemid}};
- my %desc = &linkprot_names();
- my $display;
- foreach my $title ('name','lifetime','version','key','secret') {
- if ($title eq 'secret') {
- my $length = length($values{$title});
- $display .= $desc{$title}.': '.('*' x $length);
- } elsif ($title eq 'version') {
- if ($values{$title} eq 'LTI-1p0') {
- $display .= $desc{$title}.': 1.1, ';
- }
- } else {
- $display .= $desc{$title}.': '.$values{$title}.', ';
- }
- }
- $output .= ''.&Apache::lonhtmlcommon::confirm_success(&mt('[_1] set to [_2]',''.$itemid.' ',
- "'$display'")).' ';
- } elsif (ref($oldlinkprot{$itemid}) eq 'HASH') {
- my $oldname = $oldlinkprot{$itemid}{'name'};
- $output .= ''.&Apache::lonhtmlcommon::confirm_success(&mt('Deleted setting for [_1]',''."$itemid ($oldname)".' ')).' ';
- }
- }
- } else {
- $output .= ''.
- ''.
- &mt('An error occurred when saving changes to link protection settings, which remain unchanged.').
- ' '.
- ' ';
- }
+ } elsif ($item eq 'linkprot') {
+ $output .= &store_linkprot($cdom,$cnum,'course',$changes->{$item},\%oldlinkprot);
} else {
if (ref($prefs->{$item}->{'ordered'}) eq 'ARRAY') {
my @settings = @{$prefs->{$item}->{'ordered'}};
@@ -1953,6 +2102,160 @@ sub store_changes {
return $output;
}
+sub store_linkprot {
+ my ($cdom,$cnum,$context,$changes,$oldlinkprot) = @_;
+ my ($ltiauth,$home,$lti_save_error,$output,$error,%ltienc,@deletions);
+ if ($context eq 'domain') {
+ $ltiauth = 1;
+ $home = &Apache::lonnet::domain($cdom,'primary');
+ } else {
+ $home = &Apache::lonnet::homeserver($cnum,$cdom);
+ if (exists($env{'course.'.$env{'request.course.id'}.'.internal.ltiauth'})) {
+ $ltiauth = $env{'course.'.$env{'request.course.id'}.'.internal.ltiauth'};
+ } else {
+ my %domdefs = &Apache::lonnet::get_domain_defaults($cdom);
+ $ltiauth = $domdefs{'crsltiauth'};
+ }
+ }
+ if (ref($changes) eq 'HASH') {
+ foreach my $id (sort { $a <=> $b } keys(%{$changes})) {
+ if (ref($changes->{$id}) eq 'HASH') {
+ if (exists($changes->{$id}->{'key'})) {
+ $ltienc{$id}{'key'} = $changes->{$id}->{'key'};
+ delete($changes->{$id}->{'key'});
+ }
+ if (exists($changes->{$id}->{'secret'})) {
+ $ltienc{$id}{'secret'} = $changes->{$id}->{'secret'};
+ delete($changes->{$id}->{'secret'});
+ } elsif (ref($oldlinkprot->{$id}) eq 'HASH') {
+ if (exists($oldlinkprot->{$id}{'usable'})) {
+ $changes->{$id}->{'usable'} = 1;
+ }
+ if (exists($oldlinkprot->{$id}{'cipher'})) {
+ $changes->{$id}->{'cipher'} = $oldlinkprot->{$id}{'cipher'};
+ }
+ }
+ }
+ }
+ }
+ my @ids=&Apache::lonnet::current_machine_ids();
+ if (keys(%ltienc) > 0) {
+ if ($context eq 'domain') {
+ foreach my $id (keys(%ltienc)) {
+ if (exists($ltienc{$id}{'secret'})) {
+ $changes->{$id}->{'usable'} = 1;
+ }
+ }
+ } else {
+ unless (($home eq 'no_host') || ($home eq '')) {
+ my $allowed;
+ foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
+ if ($allowed) {
+ if (&Apache::lonnet::put('nohist_ltienc',\%ltienc,$cdom,$cnum,1) eq 'ok') {
+ foreach my $id (keys(%ltienc)) {
+ if (exists($ltienc{$id}{'secret'})) {
+ $changes->{$id}->{'usable'} = 1;
+ }
+ }
+ } else {
+ $lti_save_error = 1;
+ }
+ }
+ }
+ }
+ }
+ unless ($lti_save_error) {
+ if ($context eq 'course') {
+ if (&Apache::lonnet::put('lti',$changes,$cdom,$cnum,1) eq 'ok') {
+ my $hashid=$cdom.'_'.$cnum;
+ &Apache::lonnet::devalidate_cache_new('courselti',$hashid);
+ unless (($home eq 'no_host') || ($home eq '')) {
+ if (grep(/^\Q$home\E$/,@ids)) {
+ &Apache::lonnet::devalidate_cache_new('courseltienc',$hashid);
+ }
+ }
+ } else {
+ $lti_save_error = 1;
+ }
+ }
+ unless ($lti_save_error) {
+ foreach my $id (sort { $a <=> $b } %{$changes}) {
+ if (ref($changes->{$id}) eq 'HASH') {
+ my %values = %{$changes->{$id}};
+ my %desc = &linkprot_names();
+ my $display;
+ foreach my $title ('name','lifetime','version','key','secret') {
+ if (($title eq 'key') || ($title eq 'secret')) {
+ if (ref($ltienc{$id}) eq 'HASH') {
+ if (exists($ltienc{$id}{$title})) {
+ if ($title eq 'secret') {
+ my $length = length($ltienc{$id}{$title});
+ $display .= $desc{$title}.': ['.&mt('not shown').'], ';
+ } else {
+ $display .= $desc{$title}.': '.$ltienc{$id}{$title}.', ';
+ }
+ }
+ }
+ } elsif ($title eq 'version') {
+ if ($values{$title} eq 'LTI-1p0') {
+ $display .= $desc{$title}.': 1.1, ';
+ }
+ } else {
+ $display .= $desc{$title}.': '.$values{$title}.', ';
+ }
+ }
+ if ($ltiauth) {
+ if (($values{'requser'}) && ($values{'mapuser'} ne '')) {
+ if ($values{'mapuser'} eq 'lis_person_contact_email_primary') {
+ $display .= &mt('Source of username: Email address [_1]',
+ '(lis_person_contact_email_primary)').', ';
+ } elsif ($values{'mapuser'} eq 'lis_person_sourcedid') {
+ $display .= &mt('Source of username: User ID [_1]',
+ '(lis_person_sourcedid)').', ';
+ } else {
+ $display .= &mt('Source of username: [_1]',$values{'mapuser'}).', ';
+ }
+ if ($values{'notstudent'} eq 'auth') {
+ $display .= &mt('Display LON-CAPA login page if no match').', ';
+ } elsif ($values{'notstudent'} eq 'reject') {
+ $display .= &mt('Discontinue launch if no match').', ';
+ }
+ }
+ }
+ $display =~ s/, $//;
+ $output .= ''.&Apache::lonhtmlcommon::confirm_success(&mt('[_1] set to [_2]',''.$id.' ',
+ "'$display'")).' ';
+ } elsif (ref($oldlinkprot->{$id}) eq 'HASH') {
+ my $oldname = $oldlinkprot->{$id}{'name'};
+ $output .= ''.&Apache::lonhtmlcommon::confirm_success(&mt('Deleted setting for [_1]',''."$id ($oldname)".' ')).' ';
+ }
+ }
+ } else {
+ $lti_save_error = 1;
+ }
+ }
+ unless ($lti_save_error) {
+ foreach my $id (sort { $a <=> $b } keys(%{$changes})) {
+ unless (ref($changes->{$id}) eq 'HASH') {
+ push(@deletions,$id);
+ }
+ }
+ if (@deletions) {
+ if ($context eq 'course') {
+ &Apache::lonnet::del('nohist_ltienc',\@deletions,$cdom,$cnum);
+ }
+ }
+ }
+ if ($lti_save_error) {
+ $output .= ''.
+ ''.
+ &mt('An error occurred when saving changes to link protection settings, which remain unchanged.').
+ ' '.
+ ' ';
+ }
+ return $output;
+}
+
sub update_env {
my ($cnum,$cdom,$chome,$need_env_update,$storehash) = @_;
my $count = 0;
@@ -2294,7 +2597,8 @@ ENDSCRIPT
'// '."\n".
+ $syllabus_js."\n".$menuitems_js."\n".
+ &linkprot_javascript()."\n".'//]]>'."\n".
''."\n".$stubrowse_js."\n";
return $jscript;
}
@@ -2380,6 +2684,78 @@ function getIndexByName(item) {
ENDSCRIPT
}
+sub linkprot_javascript {
+ return <<"ENDSCRIPT";
+function toggleLinkProt(form,num,item) {
+ var radioname = '';
+ var currdivid = '';
+ var newdivid = '';
+ if ((document.getElementById('linkprot_divcurr'+item+'_'+num)) &&
+ (document.getElementById('linkprot_divchg'+item+'_'+num))) {
+ currdivid = document.getElementById('linkprot_divcurr'+item+'_'+num);
+ newdivid = document.getElementById('linkprot_divchg'+item+'_'+num);
+ radioname = form.elements['linkprot_change'+item+'_'+num];
+ if (radioname) {
+ if (radioname.length > 0) {
+ var setvis;
+ for (var i=0; i 0) {
+ var setvis;
+ for (var i=0; i ['top','inline','foot','main'],
text => ['name','role','crs','disc','fdbk'],
- links => ['pers','logo','menu','comm','roles','help','logout'],
+ links => ['pers','logo','comm','roles','help','logout'],
list => ['about','prefs','port','wish','anno','rss'],
inline => ['cont','grades','chat','people','groups','resv','syll','feeds'],
);
@@ -4796,7 +5172,6 @@ sub menuitems_fields {
main => 'Access to main menu',
pers => 'Personal',
logo => 'LON-CAPA',
- menu => 'Home',
comm => 'Messages',
roles => 'Roles/Courses',
help => 'Help',
@@ -4890,30 +5265,60 @@ sub menucollections_display {
}
sub print_linkprotection {
- my ($cdom,$settings,$rowtotal,$crstype,$noedit) = @_;
- unless (ref($settings) eq 'HASH') {
- return;
- }
+ my ($cdom,$cnum,$settings,$rowtotal,$crstype,$noedit,$context) = @_;
my %linkprotection;
my $count = 0;
my $next = 1;
- my ($datatable,$disabled,$css_class);
+ my ($datatable,$disabled,$css_class,$dest);
if ($noedit) {
$disabled = ' disabled="disabled"';
}
- my %lt = &linkprot_names();
+ my %desc = &linkprot_names();
+ my %lt = &Apache::lonlocal::texthash (
+ 'requ' => 'Required settings',
+ 'opti' => 'Optional settings',
+ );
my $itemcount = 0;
- if (ref($settings->{'linkprotection'}) eq 'HASH') {
- if (keys(%{$settings->{'linkprotection'}})) {
- my @current = sort { $a <=> $b } keys(%{$settings->{'linkprotection'}});
+ my $ltiauth;
+ if ($context eq 'domain') {
+ $ltiauth = 1;
+ } else {
+ if (exists($env{'course.'.$env{'request.course.id'}.'.internal.ltiauth'})) {
+ $ltiauth = $env{'course.'.$env{'request.course.id'}.'.internal.ltiauth'};
+ } else {
+ my %domdefs = &Apache::lonnet::get_domain_defaults($cdom);
+ $ltiauth = $domdefs{'crsltiauth'};
+ }
+ }
+ if ($context eq 'domain') {
+ $dest = '/adm/domainprefs';
+ } else {
+ $dest = '/adm/courseprefs';
+ }
+
+ my ($switchserver,$switchmessage);
+ $switchserver = &check_switchserver($cdom,$cnum,$context,$dest);
+ if ($switchserver) {
+ if ($context eq 'domain') {
+ $switchmessage = &mt("submit from domain's primary library server: [_1].",$switchserver);
+ } elsif ($crstype eq 'Community') {
+ $switchmessage = &mt("submit from community's home server: [_1].",$switchserver);
+ } else {
+ $switchmessage = &mt("submit from course's home server: [_1].",$switchserver);
+ }
+ }
+
+ if ((ref($settings) eq 'HASH') && (ref($settings->{'linkprot'}) eq 'HASH')) {
+ if (keys(%{$settings->{'linkprot'}})) {
+ my @current = sort { $a <=> $b } keys(%{$settings->{'linkprot'}});
$next += $current[-1];
for (my $i=0; $i<@current; $i++) {
my $num = $current[$i];
my %values;
- if (ref($settings->{'linkprotection'}->{$num}) eq 'HASH') {
- %values = %{$settings->{'linkprotection'}->{$num}};
+ if (ref($settings->{'linkprot'}->{$num}) eq 'HASH') {
+ %values = %{$settings->{'linkprot'}->{$num}};
} else {
next;
}
@@ -4925,24 +5330,102 @@ sub print_linkprotection {
$datatable .=
''.
' '.
- &mt('Delete?').' '.
- ''.$lt{'name'}.
- ': '.
+ &mt('Delete?').'';
+ my ($usersty,$onclickrequser,%checkedrequser);
+ if ($ltiauth) {
+ $usersty = 'display:none';
+ $onclickrequser = ' onclick="toggleLinkProtReqUser(this.form,'."'requser','optional','1','block','$i'".');"';
+ %checkedrequser = (
+ no => ' checked="checked"',
+ yes => '',
+ );
+ if ($values{'requser'}) {
+ $checkedrequser{'yes'} = $checkedrequser{'no'};
+ $checkedrequser{'no'} = '';
+ }
+ $datatable .= ''.$lt{'requ'}.' ';
+ if ($values{'requser'}) {
+ $usersty = 'display:inline-block';
+ }
+ }
+ $datatable .=
+ ''.$desc{'name'}.
+ ': '.
(' 'x2).
- ''.$lt{'version'}.':'.
+ ''.$desc{'version'}.':'.
'1.1 '."\n".
(' 'x2).
- ''.$lt{'lifetime'}.': '.
- ' '.
- ''.$lt{'key'}.
- ': '.
- (' 'x2).
- ''.$lt{'secret'}.':'.
- ' '.
- ' '.&mt('Visible input').' '.
- ' '.
- ' ';
+ ''.$desc{'lifetime'}.': ';
+ if ($ltiauth) {
+ $datatable .= (' 'x2).''.$desc{'requser'}.'?'.
+ ' '.&mt('No').' '.
+ ' '.&mt('Yes').' ';
+ }
+ $datatable .= ' ';
+ if ($values{'key'} ne '') {
+ $datatable .= ''.$desc{'key'};
+ if ($noedit) {
+ $datatable .= ': ['.&mt('not shown').']';
+ } elsif ($switchserver) {
+ $datatable .= ': ['.&mt('[_1] to view/edit',$switchserver).']';
+ } else {
+ $datatable .= ': ';
+ }
+ $datatable .= ' '.(' 'x2);
+ } elsif (!$switchserver) {
+ $datatable .= ''.$desc{'key'}.':'.
+ ' '.
+ ' '.(' 'x2);
+ }
+ if ($switchserver) {
+ if ($values{'usable'} ne '') {
+ $datatable .= '
'.
+ $desc{'secret'}.': ['.&mt('not shown').'] '.(' 'x2).' '.
+ ''.&mt('Change secret?').
+ ' '.&mt('No').' '.
+ (' 'x2).
+ ' '.&mt('Yes').' '.(' 'x2).
+ '
'.
+ ' - '.$switchmessage.' '.
+ '';
+ } elsif ($values{'key'} eq '') {
+ $datatable .= ''.&mt('Key and Secret are required').' - '.$switchmessage.' '."\n";
+ } else {
+ $datatable .= ''.&mt('Secret required').' - '.$switchmessage.' '."\n";
+ }
+ $datatable .= ' ';
+ } else {
+ if ($values{'usable'} ne '') {
+ $datatable .= '
'.
+ $desc{'secret'}.': ['.&mt('not shown').'] '.(' 'x2).' '.
+ ''.&mt('Change?').
+ ' '.&mt('No').' '.
+ (' 'x2).
+ ' '.&mt('Yes').
+ '
'.
+ ''.&mt('New Secret').':'.
+ ' '.
+ ' '.&mt('Visible input').' '.
+ ' ';
+ } else {
+ $datatable .=
+ ''.$desc{'secret'}.':'.
+ ' '.
+ ' '.&mt('Visible input').' '.
+ ' ';
+ }
+ }
+ if ($ltiauth) {
+ $datatable .=
+ ''.
+ ''.$lt{'opti'}.' '.
+ &linkprot_options($i,$itemcount,$disabled,\%values,\%desc).
+ ' ';
+ }
+ $datatable .= '';
$itemcount ++;
}
}
@@ -4950,34 +5433,136 @@ sub print_linkprotection {
$css_class = $itemcount%2?' class="LC_odd_row"':'';
$datatable .= ''."\n".
' '."\n".
- ' '.&mt('Add').' '."\n".
- ''.
- ''.$lt{'name'}.
- ': '."\n".
+ ' '.&mt('Add').' '."\n".
+ '';
+ my ($usersty,$onclickrequser,%checkedrequser);
+ if ($ltiauth) {
+ $usersty = 'display:none';
+ $onclickrequser = ' onclick="toggleLinkProtReqUser(this.form,'."'requser','optional','1','block','add'".');"';
+ %checkedrequser = (
+ no => ' checked="checked"',
+ yes => '',
+ );
+ $datatable .= ''.$lt{'requ'}.' ';
+ }
+ $datatable .= ''.$desc{'name'}.
+ ': '."\n".
(' 'x2).
- ''.$lt{'version'}.':'.
+ ''.$desc{'version'}.':'.
'1.1 '."\n".
(' 'x2).
- ''.$lt{'lifetime'}.': '."\n".
- ' '.
- ''.$lt{'key'}.': '."\n".
- (' 'x2).
- ''.$lt{'secret'}.': '.
- ' '.&mt('Visible input').' '."\n".
- ' ';
+ ''.$desc{'lifetime'}.': '."\n";
+ if ($ltiauth) {
+ $datatable .= (' 'x2).''.$desc{'requser'}.'?'.
+ ' '.&mt('No').' '.
+ ' '.&mt('Yes').' ';
+ }
+ $datatable .= ' ';
+ if ($switchserver) {
+ $datatable .= ''.&mt('Key and Secret are required').' - '.$switchmessage.' '."\n";
+ } else {
+ $datatable .= ''.$desc{'key'}.': '."\n".
+ (' 'x2).
+ ''.$desc{'secret'}.': '.
+ ' '.&mt('Visible input').' '."\n";
+ }
+ if ($ltiauth) {
+ $datatable .= ''.
+ ''.$lt{'opti'}.' '.
+ &linkprot_options('add',$itemcount,$disabled,{},\%desc).
+ ' ';
+ }
+ $datatable .= '';
$$rowtotal ++;
- return $datatable;;
+ return $datatable;
}
sub linkprot_names {
- my %lt = &Apache::lonlocal::texthash(
+ return &Apache::lonlocal::texthash(
'version' => 'LTI Version',
'key' => 'Key',
'lifetime' => 'Nonce lifetime (s)',
- 'name' => 'Launcher Application Name',
+ 'name' => 'Launcher Application',
'secret' => 'Secret',
+ 'requser' => 'Use identity',
+ 'email' => 'Email address',
+ 'sourcedid' => 'User ID',
+ 'other' => 'Other',
+ 'auth' => 'Display LON-CAPA login page',
+ 'reject' => 'Discontinue launch process',
);
- return %lt;
+}
+
+sub check_switchserver {
+ my ($cdom,$cnum,$context,$dest) = @_;
+ my ($allowed,$switchserver,$home);
+ if ($context eq 'domain') {
+ $home = &Apache::lonnet::domain($cdom,'primary');
+ } else {
+ $home = &Apache::lonnet::homeserver($cnum,$cdom);
+ }
+ unless (($home eq 'no_host') || ($home eq '')) {
+ my @ids=&Apache::lonnet::current_machine_ids();
+ foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } }
+ if (!$allowed) {
+ $switchserver=''.&mt('Switch Server').' ';
+ }
+ }
+ return $switchserver;
+}
+
+sub linkprot_options {
+ my ($num,$itemcount,$disabled,$current,$desc) = @_;
+ my %lt;
+ if (ref($desc) eq 'HASH') {
+ %lt = %{$desc};
+ }
+ my $userfieldsty = 'none';
+ my (%checked,$userfield);
+ $checked{'sourcedid'} = ' checked="checked"';
+ $checked{'reject'} = ' checked="checked"';
+ if (ref($current) eq 'HASH') {
+ if (($current->{'mapuser'} ne '') && ($current->{'mapuser'} ne 'lis_person_sourcedid')) {
+ $checked{'sourcedid'} = '';
+ if ($current->{'mapuser'} eq 'lis_person_contact_email_primary') {
+ $checked{'email'} = ' checked="checked"';
+ } else {
+ $checked{'other'} = ' checked="checked"';
+ $userfield = $current->{'mapuser'};
+ $userfieldsty = 'inline-block';
+ }
+ }
+ if (($current->{'notstudent'} ne '') && ($current->{'notstudent'} ne 'reject')) {
+ $checked{'reject'} = '';
+ $checked{'auth'} = ' checked="checked"';
+ }
+ }
+ my $onclickuser = ' onclick="toggleLinkProtReqUser(this.form,'."'mapuser','userfield','other','inline-block','$num'".');"';
+ my $output = ''.
+ &mt('Source of LON-CAPA username in LTI request').': ';
+ foreach my $option ('sourcedid','email','other') {
+ $output .= ' '.$lt{$option}.' '.
+ ($option eq 'other' ? '' : (' 'x2) );
+ }
+ $output .= '
'.
+ ''.
+ '
';
+ $output .= ' '.
+ ''.
+ &mt('Action when username is not for an enrolled student').': ';
+ foreach my $option ('reject','auth') {
+ $output .= ' '.$lt{$option}.' '.
+ ($option eq 'auth' ? '' : (' 'x2) );
+ }
+ $output .= '
';
+ return $output;
}
sub print_other {
@@ -5595,6 +6180,30 @@ sub change_clone {
}
}
}
+ return;
+}
+
+sub devalidate_remote_courseprefs {
+ my ($cdom,$cnum,$cachekeys) = @_;
+ return unless (ref($cachekeys) eq 'HASH');
+ my %servers = &Apache::lonnet::internet_dom_servers($cdom);
+ my %thismachine;
+ map { $thismachine{$_} = 1; } &Apache::lonnet::current_machine_ids();
+ my @posscached = ('courselti');
+ if (keys(%servers)) {
+ foreach my $server (keys(%servers)) {
+ next if ($thismachine{$server});
+ my @cached;
+ foreach my $name (@posscached) {
+ if ($cachekeys->{$name}) {
+ push(@cached,&escape($name).':'.&escape($cdom.'_'.$cnum));
+ }
+ }
+ if (@cached) {
+ &Apache::lonnet::remote_devalidate_cache($server,\@cached);
+ }
+ }
+ }
return;
}
500 Internal Server Error
Internal Server Error
The server encountered an internal error or
misconfiguration and was unable to complete
your request.
Please contact the server administrator at
root@localhost to inform them of the time this error occurred,
and the actions you performed just before this error.
More information about this error may be available
in the server error log.