--- loncom/interface/courseprefs.pm 2021/08/04 19:59:10 1.93 +++ loncom/interface/courseprefs.pm 2023/06/03 03:32:16 1.123 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Handler to set configuration settings for a course # -# $Id: courseprefs.pm,v 1.93 2021/08/04 19:59:10 raeburn Exp $ +# $Id: courseprefs.pm,v 1.123 2023/06/03 03:32:16 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,16 +371,48 @@ 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); + 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{'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{'ltitools'}{$id} = $ltitools{$id}; + } + } + unless ($phase eq 'process') { + if (ref($values{'ltitools'}{$id}) eq 'HASH') { + delete($values{'ltitools'}{$id}{'secret'}); + } + } + } + if ($ltitools{'lock'}) { + delete($ltitools{'lock'}); } - $values{'linkprotection'} = \%courselti; my @prefs_order = ('courseinfo','localization','feedback','discussion', 'classlists','appearance','grading','printouts', - 'menuitems','linkprotection','spreadsheet','bridgetasks', - 'lti','other'); - + 'menuitems','ltitools','linkprot','spreadsheet', + 'bridgetasks','lti','other'); my %prefs = ( 'courseinfo' => { text => $lt{'gens'}, @@ -473,7 +511,8 @@ sub handler { help => 'Course_Prefs_Display', ordered => ['default_xml_style','pageseparators', 'disable_receipt_display','texengine', - 'tthoptions','uselcmath','usejsme'], + 'tthoptions','uselcmath','usejsme', + 'inline_chem','extresource'], itemtext => { default_xml_style => 'Default XML style file', pageseparators => 'Visibly Separate Items on Pages', @@ -482,6 +521,8 @@ sub handler { tthoptions => 'Default set of options to pass to tth/m when converting TeX', 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 +604,7 @@ sub handler { menucollections => 'Menu collections', }, }, - 'linkprotection' => + 'linkprot' => { text => 'Link protection', help => 'Course_Prefs_Linkprotection', @@ -571,6 +612,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 +630,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') { @@ -595,7 +648,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, @@ -648,7 +701,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; @@ -774,12 +827,18 @@ sub print_config_box { $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 'lti') { $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,$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); } @@ -792,8 +851,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; @@ -810,20 +869,17 @@ sub process_changes { } } } - } elsif ($action eq 'linkprotection') { - if (ref($values->{'linkprotection'}) eq 'HASH') { - foreach my $id (keys(%{$values->{'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->{'linkprotection'}->{$id}) eq 'HASH') { - $courselti{$id} = ''; - } } } } @ordered = sort { $a <=> $b } @ordered; - if (($env{'form.linkprot_add'}) && ($env{'form.linkprot_maxnum'} =~ /^\d+$/)) { - push(@ordered,$env{'form.linkprot_maxnum'}); + 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') { @@ -962,77 +1018,15 @@ 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); + } + } 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) { @@ -1163,7 +1157,9 @@ sub process_changes { $autocoowner = $domconf{'autoenroll'}{'co-owners'}; } } - unless ($autocoowner) { + if ($autocoowner) { + $newvalues{'co-owners'} = $values->{'internal.co-owners'}; + } else { my @keepcoowners = &Apache::loncommon::get_env_multiple('form.coowners'); my @pendingcoowners = &Apache::loncommon::get_env_multiple('form.pendingcoowners'); my @invitecoowners = &Apache::loncommon::get_env_multiple('form.invitecoowners'); @@ -1208,6 +1204,8 @@ sub process_changes { if ($pendingcoowners ne '') { @newpending = @pendingcoown; } + } else { + @newcoown = @currcoown; } $newvalues{'pendingco-owners'} = join(',',sort(@newpending)); $newvalues{'co-owners'} = join(',',sort(@newcoown)); @@ -1507,10 +1505,54 @@ sub process_changes { $newvalues{$entry} = ''; } } + } 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} = ''; + } } 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}; } @@ -1523,23 +1565,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)) { @@ -1553,20 +1822,696 @@ 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; + 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) = &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 .= '
  • '.$error.'
    • '; + } + } + my @fields = &Apache::loncommon::get_env_multiple('form.ltitools_add_fields'); + foreach my $field (@fields) { + if ($possfield{$field}) { + if ($field eq 'roles') { + foreach my $role (@courseroles) { + my $choice = $env{'form.ltitools_add_roles_'.$role}; + if (($choice ne '') && ($posslti{$choice})) { + $ltitools{$newid}{'roles'}{$role} = $choice; + if ($role eq 'cc') { + $ltitools{$newid}{'roles'}{'co'} = $choice; + } + } + } + } else { + $ltitools{$newid}{'fields'}{$field} = 1; + } + } + } + if (ref($ltitools{$newid}{'fields'}) eq 'HASH') { + if ($ltitools{$newid}{'fields'}{'user'}) { + if ($env{'form.ltitools_add_userincdom'}) { + $ltitools{$newid}{'incdom'} = 1; + } + } + } + my @courseconfig = &Apache::loncommon::get_env_multiple('form.ltitools_add_courseconfig'); + foreach my $item (@courseconfig) { + $ltitools{$newid}{'crsconf'}{$item} = 1; + } + if ($env{'form.ltitools_add_custom'}) { + my $name = $env{'form.ltitools_add_custom_name'}; + my $value = $env{'form.ltitools_add_custom_value'}; + $value =~ s/(`)/'/g; + $name =~ s/(`)/'/g; + $ltitools{$newid}{'custom'}{$name} = $value; + } + unless ($switchserver) { + my $keyitem = 'form.ltitools_add_key'; + $env{$keyitem} =~ s/(`)/'/g; + if ($env{$keyitem} ne '') { + $ltitools{$newid}{'key'} = $env{$keyitem}; + } + my $secretitem = 'form.ltitools_secret_add'; + $env{$secretitem} =~ s/(`)/'/g; + if ($env{$secretitem} ne '') { + if ($privnum && $cipher) { + $ltitools{$newid}{'secret'} = $cipher->encrypt_hex($env{$secretitem}); + $ltitools{$newid}{'cipher'} = $privnum; + } else { + $ltitools{$newid}{'secret'} = $env{$secretitem}; + } + } + } + } else { + $errors .= '
  • '. + &mt('Failed to acquire unique ID for new external tool'). + '
    • '; + } + } + if (ref($values) eq 'HASH') { + my %deletions; + my @todelete = &Apache::loncommon::get_env_multiple('form.ltitools_del'); + if (@todelete) { + map { $deletions{$_} = 1; } @todelete; + } + my %customadds; + my @newcustom = &Apache::loncommon::get_env_multiple('form.ltitools_customadd'); + if (@newcustom) { + map { $customadds{$_} = 1; } @newcustom; + } + my %imgdeletions; + my @todeleteimages = &Apache::loncommon::get_env_multiple('form.ltitools_image_del'); + if (@todeleteimages) { + map { $imgdeletions{$_} = 1; } @todeleteimages; + } + my $maxnum = $env{'form.ltitools_maxnum'}; + for (my $i=0; $i<=$maxnum; $i++) { + my $itemid = $env{'form.ltitools_id_'.$i}; + $itemid =~ s/\D+//g; + if (ref($values->{$itemid}) eq 'HASH') { + if ($deletions{$itemid}) { + if ($values->{$itemid}{'image'}) { + #FIXME need to obsolete item in RES space + } + $haschanges{$itemid} = $values->{$itemid}{'title'}; + next; + } else { + my $newpos = $env{'form.ltitools_'.$itemid}; + $newpos =~ s/\D+//g; + foreach my $item ('title','url','lifetime') { + $ltitools{$itemid}{$item} = $env{'form.ltitools_'.$item.'_'.$i}; + if ($values->{$itemid}{$item} ne $ltitools{$itemid}{$item}) { + $haschanges{$itemid} = 1; + } + } + if ($env{'form.ltitools_version_'.$i} eq 'LTI-1p0') { + $ltitools{$itemid}{'version'} = $env{'form.ltitools_version_'.$i}; + } + if ($env{'form.ltitools_msgtype_'.$i} eq 'basic-lti-launch-request') { + $ltitools{$itemid}{'msgtype'} = $env{'form.ltitools_msgtype_'.$i}; + } + if ($env{'form.ltitools_sigmethod_'.$i} eq 'HMAC-SHA256') { + $ltitools{$itemid}{'sigmethod'} = $env{'form.ltitools_sigmethod_'.$i}; + } else { + $ltitools{$itemid}{'sigmethod'} = 'HMAC-SHA1'; + } + if ($values->{$itemid}{'sigmethod'} eq '') { + if ($ltitools{$itemid}{'sigmethod'} ne 'HMAC-SHA1') { + $haschanges{$itemid} = 1; + } + } elsif ($values->{$itemid}{'sigmethod'} ne $ltitools{$itemid}{'sigmethod'}) { + $haschanges{$itemid} = 1; + } + foreach my $size ('width','height') { + $env{'form.ltitools_'.$size.'_'.$i} =~ s/^\s+//; + $env{'form.ltitools_'.$size.'_'.$i} =~ s/\s+$//; + if ($env{'form.ltitools_'.$size.'_'.$i} =~ /^\d+$/) { + $ltitools{$itemid}{'display'}{$size} = $env{'form.ltitools_'.$size.'_'.$i}; + if (ref($values->{$itemid}{'display'}) eq 'HASH') { + if ($values->{$itemid}{'display'}{$size} ne $ltitools{$itemid}{'display'}{$size}) { + $haschanges{$itemid} = 1; + } + } else { + $haschanges{$itemid} = 1; + } + } elsif (ref($values->{$itemid}{'display'}) eq 'HASH') { + if ($values->{$itemid}{'display'}{$size} ne '') { + $haschanges{$itemid} = 1; + } + } + } + foreach my $item ('linktext','explanation') { + $env{'form.ltitools_'.$item.'_'.$i} =~ s/^\s+//; + $env{'form.ltitools_'.$item.'_'.$i} =~ s/\s+$//; + if ($env{'form.ltitools_'.$item.'_'.$i} ne '') { + $ltitools{$itemid}{'display'}{$item} = $env{'form.ltitools_'.$item.'_'.$i}; + if (ref($values->{$itemid}{'display'}) eq 'HASH') { + if ($values->{$itemid}{'display'}{$item} ne $ltitools{$itemid}{'display'}{$item}) { + $haschanges{$itemid} = 1; + } + } else { + $haschanges{$itemid} = 1; + } + } elsif (ref($values->{$itemid}{'display'}) eq 'HASH') { + if ($values->{$itemid}{'display'}{$item} ne '') { + $haschanges{$itemid} = 1; + } + } + } + if ($env{'form.ltitools_target_'.$i} eq 'window') { + $ltitools{$itemid}{'display'}{'target'} = $env{'form.ltitools_target_'.$i}; + } elsif ($env{'form.ltitools_target_'.$i} eq 'tab') { + $ltitools{$itemid}{'display'}{'target'} = $env{'form.ltitools_target_'.$i}; + } else { + $ltitools{$itemid}{'display'}{'target'} = 'iframe'; + } + if (ref($values->{$itemid}{'display'}) eq 'HASH') { + if ($values->{$itemid}{'display'}{'target'} ne $ltitools{$itemid}{'display'}{'target'}) { + $haschanges{$itemid} = 1; + } + } else { + $haschanges{$itemid} = 1; + } + foreach my $extra ('passback','roster') { + if ($env{'form.ltitools_'.$extra.'_'.$i}) { + $ltitools{$itemid}{$extra} = 1; + if ($env{'form.ltitools_'.$extra.'valid_'.$i} ne '') { + my $lifetime = $env{'form.ltitools_'.$extra.'valid_'.$i}; + $lifetime =~ s/^\s+|\s+$//g; + if ($lifetime =~ /^\d+\.?\d*$/) { + $ltitools{$itemid}{$extra.'valid'} = $lifetime; + } + } + } + if ($values->{$itemid}{$extra} ne $ltitools{$itemid}{$extra}) { + $haschanges{$itemid} = 1; + } + if ($values->{$itemid}{$extra.'valid'} ne $ltitools{$itemid}{$extra.'valid'}) { + $haschanges{$itemid} = 1; + } + } + my @courseconfig = &Apache::loncommon::get_env_multiple('form.ltitools_courseconfig_'.$i); + foreach my $item ('label','title','target','linktext','explanation','append') { + if (grep(/^\Q$item\E$/,@courseconfig)) { + $ltitools{$itemid}{'crsconf'}{$item} = 1; + if (ref($values->{$itemid}{'crsconf'}) eq 'HASH') { + if ($values->{$itemid}{'crsconf'}{$item} ne $ltitools{$itemid}{'crsconf'}{$item}) { + $haschanges{$itemid} = 1; + } + } else { + $haschanges{$itemid} = 1; + } + } + } + my @fields = &Apache::loncommon::get_env_multiple('form.ltitools_fields_'.$i); + foreach my $field (@fields) { + if ($possfield{$field}) { + if ($field eq 'roles') { + foreach my $role (@courseroles) { + my $choice = $env{'form.ltitools_roles_'.$role.'_'.$i}; + if (($choice ne '') && ($posslti{$choice})) { + $ltitools{$itemid}{'roles'}{$role} = $choice; + if ($role eq 'cc') { + $ltitools{$itemid}{'roles'}{'co'} = $choice; + } + } + if (ref($values->{$itemid}{'roles'}) eq 'HASH') { + if ($values->{$itemid}{'roles'}{$role} ne $ltitools{$itemid}{'roles'}{$role}) { + $haschanges{$itemid} = 1; + } + } elsif ($ltitools{$itemid}{'roles'}{$role}) { + $haschanges{$itemid} = 1; + } + } + } else { + $ltitools{$itemid}{'fields'}{$field} = 1; + if (ref($values->{$itemid}{'fields'}) eq 'HASH') { + if ($values->{$itemid}{'fields'}{$field} ne $ltitools{$itemid}{'fields'}{$field}) { + $haschanges{$itemid} = 1; + } + } else { + $haschanges{$itemid} = 1; + } + } + } + } + if (ref($ltitools{$itemid}{'fields'}) eq 'HASH') { + if ($ltitools{$itemid}{'fields'}{'user'}) { + if ($env{'form.ltitools_userincdom_'.$i}) { + $ltitools{$itemid}{'incdom'} = 1; + } + if ($values->{$itemid}{'incdom'} ne $ltitools{$itemid}{'incdom'}) { + $haschanges{$itemid} = 1; + } + } + } + $allpos[$newpos] = $itemid; + } + if ($imgdeletions{$itemid}) { + $haschanges{$itemid} = 1; + if ($context eq 'course') { + my $currimgurl = $values->{$itemid}{'image'}; + if ($currimgurl =~ m{^(\Q/uploaded/$cdom/$cnum/toollogo/$itemid\E)/([^/]+)$}) { + my ($path,$imagefile) = ($1,$2); + if ($imagefile =~ /^tn\-(.+)$/) { + my $origimg = $1; + &Apache::lonnet::removeuploadedurl("$path/$origimg"); + } + &Apache::lonnet::removeuploadedurl($currimgurl); + } + } + #FIXME need to obsolete item in RES space + } elsif ($env{'form.ltitools_image_'.$i.'.filename'}) { + my $currimgurl = $values->{$itemid}{'image'}; + my ($imgurl,$error) = &process_ltitools_image($r,$context,$cdom,$cnum,$confname,'ltitools_image_'.$i, + $itemid,$configuserok,$lonhost,$author_ok,$currimgurl); + if ($imgurl) { + $ltitools{$itemid}{'image'} = $imgurl; + $haschanges{$itemid} = 1; + } + if ($error) { + &Apache::lonnet::logthis($error); + $errors .= '
  • '.$error.'
    • '; + } + } elsif ($values->{$itemid}{'image'}) { + $ltitools{$itemid}{'image'} = $values->{$itemid}{'image'}; + } + if ($customadds{$i}) { + my $name = $env{'form.ltitools_custom_name_'.$i}; + $name =~ s/(`)/'/g; + $name =~ s/^\s+//; + $name =~ s/\s+$//; + my $value = $env{'form.ltitools_custom_value_'.$i}; + $value =~ s/(`)/'/g; + $value =~ s/^\s+//; + $value =~ s/\s+$//; + if ($name ne '') { + $ltitools{$itemid}{'custom'}{$name} = $value; + $haschanges{$itemid} = 1; + } + } + my %customdels; + my @customdeletions = &Apache::loncommon::get_env_multiple('form.ltitools_customdel_'.$i); + if (@customdeletions) { + $haschanges{$itemid} = 1; + } + map { $customdels{$_} = 1; } @customdeletions; + if (ref($values->{$itemid}{'custom'}) eq 'HASH') { + foreach my $key (keys(%{$values->{$itemid}{'custom'}})) { + unless ($customdels{$key}) { + if ($env{'form.ltitools_customval_'.$key.'_'.$i} ne '') { + $ltitools{$itemid}{'custom'}{$key} = $env{'form.ltitools_customval_'.$key.'_'.$i}; + } + if ($values->{$itemid}{'custom'}{$key} ne $env{'form.ltitools_customval_'.$key.'_'.$i}) { + $haschanges{$itemid} = 1; + } + } + } + } + unless ($switchserver) { + my $keyitem = 'form.ltitools_key_'.$i; + $env{$keyitem} =~ s/(`)/'/g; + if ($values->{$itemid}{'key'} ne $env{$keyitem}) { + $haschanges{$itemid} = 1; + } + if ($env{$keyitem} ne '') { + $ltitools{$itemid}{'key'} = $env{$keyitem}; + } + my $secretitem = 'form.ltitools_secret_'.$i; + $env{$secretitem} =~ s/(`)/'/g; + if ($values->{$itemid}{'usable'}) { + if ($env{'form.ltitools_changesecret_'.$i}) { + if ($env{$secretitem} ne '') { + if ($privnum && $cipher) { + $ltitools{$itemid}{'secret'} = $cipher->encrypt_hex($env{$secretitem}); + $ltitools{$itemid}{'cipher'} = $privnum; + } else { + $ltitools{$itemid}{'secret'} = $env{$secretitem}; + } + $haschanges{$itemid} = 1; + } + } else { + $ltitools{$itemid}{'secret'} = $values->{$itemid}{'secret'}; + $ltitools{$itemid}{'cipher'} = $values->{$itemid}{'cipher'}; + } + } elsif ($env{$secretitem} ne '') { + if ($privnum && $cipher) { + $ltitools{$itemid}{'secret'} = $cipher->encrypt_hex($env{$secretitem}); + $ltitools{$itemid}{'cipher'} = $privnum; + } else { + $ltitools{$itemid}{'secret'} = $env{$secretitem}; + } + $haschanges{$itemid} = 1; + } + } + unless ($haschanges{$itemid}) { + foreach my $key (keys(%{$values->{$itemid}})) { + if (ref($values->{$itemid}{$key}) eq 'HASH') { + if (ref($ltitools{$itemid}{$key}) eq 'HASH') { + foreach my $innerkey (keys(%{$values->{$itemid}{$key}})) { + unless (exists($ltitools{$itemid}{$key}{$innerkey})) { + $haschanges{$itemid} = 1; + last; + } + } + } elsif (keys(%{$values->{$itemid}{$key}}) > 0) { + $haschanges{$itemid} = 1; + } + } + last if ($haschanges{$itemid}); + } + } + } + } + } + if (@allpos > 0) { + my $idx = 0; + foreach my $itemid (@allpos) { + if ($itemid ne '') { + $ltitools{$itemid}{'order'} = $idx; + if (ref($values) eq 'HASH') { + if (ref($values->{$itemid}) eq 'HASH') { + if ($values->{$itemid}{'order'} ne $idx) { + $haschanges{$itemid} = 1; + } + } + } + $idx ++; + } + } + } + if (keys(%haschanges)) { + foreach my $entry (keys(%haschanges)) { + $changes->{$entry} = $ltitools{$entry}; + } + if (ref($lastactref) eq 'HASH') { + $lastactref->{'courseltitools'} = 1; + } + } + return $errors; +} + +sub get_ltitools_id { + my ($context,$cdom,$cnum,$title) = @_; + my ($lockhash,$tries,$gotlock,$id,$error); + + # get lock on ltitools db + $lockhash = { + lock => $env{'user.name'}. + ':'.$env{'user.domain'}, + }; + $tries = 0; + if ($context eq 'domain') { + $gotlock = &Apache::lonnet::newput_dom('ltitools',$lockhash,$cdom); + } else { + $gotlock = &Apache::lonnet::newput('ltitools',$lockhash,$cdom,$cnum); + } + while (($gotlock ne 'ok') && ($tries<10)) { + $tries ++; + sleep (0.1); + if ($context eq 'domain') { + $gotlock = &Apache::lonnet::newput_dom('ltitools',$lockhash,$cdom); + } else { + $gotlock = &Apache::lonnet::newput('ltitools',$lockhash,$cdom,$cnum); + } + } + if ($gotlock eq 'ok') { + my %currids; + if ($context eq 'domain') { + %currids = &Apache::lonnet::dump_dom('ltitools',$cdom); + } else { + %currids = &Apache::lonnet::dump('ltitools',$cdom,$cnum); + } + if ($currids{'lock'}) { + delete($currids{'lock'}); + if (keys(%currids)) { + my @curr = sort { $a <=> $b } keys(%currids); + if ($curr[-1] =~ /^\d+$/) { + $id = 1 + $curr[-1]; + } + } else { + $id = 1; + } + if ($id) { + if ($context eq 'domain') { + unless (&Apache::lonnet::newput_dom('ltitools',{ $id => $title },$cdom) eq 'ok') { + $error = 'nostore'; + } + } else { + unless (&Apache::lonnet::newput('ltitools',{ $id => $title },$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('ltitools',['lock'],$cdom); + } else { + $dellockoutcome = &Apache::lonnet::del('ltitools',['lock'],$cdom,$cnum); + } } else { $error = 'nolock'; } return ($id,$error); } +sub process_ltitools_image { + my ($r,$context,$dom,$cnum,$confname,$caller,$itemid,$configuserok,$switch,$author_ok,$currimg) = @_; + my $filename = $env{'form.'.$caller.'.filename'}; + my ($error,$url); + my ($width,$height) = (21,21); + if ($configuserok eq 'ok') { + if ($switch) { + $error = &mt('Upload of Tool Provider (LTI) icon is not permitted to this server: [_1]', + $switch); + } elsif ($author_ok eq 'ok') { + my ($result,$imageurl,$madethumb); + if ($context eq 'domain') { + ($result,$imageurl,$madethumb) = + &Apache::lonconfigsettings::publishlogo($r,'upload',$caller,$dom,$confname, + "ltitools/$itemid/icon",$width,$height); + } else { + ($result,$imageurl,$madethumb) = &processlogo($dom,$cnum,$caller,$currimg,$itemid,$width,$height); + } + if ($result eq 'ok') { + if ($madethumb) { + my ($path,$imagefile) = ($imageurl =~ m{^(.+)/([^/]+)$}); + my $imagethumb = "$path/tn-".$imagefile; + $url = $imagethumb; + } else { + $url = $imageurl; + } + } else { + if ($context eq 'domain') { + $error = &mt("Upload of [_1] failed because an error occurred publishing the file in RES space. Error was: [_2].",$filename,$result); + } else { + $error = &mt("Upload of [_1] failed because an error occurred. Error was: [_2].",$filename,$result); + } + } + } else { + $error = &mt("Upload of [_1] failed because an author role could not be assigned to a Domain Configuration user ([_2]) in domain: [_3]. Error was: [_4].",$filename,$confname,$dom,$author_ok); + } + } else { + $error = &mt("Upload of [_1] failed because a Domain Configuration user ([_2]) could not be created in domain: [_3]. Error was: [_4].",$filename,$confname,$dom,$configuserok); + } + return ($url,$error); +} + +sub processlogo { + my ($dom,$cnum,$caller,$currimg,$itemid,$width,$height) = @_; + my ($result,$imageurl,$madethumb); + if ($env{"form.$caller.filename"} ne '') { + unless ($caller eq 'ltitools_add_image') { + if ($currimg =~ m{^(\Q/uploaded/$dom/$cnum/toollogo/$itemid\E)/([^/]+)$}) { + my ($path,$imagefile) = ($1,$2); + if ($imagefile =~ /^tn\-(.+)$/) { + my $origimg = $1; + &Apache::lonnet::removeuploadedurl("$path/$origimg"); + } + &Apache::lonnet::removeuploadedurl($currimg); + } + } + $imageurl = &Apache::lonnet::userfileupload($caller,'toollogo',"toollogo/$itemid", + '','','',$cnum,$dom,$width,$height); + if ($imageurl =~ m{^(\Q/uploaded/$dom/$cnum/toollogo/$itemid\E)/([^/]+)$}) { + my ($path,$imagefile) = ($1,$2); + $result = 'ok'; + my $thumburl = "$path/tn-".$imagefile; + my ($rtncode,$info); + my $res = &Apache::lonnet::getuploaded('HEAD',$thumburl,$dom,$cnum,\$info,\$rtncode); + if ($res eq 'ok') { + $madethumb = 1; + } + } elsif ($imageurl eq '/adm/notfound.html') { + undef($imageurl); + $result = 'store failed'; + } elsif ($imageurl =~ /^error: (.+)$/) { + $result = $1; + } + } + return ($result,$imageurl,$madethumb); +} + sub get_sec_str { my ($entry,$num) = @_; my @secs = &Apache::loncommon::get_env_multiple('form.'.$entry.'_sections_'.$num); @@ -1609,12 +2554,15 @@ sub check_clone { sub store_changes { my ($cdom,$cnum,$prefs_order,$actions,$prefs,$values,$changes,$crstype) = @_; my ($chome,$output); - my (%storehash,@delkeys,@need_env_update,@oldcloner,%oldlinkprot); + my (%storehash,@delkeys,@need_env_update,@oldcloner,%oldlinkprot,%oldltitools); 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->{'linkprot'}); + if (ref($values->{'ltitools'}) eq 'HASH') { + %oldltitools = %{$values->{'ltitools'}}; } - delete($values->{'linkprotection'}); %storehash = %{$values}; } else { if ($crstype eq 'Community') { @@ -1627,7 +2575,9 @@ 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 == 1) && (exists($changes->{'ltitools'}))) { $skipstore = 1; } elsif (!$numchanges) { if ($crstype eq 'Community') { @@ -1650,7 +2600,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:').'