--- loncom/interface/lonconfigsettings.pm 2022/09/08 01:41:13 1.67 +++ loncom/interface/lonconfigsettings.pm 2023/03/19 16:05:48 1.68 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Handler to set domain-wide configuration settings # -# $Id: lonconfigsettings.pm,v 1.67 2022/09/08 01:41:13 raeburn Exp $ +# $Id: lonconfigsettings.pm,v 1.68 2023/03/19 16:05:48 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,$confname,$values) = @_; my ($pagetitle,$brcrumtitle,$action,$call_category_check,$instcode_check, - $linkprot_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'); } @@ -116,8 +117,8 @@ sub print_header { ENDSCRIPT } } - if (($context eq 'course') && ($phase eq 'display') && - (grep(/^linkprot$/,@actions))) { + if (($context eq 'course') && ((grep(/^linkprot$/,@actions)) || + (grep(/^ltitools$/,@actions)))) { my $allowed; my $home = &Apache::lonnet::homeserver($confname,$dom); unless ($home eq 'no_host') { @@ -125,102 +126,12 @@ ENDSCRIPT foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } } } if ($allowed) { - my (@changeable,@settable); - if (ref($values->{'linkprot'}) eq 'HASH') { - if (keys(%{$values->{'linkprot'}})) { - my @current = sort { $a <=> $b } keys(%{$values->{'linkprot'}}); - if (@current) { - for (my $i=0; $i<@current; $i++) { - my $num = $current[$i]; - if (ref($values->{'linkprot'}->{$num}) eq 'HASH') { - if ($values->{'linkprot'}->{$num}->{'usable'}) { - push(@changeable,$i); - } else { - push(@settable,$i); - } - } - } - } - } - } - my ($numrules,$intargjs); -$linkprot_check .= < \%loaditems,}; } } elsif ($context eq 'course') { - my $onload; + my ($onload,$ishome,$crshome_checked); if (grep(/^courseinfo$/,@actions)) { if (@code_order) { $onload = "courseSet('','load');toggleCloners(document.display.cloners_instcode);"; @@ -410,11 +331,9 @@ $jscript my %domdefs = &Apache::lonnet::get_domain_defaults($dom); $ltiauth = $domdefs{'crsltiauth'}; } - my $ishome; - my $chome = $env{'course.'.$env{'request.course.id'}.'.home'}; - unless (($chome eq 'no_host') || ($chome eq '')) { - my @ids=&Apache::lonnet::current_machine_ids(); - foreach my $id (@ids) { if ($id eq $chome) { $ishome=1; } } + unless ($crshome_checked) { + $ishome = &is_home(); + $crshome_checked = 1; } my $posslti = scalar(keys(%{$values->{'linkprot'}})); for (my $i=0; $i<=$posslti; $i++) { @@ -424,7 +343,7 @@ $jscript } if (ref($values->{'linkprot'}->{$i}) eq 'HASH') { if ($values->{'linkprot'}->{$i}->{'usable'}) { - $onload .= "toggleLinkProt(document.display,'$num','secret');"; + $onload .= "toggleChgSecret(document.display,'$num','secret','linkprot');"; } } $onload .= "toggleLinkProtExtra(document.display,'returnurl','divurlparam','1','inline-block','$num');"; @@ -433,7 +352,32 @@ $jscript "toggleLinkProtExtra(document.display,'mapuser','userfield','other','inline-block','$num');"; } if ($ishome) { - $onload .= "uncheckLinkProtMakeVis('visible','$num');"; + $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');"; } } } @@ -470,6 +414,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 .= < 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); @@ -652,21 +716,47 @@ sub display_settings { $settings = $inststatus; } } - } elsif ($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 (($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'}; + } } - } elsif (ref($values->{'lti'}) eq 'HASH') { - $settings = $values->{'lti'}; } } ($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,$confname,$phase, $item,$prefs->{$item},$values,$allitems,$crstype,$parm_permission); @@ -801,6 +891,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', @@ -809,4 +1167,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