--- loncom/interface/courseprefs.pm 2022/02/07 18:29:01 1.49.2.28.2.4 +++ loncom/interface/courseprefs.pm 2023/12/29 19:44:06 1.49.2.28.2.19 @@ -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.4 2022/02/07 18:29:01 raeburn Exp $ +# $Id: courseprefs.pm,v 1.49.2.28.2.19 2023/12/29 19:44:06 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() @@ -112,7 +116,7 @@ This module is used for configuration of =item item_table_row_end() -=item yes_no_radio() +=item yesno_radio() =item select_from_options() @@ -220,6 +224,8 @@ use Apache::lonparmset; use Apache::courseclassifier; use Apache::lonlocal; use LONCAPA qw(:DEFAULT :match); +use Crypt::CBC; +use Time::HiRes qw( sleep ); my $registered_cleanup; my $modified_courses; @@ -288,7 +294,7 @@ sub handler { excc => 'Exclude from community catalog', clon => 'Users allowed to clone community', rept => 'Replacement titles for standard community roles', - time => 'Timezone where the community is located', + time => 'Time Zone where the community is located', date => 'Locale used for community calendar', coco => 'Community Content', copo => 'Community Policy', @@ -317,7 +323,7 @@ sub handler { excc => 'Exclude from course catalog', clon => 'Users allowed to clone course', rept => 'Replacement titles for standard course roles', - time => 'Timezone in which the course takes place', + time => 'Time Zone in which the course takes place', date => 'Locale used for course calendar', coco => 'Course Content', copo => 'Course Policy', @@ -365,30 +371,48 @@ 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') { + my %ltitools = &Apache::lonnet::dump('ltitools',$cdom,$cnum,undef,undef,undef,1); + my %ltitoolsenc = &Apache::lonnet::dump('nohist_toolsenc',$cdom,$cnum,undef,undef,undef,1); + 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{'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'}); + } + foreach my $id (keys(%ltitools)) { + if (ref($ltitools{$id}) eq 'HASH') { + if (ref($ltitoolsenc{$id}) eq 'HASH') { + $values{'ltitools'}{$id} = { %{$ltitools{$id}}, %{$ltitoolsenc{$id}} }; } else { - $values{'linkprotection'}{$id} = $lti{$id}; + $values{'ltitools'}{$id} = $ltitools{$id}; } } unless ($phase eq 'process') { - if (ref($values{'linkprotection'}{$id}) eq 'HASH') { - delete($values{'linkprotection'}{$id}{'secret'}); + if (ref($values{'ltitools'}{$id}) eq 'HASH') { + delete($values{'ltitools'}{$id}{'secret'}); } } } - if ($lti{'lock'}) { - delete($lti{'lock'}); + if ($ltitools{'lock'}) { + delete($ltitools{'lock'}); } my @prefs_order = ('courseinfo','localization','feedback','discussion', 'classlists','appearance','grading','printouts', - 'menuitems','linkprotection','spreadsheet','bridgetasks', - 'other'); - + 'menuitems','ltitools','linkprot','spreadsheet', + 'bridgetasks','other'); my %prefs = ( 'courseinfo' => { text => $lt{'gens'}, @@ -402,7 +426,7 @@ sub handler { 'co-owners' => $lt{'cown'}, 'description' => $lt{'desc'}, 'courseid' => $lt{'idnu'}, - 'uniquecode' => $lt{'unco'}, + 'uniquecode' => $lt{'unco'}, 'categories' => $lt{'catg'}, 'hidefromcat' => $lt{'excc'}, 'cloners' => $lt{'clon'}, @@ -450,7 +474,7 @@ sub handler { 'plc.users.denied' => 'No Chat room use', allow_limited_html_in_feedback => 'Allow limited HTML in discussion', allow_discussion_post_editing => 'Users can edit/delete own discussion posts', - discussion_post_fonts => 'Discussion post fonts based on likes/unlikes', + discussion_post_fonts => 'Discussion post fonts based on likes/unlikes', }, }, 'classlists' => @@ -484,7 +508,8 @@ sub handler { help => 'Course_Prefs_Display', ordered => ['default_xml_style','pageseparators', 'disable_receipt_display','texengine', - 'tthoptions','uselcmath','usejsme','inline_chem'], + 'tthoptions','uselcmath','usejsme', + 'inline_chem','extresource'], itemtext => { default_xml_style => 'Default XML style file', pageseparators => 'Visibly Separate Items on Pages', @@ -494,6 +519,7 @@ sub handler { uselcmath => 'Student formula entry uses inline preview, not DragMath pop-up', usejsme => 'Molecule editor uses JSME (HTML5) in place of JME (Java)', inline_chem => 'Chemical reaction response uses inline preview, not pop-up', + extresource => 'Display of external resources', }, }, 'grading' => @@ -563,7 +589,7 @@ sub handler { menucollections => 'Menu collections', }, }, - 'linkprotection' => + 'linkprot' => { text => 'Link protection', help => 'Course_Prefs_Linkprotection', @@ -571,6 +597,14 @@ sub handler { col2 => 'Settings', }], }, + 'ltitools' => + { + text => 'External tools', + help => 'Course_Prefs_ExternalTools', + header => [{col1 => 'Item', + col2 => 'Settings', + }], + }, 'other' => { text => 'Other settings', help => 'Course_Prefs_Other', @@ -581,10 +615,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') { @@ -641,6 +679,8 @@ sub get_allitems { if ($item eq 'feedback') { push(@allitems,(map { $_.'.text'; } @{$prefs{$item}{'ordered'}})); } + } elsif (($item eq 'linkprot') || ($item eq 'ltitools')) { + push(@allitems,$item); } } } @@ -767,17 +807,23 @@ sub print_config_box { } elsif ($action eq 'appearance') { $output .= &print_appearance($cdom,$settings,$ordered,$itemtext,\$rowtotal,$crstype,$noedit); } elsif ($action eq 'grading') { - $output .= &print_grading($cdom,$settings,$ordered,$itemtext,\$rowtotal,$crstype,$noedit); + $output .= &print_grading($cdom,$cnum,$settings,$ordered,$itemtext,\$rowtotal,$crstype,$noedit); } elsif ($action eq 'printouts') { $output .= &print_printouts($cdom,$settings,$ordered,$itemtext,\$rowtotal,$crstype,$noedit); } elsif ($action eq 'spreadsheet') { $output .= &print_spreadsheet($cdom,$settings,$ordered,$itemtext,\$rowtotal,$crstype,$noedit); } elsif ($action eq 'bridgetasks') { $output .= &print_bridgetasks($cdom,$settings,$ordered,$itemtext,\$rowtotal,$crstype,$noedit); + } elsif ($action eq 'ltitools') { + my $currtools = {}; + if ((ref($settings) eq 'HASH') && (ref($settings->{'ltitools'}))) { + $currtools = $settings->{'ltitools'}; + } + $output .= &print_ltitools($cdom,$cnum,$currtools,\$rowtotal,$crstype,$noedit,'course'); } 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); } @@ -790,8 +836,8 @@ sub print_config_box { } sub process_changes { - my ($cdom,$cnum,$action,$values,$item,$changes,$allitems,$disallowed,$crstype) = @_; - my (%newvalues,%lti,%ltienc,$ltiauth,$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; @@ -808,26 +854,17 @@ sub process_changes { } } } - } elsif ($action eq 'linkprotection') { + } elsif (($action eq 'linkprot') || ($action eq 'ltitools')) { 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} = ''; - } } } } @ordered = sort { $a <=> $b } @ordered; - 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'}; + if (($env{'form.'.$action.'_add'}) && ($env{'form.'.$action.'_maxnum'} =~ /^\d+$/)) { + push(@ordered,$env{'form.'.$action.'_maxnum'}); } } elsif (ref($item->{'ordered'}) eq 'ARRAY') { if ($action eq 'courseinfo') { @@ -966,144 +1003,15 @@ 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',$lastactref); + } + } elsif ($action eq 'ltitools') { + if (ref($values) eq 'HASH') { + my $switchserver = &check_switchserver($cdom,$cnum,'course','/adm/courseprefs'); + $errors = &process_ltitools('',$cdom,$cnum,$values->{$action},$changes,'course',$lastactref, + 'ok','','ok'); } } else { foreach my $entry (@ordered) { @@ -1548,10 +1456,81 @@ sub process_changes { $settings =~ s/,$//; } $newvalues{$entry} = $settings; + } elsif ($entry eq 'extresource') { + if ($env{'form.'.$entry} =~ /^iframe|tab|window$/) { + $newvalues{$entry} = $env{'form.'.$entry}; + if ($env{'form.'.$entry} ne 'iframe') { + if ($env{'form.extwintabreuse'}) { + $newvalues{$entry} .= ':1'; + } else { + $newvalues{$entry} .= ':0'; + } + if ($env{'form.'.$entry} eq 'window') { + foreach my $dim ('width','height') { + $env{'form.extreswin'.$dim} =~ s/^\s+|\s+$//g; + if ($env{'form.extreswin'.$dim} =~ /^\d+$/) { + $newvalues{$entry} .= ':'.$env{'form.extreswin'.$dim}; + } else { + $newvalues{$entry} .= ':'; + } + } + } + } + } + unless (($newvalues{$entry} eq 'iframe') && ($values->{$entry} eq '')) { + if ($newvalues{$entry} ne $values->{$entry}) { + $changes->{$entry} = $newvalues{$entry}; + } + } + } elsif ($entry eq 'timezone') { + if ($env{'form.'.$entry}) { + $newvalues{$entry} = $env{'form.'.$entry}; + if ($newvalues{$entry} ne $values->{$entry}) { + $changes->{$entry} = $newvalues{$entry}; + } + if ($env{'form.tzover'}) { + $newvalues{'tzover'} = $env{'form.tzover'}; + if ($newvalues{'tzover'} ne $values->{'tzover'}) { + $changes->{'tzover'} = $newvalues{'tzover'}; + } + } elsif ($values->{'tzover'}) { + $changes->{'tzover'} = ''; + } + } elsif ($values->{$entry}) { + $changes->{$entry} = ''; + } + } elsif ($entry eq 'grading') { + if ($env{'form.'.$entry} eq 'standard') { + if ($env{'form.hidetotals'}) { + my %sections = &Apache::loncommon::get_sections($cdom,$cnum); + if (keys(%sections)) { + my @secs = &Apache::loncommon::get_env_multiple('form.hidetotals_sections'); + if (grep(/^all$/,@secs)) { + $newvalues{'hidetotals'} = 'all'; + } elsif (@secs) { + $newvalues{'hidetotals'} = ''; + foreach my $sec (sort {$a <=> $b} @secs) { + if (exists($sections{$sec})) { + $newvalues{'hidetotals'} .= $sec.',' + } + } + $newvalues{'hidetotals'} =~ s/,$//; + } + } else { + $newvalues{'hidetotals'} = 'all'; + } + } + } + if ($newvalues{'hidetotals'} ne $values->{'hidetotals'}) { + $changes->{'hidetotals'} = $newvalues{'hidetotals'}; + $changes->{'grading'} = $env{'form.'.$entry}; + } + $newvalues{$entry} = $env{'form.'.$entry}; } else { $newvalues{$entry} = $env{'form.'.$entry}; } - unless (($entry eq 'co-owners') || ($entry eq 'discussion_post_fonts')) { + unless (($entry eq 'co-owners') || ($entry eq 'discussion_post_fonts') || + ($entry eq 'extresource') || ($entry eq 'timezone')) { if ($newvalues{$entry} ne $values->{$entry}) { $changes->{$entry} = $newvalues{$entry}; } @@ -1564,23 +1543,250 @@ 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 ($dest,$ltiauth,$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} = ''; + } + } + } + } + ($cipher,$privnum) = &get_credentials($cdom,$cnum,'lti',$context); + 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}; + } + } + my $urlitem = 'form.linkprot_returnurl_'.$idx; + my $urlparamname = 'form.linkprot_urlparam_'.$idx; + if ($env{$urlitem} == 1) { + $env{$urlparamname} =~ s/(`)/'/g; + } elsif (exists($env{$urlparamname})) { + $env{$urlparamname} = ''; + } + my $passback = 'form.linkprot_passback_'.$idx; + my $passbackparamname = 'form.linkprot_passbackformat_'.$idx; + if ($env{$passback} == 1) { + unless ($env{$passbackparamname} =~ /^1\.(0|1)$/) { + $env{$passbackparamname} = ''; + } + } elsif (exists($env{$passbackparamname})) { + $env{$passbackparamname} = ''; + } + unless ($idx eq 'add') { + if ((!$current{'returnurl'} && ($env{$urlparamname} ne '')) || + ($current{'returnurl'} && ($env{$urlparamname} eq ''))) { + $haschanges{$itemid} = 1; + } + if ((!$current{'passback'} && ($env{$passbackparamname} ne '')) || + ($current{'passback'} && ($env{$passbackparamname} eq ''))) { + $haschanges{$itemid} = 1; + } + } + if ($env{$urlparamname} ne '') { + $linkprot{$itemid}{'returnurl'} = $env{$urlparamname}; + } + if ($env{$passbackparamname} ne '') { + $linkprot{$itemid}{'passback'} = 1; + $linkprot{$itemid}{'passbackformat'} = $env{$passbackparamname}; + } + 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)) { @@ -1594,20 +1800,629 @@ 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'; } return ($id,$error); } +sub get_credentials { + my ($cdom,$cnum,$type,$context) = @_; + my ($cipher,$privnum,$home); + 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); + } + my ($hostskey,$domkey,$crskey); + if ($type eq 'ltitools') { + $hostskey = 'toolprivhosts'; + $domkey = 'toolenc_dom'; + $crskey = 'toolenc_crs'; + } else { + $hostskey = 'ltiprivhosts'; + $domkey = 'linkprotenc_dom'; + $crskey = 'linkprotenc_crs'; + } + if ((($context eq 'domain') && ($domdefs{$domkey})) || + (($context eq 'course') && ($domdefs{$crskey}))) { + unless (($home eq 'no_host') || ($home eq '')) { + if (grep(/^\Q$home\E$/,@ids)) { + if (ref($domdefs{$hostskey}) eq 'ARRAY') { + if (grep(/^\Q$home\E$/,@{$domdefs{$hostskey}})) { + my %privhash = &Apache::lonnet::restore_dom($type,'private',$cdom,$home,1); + my $privkey = $privhash{'key'}; + $privnum = $privhash{'version'}; + if (($privnum) && ($privkey ne '')) { + $cipher = Crypt::CBC->new({'key' => $privkey, + 'cipher' => 'DES'}); + } + } + } + } + } + } + return ($cipher,$privnum); +} + +sub process_ltitools { + my ($r,$cdom,$cnum,$values,$changes,$context,$lastactref,$configuserok,$lonhost, + $author_ok,$confname) = @_; + my (%currconfig,$newid,@allpos,%changes,%ltitools,$errors); + + my (%posslti,%possfield); + my @courseroles = ('cc','in','ta','ep','st'); + my @ltiroles = qw(Instructor ContentDeveloper TeachingAssistant Learner); + map { $posslti{$_} = 1; } @ltiroles; + my @allfields = ('fullname','firstname','lastname','email','user','roles'); + map { $possfield{$_} = 1; } @allfields; + + my ($dest,$privnum,$cipher); + + ($cipher,$privnum) = &get_credentials($cdom,$cnum,'ltitools',$context); + if ($context eq 'domain') { + $dest = '/adm/domainprefs'; + } else { + $dest = '/adm/courseprefs'; + } + my $switchserver = &check_switchserver($cdom,$cnum,$context,$dest); + + my (@allpos,@items,%deletions,%itemids,%haschanges); + if ($env{'form.ltitools_add'}) { + my $title = $env{'form.ltitools_add_title'}; + $title =~ s/(`)/'/g; + my ($newid,$error) = &Apache::lonnet::get_ltitools_id($context,$cdom,$cnum,$title); + if ($newid) { + my $position = $env{'form.ltitools_add_pos'}; + $position =~ s/\D+//g; + if ($position ne '') { + $allpos[$position] = $newid; + } + $haschanges{$newid} = 1; + foreach my $item ('title','url','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}) { + $ltitools{$newid}{$item} = $env{'form.ltitools_add_'.$item}; + } + } + if ($env{'form.ltitools_add_version'} eq 'LTI-1p0') { + $ltitools{$newid}{'version'} = $env{'form.ltitools_add_version'}; + } + if ($env{'form.ltitools_add_msgtype'} eq 'basic-lti-launch-request') { + $ltitools{$newid}{'msgtype'} = $env{'form.ltitools_add_msgtype'}; + } + if ($env{'form.ltitools_add_sigmethod'} eq 'HMAC-SHA256') { + $ltitools{$newid}{'sigmethod'} = $env{'form.ltitools_add_sigmethod'}; + } else { + $ltitools{$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+$//; + if (($item eq 'width') || ($item eq 'height')) { + if ($env{'form.ltitools_add_'.$item} =~ /^\d+$/) { + $ltitools{$newid}{'display'}{$item} = $env{'form.ltitools_add_'.$item}; + } + } else { + if ($env{'form.ltitools_add_'.$item} ne '') { + $ltitools{$newid}{'display'}{$item} = $env{'form.ltitools_add_'.$item}; + } + } + } + if ($env{'form.ltitools_add_target'} eq 'window') { + $ltitools{$newid}{'display'}{'target'} = $env{'form.ltitools_add_target'}; + } elsif ($env{'form.ltitools_add_target'} eq 'tab') { + $ltitools{$newid}{'display'}{'target'} = $env{'form.ltitools_add_target'}; + } else { + $ltitools{$newid}{'display'}{'target'} = 'iframe'; + } + foreach my $item ('passback','roster') { + if ($env{'form.ltitools_'.$item.'_add'}) { + $ltitools{$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*$/) { + $ltitools{$newid}{$item.'valid'} = $lifetime; + } + } + } + } + if ($env{'form.ltitools_add_image.filename'} ne '') { + my ($imageurl,$error) = + &process_ltitools_image($r,$context,$cdom,$cnum,$confname,'ltitools_add_image', + $newid,$configuserok,$lonhost,$author_ok); + if ($imageurl) { + $ltitools{$newid}{'image'} = $imageurl; + } + if ($error) { + &Apache::lonnet::logthis($error); + $errors .= '