--- loncom/interface/lonconfigsettings.pm 2021/09/21 22:54:26 1.53 +++ loncom/interface/lonconfigsettings.pm 2023/09/24 03:31:18 1.72 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Handler to set domain-wide configuration settings # -# $Id: lonconfigsettings.pm,v 1.53 2021/09/21 22:54:26 raeburn Exp $ +# $Id: lonconfigsettings.pm,v 1.72 2023/09/24 03:31:18 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -37,12 +37,13 @@ use Apache::lonhtmlcommon(); use Apache::lonlocal; use Apache::lonparmset(); use Apache::courseclassifier(); -use LONCAPA qw(:DEFAULT :match); +use LONCAPA qw(:DEFAULT :match); +use File::Copy; sub print_header { - my ($r,$phase,$context,$jscript,$container,$instcode,$dom,$values) = @_; + my ($r,$phase,$context,$jscript,$container,$instcode,$dom,$confname,$values) = @_; my ($pagetitle,$brcrumtitle,$action,$call_category_check,$instcode_check, - $crstype,@actions,@code_order); + $linkprot_check,$ltitools_check,$crstype,@actions,@code_order); if ($phase eq 'display') { @actions = &Apache::loncommon::get_env_multiple('form.actions'); } @@ -92,7 +93,7 @@ sub print_header { var gotcode = 0; for (var i=0; i \%loaditems,}; } } elsif ($context eq 'course') { + my ($onload,$ishome,$crshome_checked); if (grep(/^courseinfo$/,@actions)) { - if (@code_order) { - $additem = { - add_entries => {'onload' => "courseSet('','load');toggleCloners(document.display.cloners_instcode);"}, - }; + if (@code_order) { + $onload = "courseSet('','load');toggleCloners(document.display.cloners_instcode);"; + } + } + if (grep(/^linkprot$/,@actions)) { + if (ref($values) eq 'HASH') { + if (ref($values->{'linkprot'}) eq 'HASH') { + my $ltiauth; + 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($dom); + $ltiauth = $domdefs{'crsltiauth'}; + } + unless ($crshome_checked) { + $ishome = &is_home(); + $crshome_checked = 1; + } + my $posslti = scalar(keys(%{$values->{'linkprot'}})); + for (my $i=0; $i<=$posslti; $i++) { + my $num = $i; + if ($i == $posslti) { + $num = 'add'; + } + if (ref($values->{'linkprot'}->{$i}) eq 'HASH') { + if ($values->{'linkprot'}->{$i}->{'usable'}) { + $onload .= "toggleChgSecret(document.display,'$num','secret','linkprot');"; + } + } + $onload .= "toggleLinkProtExtra(document.display,'returnurl','divurlparam','1','inline-block','$num');". + "toggleLinkProtExtra(document.display,'passback','passbackparam','1','inline-block','$num');"; + if ($ltiauth) { + $onload .= "toggleLinkProtExtra(document.display,'requser','optional','1','block','$num');". + "toggleLinkProtExtra(document.display,'mapuser','userfield','other','inline-block','$num');"; + } + if ($ishome) { + $onload .= "uncheckLinkProtMakeVis('linkprot','visible','$num');"; + } + } + } } } + if (grep(/^ltitools$/,@actions)) { + if (ref($values) eq 'HASH') { + if (ref($values->{'ltitools'}) eq 'HASH') { + unless ($crshome_checked) { + $ishome = &is_home(); + $crshome_checked = 1; + } + my $possltitools = scalar(keys(%{$values->{'ltitools'}})); + for (my $i=0; $i<=$possltitools; $i++) { + my $num = $i; + if ($i == $possltitools) { + $num = 'add'; + } + if (ref($values->{'ltitools'}->{$i}) eq 'HASH') { + if ($values->{'ltitools'}->{$i}->{'usable'}) { + $onload .= "toggleChgSecret(document.display,'$num','secret','ltitools');"; + } + } + if ($ishome) { + $onload .= "uncheckLinkProtMakeVis('ltitools','visible','$num');"; + } + } + } + } + } + if (grep(/^appearance$/,@actions)) { + $onload .= "toggleExtRes();"; + } + if (grep(/^localization$/,@actions)) { + $onload .= "toggleTimeZone();"; + } + if (grep(/^grading$/,@actions)) { + $onload .= 'toggleGrading(document.display);toggleHiddenTotalsSec(document.display);'; + } + if ($onload) { + my %loaditems = ( + 'onload' => $onload, + ); + $additem = {'add_entries' => \%loaditems,}; + } } } $r->print(&Apache::loncommon::start_page($pagetitle,$js,$additem)); @@ -305,6 +418,126 @@ $jscript return; } +sub ltisecret_js { + my ($name,$dom,$values) = @_; + return unless (ref($values) eq 'HASH'); + my $js; + if (($name eq 'linkprot') || ($name eq 'ltitools')) { + my (@changeable,@settable); + if (ref($values->{$name}) eq 'HASH') { + if (keys(%{$values->{$name}})) { + my @current = sort { $a <=> $b } keys(%{$values->{$name}}); + if (@current) { + for (my $i=0; $i<@current; $i++) { + my $num = $current[$i]; + if (ref($values->{$name}->{$num}) eq 'HASH') { + if ($values->{$name}->{$num}->{'usable'}) { + push(@changeable,$i); + } else { + push(@settable,$i); + } + } + } + } + } + } + my ($numrules,$intargjs); +$js .= <print('

