--- loncom/interface/courseprefs.pm 2022/02/07 06:16:44 1.101 +++ loncom/interface/courseprefs.pm 2022/02/15 04:28:01 1.102 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Handler to set configuration settings for a course # -# $Id: courseprefs.pm,v 1.101 2022/02/07 06:16:44 raeburn Exp $ +# $Id: courseprefs.pm,v 1.102 2022/02/15 04:28:01 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() @@ -365,28 +369,28 @@ sub handler { } my %values=&Apache::lonnet::dump('environment',$cdom,$cnum); - my %lti=&Apache::lonnet::dump('lti',$cdom,$cnum,undef,undef,undef,1); + 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(%lti)) { - if (ref($lti{$id}) eq 'HASH') { + foreach my $id (keys(%linkprot)) { + if (ref($linkprot{$id}) eq 'HASH') { if (ref($ltienc{$id}) eq 'HASH') { - $values{'linkprotection'}{$id} = { %{$lti{$id}}, %{$ltienc{$id}} }; + $values{'linkprot'}{$id} = { %{$linkprot{$id}}, %{$ltienc{$id}} }; } else { - $values{'linkprotection'}{$id} = $lti{$id}; + $values{'linkprot'}{$id} = $linkprot{$id}; } } unless ($phase eq 'process') { - if (ref($values{'linkprotection'}{$id}) eq 'HASH') { - delete($values{'linkprotection'}{$id}{'secret'}); + if (ref($values{'linkprot'}{$id}) eq 'HASH') { + delete($values{'linkprot'}{$id}{'secret'}); } } } - if ($lti{'lock'}) { - delete($lti{'lock'}); + if ($linkprot{'lock'}) { + delete($linkprot{'lock'}); } my @prefs_order = ('courseinfo','localization','feedback','discussion', 'classlists','appearance','grading','printouts', - 'menuitems','linkprotection','spreadsheet','bridgetasks', + 'menuitems','linkprot','spreadsheet','bridgetasks', 'lti','other'); my %prefs = ( @@ -578,7 +582,7 @@ sub handler { menucollections => 'Menu collections', }, }, - 'linkprotection' => + 'linkprot' => { text => 'Link protection', help => 'Course_Prefs_Linkprotection', @@ -793,8 +797,8 @@ sub print_config_box { $output .= &print_lti($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,$cnum,$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); } @@ -808,7 +812,7 @@ sub print_config_box { sub process_changes { my ($cdom,$cnum,$action,$values,$item,$changes,$allitems,$disallowed,$crstype) = @_; - my (%newvalues,%lti,%ltienc,$ltiauth,$errors); + my (%newvalues,$errors); if (ref($item) eq 'HASH') { if (ref($changes) eq 'HASH') { my @ordered; @@ -825,14 +829,11 @@ sub process_changes { } } } - } elsif ($action eq '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->{$action}->{$id}) eq 'HASH') { - $lti{$id} = ''; - } } } } @@ -840,12 +841,6 @@ sub process_changes { if (($env{'form.linkprot_add'}) && ($env{'form.linkprot_maxnum'} =~ /^\d+$/)) { push(@ordered,$env{'form.linkprot_maxnum'}); } - 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'}; - } } elsif (ref($item->{'ordered'}) eq 'ARRAY') { if ($action eq 'courseinfo') { my ($can_toggle_cat,$can_categorize) = @@ -983,145 +978,9 @@ sub process_changes { } elsif ($values->{'menucollections'}) { $changes->{'menucollections'} = ''; } - } elsif ($action eq 'linkprotection') { - my %menutitles = <imenu_titles(); - my $switchserver = &check_switchserver($cdom,$cnum); - 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->{$action}) 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->{$action}->{$itemid}) eq 'HASH') { - push(@items,$i); - $itemids{$i} = $itemid; - if ((@todelete > 0) && (grep(/^$i$/,@todelete))) { - $deletions{$itemid} = $values->{$action}->{$itemid}->{'name'}; - } - } - } - } - } - - foreach my $idx (@items) { - my $itemid = $itemids{$idx}; - next unless ($itemid); - if (exists($deletions{$itemid})) { - $lti{$itemid} = $deletions{$itemid}; - $haschanges{$itemid} = 1; - next; - } - my %current; - if (ref($values->{$action}) eq 'HASH') { - if (ref($values->{$action}->{$itemid}) eq 'HASH') { - foreach my $key (keys(%{$values->{$action}->{$itemid}})) { - $current{$key} = $values->{$action}->{$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 '') { - $lti{$itemid}{$inner} = $env{$formitem}; - } - } - if ($ltiauth) { - my $reqitem = 'form.linkprot_requser_'.$idx; - $env{$reqitem} =~ s/(`)/'/g; - unless ($idx eq 'add') { - if ($current{'requser'} ne $env{$reqitem}) { - $haschanges{$itemid} = 1; - } - } - if ($env{$reqitem} ne '') { - $lti{$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 '') { - $lti{$itemid}{$inner} = $mapuser; - } else { - delete($lti{$itemid}{'requser'}); - last; - } - } elsif ($env{$formitem} eq 'sourcedid') { - $lti{$itemid}{$inner} = 'lis_person_sourcedid'; - } elsif ($env{$formitem} eq 'email') { - $lti{$itemid}{$inner} = 'lis_person_contact_email_primary'; - } - } else { - $lti{$itemid}{$inner} = $env{$formitem}; - } - unless ($idx eq 'add') { - if ($current{$inner} ne $lti{$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 '') { - $lti{$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 '') { - $lti{$itemid}{'secret'} = $env{$secretitem}; - $haschanges{$itemid} = 1; - } - } else { - $lti{$itemid}{'secret'} = $current{'secret'}; - } - } elsif ($env{$secretitem} ne '') { - $lti{$itemid}{'secret'} = $env{$secretitem}; - $haschanges{$itemid} = 1; - } - } - } - if (keys(%haschanges)) { - foreach my $entry (keys(%haschanges)) { - $changes->{$entry} = $lti{$entry}; - } + } elsif ($action eq 'linkprot') { + if (ref($values) eq 'HASH') { + $errors = &process_linkprot($cdom,$cnum,$values->{$action},$changes,'course'); } } else { foreach my $entry (@ordered) { @@ -1616,23 +1475,201 @@ 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) = @_; + my ($dest,$ltiauth,$errors,%linkprot); + if (ref($values) eq 'HASH') { + foreach my $id (keys(%{$values})) { + if ($id =~ /^\d+$/) { + unless (ref($values->{$id}) eq 'HASH') { + $linkprot{$id} = ''; + } + } + } + } + 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'} ne $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 '') { + $linkprot{$itemid}{'secret'} = $env{$secretitem}; + $haschanges{$itemid} = 1; + } + } else { + $linkprot{$itemid}{'secret'} = $current{'secret'}; + } + } elsif ($env{$secretitem} ne '') { + $linkprot{$itemid}{'secret'} = $env{$secretitem}; + $haschanges{$itemid} = 1; + } + } + } + if (keys(%haschanges)) { + foreach my $entry (keys(%haschanges)) { + $changes->{$entry} = $linkprot{$entry}; + } + } + 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)) { @@ -1646,14 +1683,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'; } @@ -1704,10 +1752,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') { @@ -1720,7 +1768,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') { @@ -1756,127 +1804,8 @@ sub store_changes { "'$storehash{$key}'")).''; } } - } elsif ($item eq 'linkprotection') { - my ($ltiauth,%ltienc,$lti_save_error); - 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->{$item}) eq 'HASH') { - foreach my $id (sort { $a <=> $b } keys(%{$changes->{$item}})) { - if (ref($changes->{$item}->{$id}) eq 'HASH') { - if (exists($changes->{$item}->{$id}->{'key'})) { - $ltienc{$id}{'key'} = $changes->{$item}->{$id}->{'key'}; - delete($changes->{$item}->{$id}->{'key'}); - } - if (exists($changes->{$item}->{$id}->{'secret'})) { - $ltienc{$id}{'secret'} = $changes->{$item}->{$id}->{'secret'}; - delete($changes->{$item}->{$id}->{'secret'}); - } elsif (ref($oldlinkprot{$id}) eq 'HASH') { - if (exists($oldlinkprot{$id}{'usable'})) { - $changes->{$item}->{$id}->{'usable'} = 1; - } - } - } - } - } - if (keys(%ltienc) > 0) { - if (&Apache::lonnet::put('nohist_ltienc',\%ltienc,$cdom,$cnum,1) eq 'ok') { - foreach my $id (keys(%ltienc)) { - if (exists($ltienc{$id}{'secret'})) { - $changes->{$item}->{$id}->{'usable'} = 1; - } - } - } else { - $lti_save_error = 1; - } - } - unless ($lti_save_error) { - if (&Apache::lonnet::put('lti',$changes->{$item},$cdom,$cnum,1) eq 'ok') { - my $hashid=$cdom.'_'.$cnum; - &Apache::lonnet::devalidate_cache_new('courselti',$hashid); - $chome = &Apache::lonnet::homeserver($cnum,$cdom); - unless (($chome eq 'no_host') || ($chome eq '')) { - my @ids=&Apache::lonnet::current_machine_ids(); - if (grep(/^\Q$chome\E$/,@ids)) { - &Apache::lonnet::devalidate_cache_new('courseltienc',$hashid); - } - } - foreach my $id (sort { $a <=> $b } %{$changes->{$item}}) { - if (ref($changes->{$item}->{$id}) eq 'HASH') { - my %values = %{$changes->{$item}->{$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}.': '.('*' x $length).', '; - } 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) { - my @deletions; - foreach my $id (sort { $a <=> $b } keys(%{$changes->{$item}})) { - unless (ref($changes->{$item}->{$id}) eq 'HASH') { - push (@deletions,$id); - } - } - if (@deletions) { - &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.'). - ''. - '
    • '; - } + } 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'}}; @@ -2210,6 +2139,156 @@ sub store_changes { return $output; } +sub store_linkprot { + my ($cdom,$cnum,$context,$changes,$oldlinkprot) = @_; + my ($ltiauth,$lti_save_error,$output,$error,%ltienc,@deletions); + 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 (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; + } + } + } + } + } + my $chome = &Apache::lonnet::homeserver($cnum,$cdom); + 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 (($chome eq 'no_host') || ($chome 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 (($chome eq 'no_host') || ($chome eq '')) { + if (grep(/^\Q$chome\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}.': '.('*' x $length).', '; + } 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; @@ -2549,70 +2628,12 @@ function toggleAddmenucoll() { } ENDSCRIPT } - my $linkprotector_js = <<"ENDSCRIPT"; -function toggleLTI(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'."\n". + &linkprot_javascript()."\n".'//]]>'."\n". ''."\n".$stubrowse_js."\n"; return $jscript; } @@ -2698,6 +2719,68 @@ 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{'linkprotection'}) eq 'HASH') { - if (keys(%{$settings->{'linkprotection'}})) { - my @current = sort { $a <=> $b } keys(%{$settings->{'linkprotection'}}); + if (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; } @@ -5553,7 +5656,7 @@ sub print_linkprotection { my ($usersty,$onclickrequser,%checkedrequser); if ($ltiauth) { $usersty = 'display:none'; - $onclickrequser = ' onclick="toggleLTIReqUser(this.form,'."'requser','optional','1','block','$i'".');"'; + $onclickrequser = ' onclick="toggleLinkProtReqUser(this.form,'."'requser','optional','1','block','$i'".');"'; %checkedrequser = ( no => ' checked="checked"', yes => '', @@ -5604,25 +5707,25 @@ sub print_linkprotection { $datatable .= '
    '. $desc{'secret'}.': ['.&mt('not shown').'] '.(' 'x2).'
    '. ''.&mt('Change secret?'). - ''. + ''. (' 'x2). - ''.(' 'x2). + ''.(' 'x2). ''; } elsif ($values{'key'} eq '') { - $datatable .= ''.&mt('Key and Secret are required').' - '.&mt("submit from course's home server: [_1].",$switchserver).''."\n"; + $datatable .= ''.&mt('Key and Secret are required').' - '.$switchmessage.''."\n"; } else { - $datatable .= ''.&mt('Secret required').' - '.&mt("submit from course's home server: [_1].",$switchserver).''."\n"; + $datatable .= ''.&mt('Secret required').' - '.$switchmessage.''."\n"; } } else { if ($values{'usable'} ne '') { $datatable .= '
    '. $desc{'secret'}.': ['.&mt('not shown').'] '.(' 'x2).'
    '. ''.&mt('Change?'). - ''. + ''. (' 'x2). - '