'); - } + } } if ($phase eq 'process') { $r->print(''); @@ -381,7 +614,8 @@ sub make_changes { $errors = &Apache::courseprefs::process_changes($dom,$confname,$item,$values, $prefs->{$item},$changes{$item}, - $allitems,\%disallowed,$crstype); + $allitems,\%disallowed,$crstype, + \%lastact); if (keys(%{$changes{$item}}) > 0) { $numchanged ++; } @@ -439,18 +673,18 @@ sub display_settings { if (ref($values) eq 'HASH') { $instcode = $values->{'internal.coursecode'}; } - &print_header($r,$phase,$context,$jscript,$container,$instcode,$dom,$values); + &print_header($r,$phase,$context,$jscript,$container,$instcode,$dom,$confname,$values); my $divwidth = 900; if ((ref($prefs_order) eq 'ARRAY') && (ref($prefs) eq 'HASH') && (ref($values) eq 'HASH')) { if (@actions > 0) { my $rowsum = 0; - my (%output,%rowtotal,@items,$got_check_uncheck); + my (%output,%rowtotal,@items,$got_check_uncheck,$got_change_secret); foreach my $item (@{$prefs_order}) { if (grep(/^\Q$item\E$/,@actions)) { push(@items,$item); if ($context eq 'domain') { my $settings; - if (ref($values) eq 'HASH') { + if (ref($values) eq 'HASH') { $settings = $values->{$item}; } if (($item eq 'usersessions') || ($item eq 'ssl')) { @@ -478,7 +712,7 @@ sub display_settings { my $inststatus = { inststatustypes => $usertypes, inststatusorder => $types, - inststatusguest => [], + inststatusguest => [], }; if (ref($values->{defaults}) eq 'HASH') { $settings = {%{$inststatus},%{$values->{'defaults'}}}; @@ -486,13 +720,49 @@ sub display_settings { $settings = $inststatus; } } + } elsif (($item eq 'lti') || ($item eq 'ltitools')) { + unless ($got_change_secret) { + $r->print(''."\n"); + $got_change_secret = 1; + } + if ($item eq 'lti') { + if (ref($values->{'ltisec'}) eq 'HASH') { + if (ref($values->{'lti'}) eq 'HASH') { + $settings = {%{$values->{'lti'}},%{$values->{'ltisec'}}}; + } else { + $settings = $values->{'ltisec'}; + } + } elsif (ref($values->{'lti'}) eq 'HASH') { + $settings = $values->{'lti'}; + } + } elsif ($item eq 'ltitools') { + if (ref($values->{'toolsec'}) eq 'HASH') { + if (ref($values->{'ltitools'}) eq 'HASH') { + $settings = {%{$values->{'ltitools'}},%{$values->{'toolsec'}}}; + } else { + $settings = $values->{'toolsec'}; + } + } + } } ($output{$item},$rowtotal{$item}) = &Apache::domainprefs::print_config_box($r,$dom,$confname, $phase,$item,$prefs->{$item},$settings); } else { + unless ($got_change_secret) { + $r->print(''."\n"); + $got_change_secret = 1; + } ($output{$item},$rowtotal{$item}) = - &Apache::courseprefs::print_config_box($r,$dom,$phase, + &Apache::courseprefs::print_config_box($r,$dom,$confname,$phase, $item,$prefs->{$item},$values,$allitems,$crstype,$parm_permission); } $rowsum += $rowtotal{$item}; @@ -625,6 +895,274 @@ ENDCOL return $output; } +sub ltisec_javascript { + my ($dom) = @_; + my %servers = &Apache::lonnet::get_servers($dom,'library'); + my $primary = &Apache::lonnet::domain($dom,'primary'); + my $course_servers = "'".join("','",keys(%servers))."'"; + my $output = <<"ENDJS"; + +function toggleLTIEncKey(form,context) { + var shownhosts = new Array(); + var hiddenhosts = new Array(); + var forcourse = new Array($course_servers); + var fromdomain = '$primary'; + var crsradio; + if (context == 'ltisec') { + crsradio = form.elements['ltisec_crslinkprot']; + } else { + crsradio = form.elements['toolsec_crs']; + } + if (crsradio.length) { + for (var i=0; i 0) { + for (var j=0; j 0) { + for (var j=0; j 0) { + for (var i=0; i 0) { + for (var i=0; i 0) { + var setvis; + for (var i=0; i{$item}) eq 'HASH') { + my $num = $settings->{$item}{'order'}; + $ordered{$num} = $item; + } + } + $total = scalar(keys(%{$settings})); + my @jsarray = (); + foreach my $item (sort {$a <=> $b } (keys(%ordered))) { + push(@jsarray,$ordered{$item}); + } + my $jstext = ' var ltitools = Array('."'".join("','",@jsarray)."'".');'."\n"; + return <<"ENDSCRIPT"; + + +$togglejs + +ENDSCRIPT +} + +sub ltitools_toggle_js { + return <<"ENDSCRIPT"; + + +ENDSCRIPT +} + sub get_crumb_text { my %brcrumbtext = ( domain => 'Domain Settings', @@ -633,4 +1171,271 @@ sub get_crumb_text { return %brcrumbtext; } +sub publishlogo { + my ($r,$action,$formname,$dom,$confname,$subdir,$thumbwidth,$thumbheight, + $savefileas,$modified) = @_; + my ($output,$fname,$logourl,$madethumb); + if ($action eq 'upload') { + $fname=$env{'form.'.$formname.'.filename'}; + chop($env{'form.'.$formname}); + } else { + ($fname) = ($formname =~ /([^\/]+)$/); + } + if ($savefileas ne '') { + $fname = $savefileas; + } + $fname=&Apache::lonnet::clean_filename($fname); +# See if there is anything left + unless ($fname) { return ('error: no uploaded file'); } + $fname="$subdir/$fname"; + my $docroot=$r->dir_config('lonDocRoot'); + my $filepath="$docroot/priv"; + my $relpath = "$dom/$confname"; + my ($fnamepath,$file,$fetchthumb); + $file=$fname; + if ($fname=~m|/|) { + ($fnamepath,$file) = ($fname =~ m|^(.*)/([^/]+)$|); + } + my @parts=split(/\//,"$filepath/$relpath/$fnamepath"); + my $count; + for ($count=5;$count<=$#parts;$count++) { + $filepath.="/$parts[$count]"; + if ((-e $filepath)!=1) { + mkdir($filepath,02770); + } + } + # Check for bad extension and disallow upload + if ($file=~/\.(\w+)$/ && + (&Apache::loncommon::fileembstyle($1) eq 'hdn')) { + $output = + &mt('Invalid file extension ([_1]) - reserved for internal use.',$1); + } elsif ($file=~/\.(\w+)$/ && + !defined(&Apache::loncommon::fileembstyle($1))) { + $output = &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1); + } elsif ($file=~/\.(\d+)\.(\w+)$/) { + $output = &mt('Filename not allowed - rename the file to remove the number immediately before the file extension([_1]) and re-upload.',$2); + } elsif (-d "$filepath/$file") { + $output = &mt('Filename is a directory name - rename the file and re-upload'); + } else { + my $source = $filepath.'/'.$file; + my $logfile; + if (!open($logfile,">>",$source.'.log')) { + return (&mt('No write permission to Authoring Space')); + } + print $logfile +"\n================= Publish ".localtime()." ================\n". +$env{'user.name'}.':'.$env{'user.domain'}."\n"; +# Save the file + if (!open(FH,">",$source)) { + &Apache::lonnet::logthis('Failed to create '.$source); + return (&mt('Failed to create file')); + } + if ($action eq 'upload') { + if (!print FH ($env{'form.'.$formname})) { + &Apache::lonnet::logthis('Failed to write to '.$source); + return (&mt('Failed to write file')); + } + } else { + my $original = &Apache::lonnet::filelocation('',$formname); + if(!copy($original,$source)) { + &Apache::lonnet::logthis('Failed to copy '.$original.' to '.$source); + return (&mt('Failed to write file')); + } + } + close(FH); + chmod(0660, $source); # Permissions to rw-rw---. + + my $targetdir=$docroot.'/res/'.$dom.'/'.$confname .'/'.$fnamepath; + my $copyfile=$targetdir.'/'.$file; + + my @parts=split(/\//,$targetdir); + my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]"; + for (my $count=5;$count<=$#parts;$count++) { + $path.="/$parts[$count]"; + if (!-e $path) { + print $logfile "\nCreating directory ".$path; + mkdir($path,02770); + } + } + my $versionresult; + if (-e $copyfile) { + $versionresult = &logo_versioning($targetdir,$file,$logfile); + } else { + $versionresult = 'ok'; + } + if ($versionresult eq 'ok') { + if (copy($source,$copyfile)) { + print $logfile "\nCopied original source to ".$copyfile."\n"; + $output = 'ok'; + $logourl = '/res/'.$dom.'/'.$confname.'/'.$fname; + if (ref($modified) eq 'ARRAY') { + push(@{$modified},[$copyfile,$source]); + } + my $metaoutput = + &write_metadata($dom,$confname,$formname,$targetdir,$file,$logfile); + } else { + print $logfile "\nUnable to write ".$copyfile.':'.$!."\n"; + $output = &mt('Failed to copy file to RES space').", $!"; + } + if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) { + my $inputfile = $filepath.'/'.$file; + my $outfile = $filepath.'/'.'tn-'.$file; + my ($fullwidth,$fullheight) = &Apache::lonnet::check_dimensions($inputfile); + if ($fullwidth ne '' && $fullheight ne '') { + if ($fullwidth > $thumbwidth && $fullheight > $thumbheight) { + my $thumbsize = $thumbwidth.'x'.$thumbheight; + my @args = ('convert','-sample',$thumbsize,$inputfile,$outfile); + system({$args[0]} @args); + chmod(0660, $filepath.'/tn-'.$file); + if (-e $outfile) { + my $copyfile=$targetdir.'/tn-'.$file; + if (copy($outfile,$copyfile)) { + print $logfile "\nCopied source to ".$copyfile."\n"; + my $thumb_metaoutput = + &write_metadata($dom,$confname,$formname, + $targetdir,'tn-'.$file,$logfile); + if (ref($modified) eq 'ARRAY') { + push(@{$modified},[$copyfile,$outfile]); + } + $madethumb = 1; + } else { + print $logfile "\nUnable to write ".$copyfile. + ':'.$!."\n"; + } + } + } + } + } + } else { + $output = $versionresult; + } + } + return ($output,$logourl,$madethumb); +} + +sub logo_versioning { + my ($targetdir,$file,$logfile) = @_; + my $target = $targetdir.'/'.$file; + my ($maxversion,$fn,$extn,$output); + $maxversion = 0; + if ($file =~ /^(.+)\.(\w+)$/) { + $fn=$1; + $extn=$2; + } + opendir(DIR,$targetdir); + while (my $filename=readdir(DIR)) { + if ($filename=~/\Q$fn\E\.(\d+)\.\Q$extn\E$/) { + $maxversion=($1>$maxversion)?$1:$maxversion; + } + } + $maxversion++; + print $logfile "\nCreating old version ".$maxversion."\n"; + my $copyfile=$targetdir.'/'.$fn.'.'.$maxversion.'.'.$extn; + if (copy($target,$copyfile)) { + print $logfile "Copied old target to ".$copyfile."\n"; + $copyfile=$copyfile.'.meta'; + if (copy($target.'.meta',$copyfile)) { + print $logfile "Copied old target metadata to ".$copyfile."\n"; + $output = 'ok'; + } else { + print $logfile "Unable to write metadata ".$copyfile.':'.$!."\n"; + $output = &mt('Failed to copy old meta').", $!, "; + } + } else { + print $logfile "Unable to write ".$copyfile.':'.$!."\n"; + $output = &mt('Failed to copy old target').", $!, "; + } + return $output; +} + +sub write_metadata { + my ($dom,$confname,$formname,$targetdir,$file,$logfile) = @_; + my (%metadatafields,%metadatakeys,$output); + $metadatafields{'title'}=$formname; + $metadatafields{'creationdate'}=time; + $metadatafields{'lastrevisiondate'}=time; + $metadatafields{'copyright'}='public'; + $metadatafields{'modifyinguser'}=$env{'user.name'}.':'. + $env{'user.domain'}; + $metadatafields{'authorspace'}=$confname.':'.$dom; + $metadatafields{'domain'}=$dom; + { + print $logfile "\nWrite metadata file for ".$targetdir.'/'.$file; + my $mfh; + if (open($mfh,">",$targetdir.'/'.$file.'.meta')) { + foreach (sort(keys(%metadatafields))) { + unless ($_=~/\./) { + my $unikey=$_; + $unikey=~/^([A-Za-z]+)/; + my $tag=$1; + $tag=~tr/A-Z/a-z/; + print $mfh "\n\<$tag"; + foreach (split(/\,/,$metadatakeys{$unikey})) { + my $value=$metadatafields{$unikey.'.'.$_}; + $value=~s/\"/\'\'/g; + print $mfh ' '.$_.'="'.$value.'"'; + } + print $mfh '>'. + &HTML::Entities::encode($metadatafields{$unikey},'<>&"') + .''; + } + } + $output = 'ok'; + print $logfile "\nWrote metadata"; + close($mfh); + } else { + print $logfile "\nFailed to open metadata file"; + $output = &mt('Could not write metadata'); + } + } + return $output; +} + +sub change_secret_js { + return <<"ENDSCRIPT"; +function toggleChgSecret(form,num,item,name) { + var radioname = ''; + var currdivid = ''; + var newdivid = ''; + if ((document.getElementById(name+'_divcurr'+item+'_'+num)) && + (document.getElementById(name+'_divchg'+item+'_'+num))) { + currdivid = document.getElementById(name+'_divcurr'+item+'_'+num); + newdivid = document.getElementById(name+'_divchg'+item+'_'+num); + radioname = form.elements[name+'_change'+item+'_'+num]; + if (radioname) { + if (radioname.length > 0) { + var setvis; + for (var i=0; i 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.