--- loncom/interface/domainprefs.pm 2022/08/30 20:03:05 1.160.6.118.2.9 +++ loncom/interface/domainprefs.pm 2024/01/02 02:46:18 1.160.6.118.2.17 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Handler to set domain-wide configuration settings # -# $Id: domainprefs.pm,v 1.160.6.118.2.9 2022/08/30 20:03:05 raeburn Exp $ +# $Id: domainprefs.pm,v 1.160.6.118.2.17 2024/01/02 02:46:18 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -27,7 +27,7 @@ # # ############################################################### -############################################################## +############################################################### =pod @@ -104,8 +104,8 @@ $datatable - HTML containing form eleme In the case of course requests, radio buttons are displayed for each institutional affiliate type (and also default, and _LC_adv) for each of the course types -(official, unofficial, community, and textbook). In each case the radio buttons -allow the selection of one of four values: +(official, unofficial, community, textbook, and lti). +In each case the radio buttons allow the selection of one of four values: 0, approval, validate, autolimit=N (where N is blank, or a positive integer). which have the following effects: @@ -167,6 +167,7 @@ use Apache::lonmsg(); use Apache::lonconfigsettings; use Apache::lonuserutils(); use Apache::loncoursequeueadmin(); +use Apache::courseprefs(); use LONCAPA qw(:DEFAULT :match); use LONCAPA::Enrollment; use LONCAPA::lonauthcgi(); @@ -174,7 +175,9 @@ use File::Copy; use Locale::Language; use DateTime::TimeZone; use DateTime::Locale; +use Time::HiRes qw( sleep ); use Net::CIDR; +use Crypt::CBC; my $registered_cleanup; my $modified_urls; @@ -218,15 +221,50 @@ sub handler { 'serverstatuses','requestcourses','helpsettings', 'coursedefaults','usersessions','loadbalancing', 'requestauthor','selfenrollment','inststatus', - 'passwords','ltitools','ltisec','wafproxy','ipaccess'],$dom); + 'passwords','ltitools','toolsec','lti','ltisec', + 'wafproxy','ipaccess'],$dom); my %encconfig = - &Apache::lonnet::get_dom('encconfig',['ltitools','linkprot'],$dom,undef,1); + &Apache::lonnet::get_dom('encconfig',['ltitools','lti','linkprot'],$dom,undef,1); + my ($checked_is_home,$is_home); if (ref($domconfig{'ltitools'}) eq 'HASH') { if (ref($encconfig{'ltitools'}) eq 'HASH') { + my $home = &Apache::lonnet::domain($dom,'primary'); + unless (($home eq 'no_host') || ($home eq '')) { + my @ids=&Apache::lonnet::current_machine_ids(); + if (grep(/^\Q$home\E$/,@ids)) { + $is_home = 1; + } + } + $checked_is_home = 1; foreach my $id (keys(%{$domconfig{'ltitools'}})) { - if (ref($domconfig{'ltitools'}{$id}) eq 'HASH') { - foreach my $item ('key','secret') { - $domconfig{'ltitools'}{$id}{$item} = $encconfig{'ltitools'}{$id}{$item}; + if ((ref($domconfig{'ltitools'}{$id}) eq 'HASH') && + (ref($encconfig{'ltitools'}{$id}) eq 'HASH')) { + $domconfig{'ltitools'}{$id}{'key'} = $encconfig{'ltitools'}{$id}{'key'}; + if (($is_home) && ($phase eq 'process')) { + $domconfig{'ltitools'}{$id}{'secret'} = $encconfig{'ltitools'}{$id}{'secret'}; + } + } + } + } + } + if (ref($domconfig{'lti'}) eq 'HASH') { + if (ref($encconfig{'lti'}) eq 'HASH') { + unless ($checked_is_home) { + my $home = &Apache::lonnet::domain($dom,'primary'); + unless (($home eq 'no_host') || ($home eq '')) { + my @ids=&Apache::lonnet::current_machine_ids(); + if (grep(/^\Q$home\E$/,@ids)) { + $is_home = 1; + } + } + $checked_is_home = 1; + } + foreach my $id (keys(%{$domconfig{'lti'}})) { + if ((ref($domconfig{'lti'}{$id}) eq 'HASH') && + (ref($encconfig{'lti'}{$id}) eq 'HASH')) { + $domconfig{'lti'}{$id}{'key'} = $encconfig{'lti'}{$id}{'key'}; + if (($is_home) && ($phase eq 'process')) { + $domconfig{'lti'}{$id}{'secret'} = $encconfig{'lti'}{$id}{'secret'}; } } } @@ -330,7 +368,7 @@ sub handler { modify => \&modify_passwords, }, 'quotas' => - { text => 'Blogs, personal web pages, webDAV/quotas, portfolios', + { text => 'Blogs, personal pages/timezones, webDAV/quotas, portfolio', help => 'Domain_Configuration_Quotas', header => [{col1 => 'User affiliation', col2 => 'Available tools', @@ -541,12 +579,16 @@ sub handler { 'ltitools' => {text => 'External Tools (LTI)', help => 'Domain_Configuration_LTI_Tools', - header => [{col1 => 'Setting', - col2 => 'Value',}], + header => [{col1 => 'Encryption of shared secrets', + col2 => 'Settings'}, + {col1 => 'Rules for shared secrets', + col2 => 'Settings'}, + {col1 => 'Providers', + col2 => 'Settings',}], print => \&print_ltitools, modify => \&modify_ltitools, }, - 'lti' => + 'lti' => {text => 'LTI Link Protection and LTI Consumers', help => 'Domain_Configuration_LTI_Provider', header => [{col1 => 'Encryption of shared secrets', @@ -554,11 +596,13 @@ sub handler { {col1 => 'Rules for shared secrets', col2 => 'Settings'}, {col1 => 'Link Protectors', + col2 => 'Settings'}, + {col1 => 'Consumers', col2 => 'Settings'},], print => \&print_lti, modify => \&modify_lti, }, - 'ipaccess' => + 'ipaccess' => {text => 'IP-based access control', help => 'Domain_Configuration_IP_Access', header => [{col1 => 'Setting', @@ -753,12 +797,12 @@ sub process_changes { $output = &modify_usersessions($dom,$lastactref,%domconfig); } elsif ($action eq 'loadbalancing') { $output = &modify_loadbalancing($dom,%domconfig); + } elsif ($action eq 'ltitools') { + $output = &modify_ltitools($r,$dom,$action,$lastactref,%domconfig); } elsif ($action eq 'lti') { $output = &modify_lti($r,$dom,$action,$lastactref,%domconfig); } elsif ($action eq 'passwords') { $output = &modify_passwords($r,$dom,$confname,$lastactref,%domconfig); - } elsif ($action eq 'ltitools') { - $output = &modify_ltitools($r,$dom,$action,$lastactref,%domconfig); } elsif ($action eq 'wafproxy') { $output = &modify_wafproxy($dom,$action,$lastactref,%domconfig); } elsif ($action eq 'ipaccess') { @@ -794,9 +838,9 @@ sub print_config_box { &Apache::lonuserutils::custom_roledefs_js($context,$crstype,$formname,\%full, \@templateroles); } elsif ($action eq 'ltitools') { - $output .= <itools_javascript($settings); + $output .= &Apache::lonconfigsettings::ltitools_javascript($settings); } elsif ($action eq 'lti') { - $output .= &passwords_javascript('secrets')."\n". + $output .= &passwords_javascript('ltisecrets')."\n". <i_javascript($dom,$settings); } elsif ($action eq 'wafproxy') { $output .= &wafproxy_javascript($dom); @@ -824,7 +868,7 @@ sub print_config_box { if ($numheaders > 1) { my $colspan = ''; my $rightcolspan = ''; - my $leftnobr = ''; + my $leftnobr = ''; if (($action eq 'rolecolors') || ($action eq 'defaults') || ($action eq 'directorysrch') || (($action eq 'login') && ($numheaders < 5))) { @@ -848,7 +892,8 @@ sub print_config_box { if (($action eq 'autoupdate') || ($action eq 'usercreation') || ($action eq 'selfcreation') || ($action eq 'usermodification') || ($action eq 'defaults') || ($action eq 'coursedefaults') || ($action eq 'selfenrollment') || ($action eq 'usersessions') || ($action eq 'directorysrch') || - ($action eq 'helpsettings') || ($action eq 'contacts') || ($action eq 'wafproxy') || ($action eq 'lti')) { + ($action eq 'helpsettings') || ($action eq 'contacts') || ($action eq 'wafproxy') || + ($action eq 'lti') || ($action eq 'ltitools')) { $output .= $item->{'print'}->('top',$dom,$settings,\$rowtotal); } elsif ($action eq 'passwords') { $output .= $item->{'print'}->('top',$dom,$confname,$settings,\$rowtotal); @@ -884,7 +929,8 @@ sub print_config_box { ($action eq 'selfcreation') || ($action eq 'selfenrollment') || ($action eq 'usersessions') || ($action eq 'coursecategories') || ($action eq 'contacts') || ($action eq 'passwords') || - ($action eq 'defaults') || ($action eq 'lti')) { + ($action eq 'defaults') || ($action eq 'lti') || + ($action eq 'ltitools')) { if ($action eq 'coursecategories') { $output .= &print_coursecategories('middle',$dom,$item,$settings,\$rowtotal); $colspan = ' colspan="2"'; @@ -1120,7 +1166,7 @@ sub print_config_box { $output .= &print_quotas($dom,$settings,\$rowtotal,$action); } elsif (($action eq 'autoenroll') || ($action eq 'autocreate') || ($action eq 'serverstatuses') || ($action eq 'loadbalancing') || - ($action eq 'ltitools') || ($action eq 'ipaccess')) { + ($action eq 'ipaccess')) { $output .= $item->{'print'}->($dom,$settings,\$rowtotal); } } @@ -1140,7 +1186,6 @@ sub print_login { %lt = &login_file_options(); $switchserver = &check_switchserver($dom,$confname); } - if ($caller eq 'service') { my %servers = &Apache::lonnet::internet_dom_servers($dom); my $choice = $choices{'disallowlogin'}; @@ -1477,7 +1522,7 @@ sub print_login { $styleon{$lonhost} = 'display:none'; $styleoff{$lonhost} = ''; } - if (ref($settings->{'saml'}) eq 'HASH') { + if ((ref($settings) eq 'HASH') && (ref($settings->{'saml'}) eq 'HASH')) { foreach my $lonhost (keys(%{$settings->{'saml'}})) { if (ref($settings->{'saml'}{$lonhost}) eq 'HASH') { $saml{$lonhost} = 1; @@ -2217,7 +2262,7 @@ sub print_quotas { my $typecount = 0; my ($css_class,%titles); if ($context eq 'requestcourses') { - @usertools = ('official','unofficial','community','textbook'); + @usertools = ('official','unofficial','community','textbook','lti'); @options =('norequest','approval','validate','autolimit'); %validations = &Apache::lonnet::auto_courserequest_checks($dom); %titles = &courserequest_titles(); @@ -2226,7 +2271,7 @@ sub print_quotas { @options = ('norequest','approval','automatic'); %titles = &authorrequest_titles(); } else { - @usertools = ('aboutme','blog','webdav','portfolio'); + @usertools = ('aboutme','blog','webdav','portfolio','timezone'); %titles = &tool_titles(); } if (ref($types) eq 'ARRAY') { @@ -2330,9 +2375,12 @@ sub print_quotas { } } else { my $checked = 'checked="checked" '; + if ($item eq 'timezone') { + $checked = ''; + } if (ref($settings) eq 'HASH') { if (ref($settings->{$item}) eq 'HASH') { - if ($settings->{$item}->{$type} == 0) { + if (!$settings->{$item}->{$type}) { $checked = ''; } elsif ($settings->{$item}->{$type} == 1) { $checked = 'checked="checked" '; @@ -2681,7 +2729,7 @@ sub print_studentcode { my ($settings,$rowtotal) = @_; my $rownum = 0; my ($output,%current); - my @crstypes = ('official','unofficial','community','textbook'); + my @crstypes = ('official','unofficial','community','textbook','lti'); if (ref($settings) eq 'HASH') { if (ref($settings->{'uniquecode'}) eq 'HASH') { foreach my $type (@crstypes) { @@ -3012,6 +3060,30 @@ sub ltitools_toggle_js { function toggleLTITools(form,setting,item) { var radioname = ''; var divid = ''; + if ((setting == 'passback') || (setting == 'roster')) { + radioname = 'ltitools_'+setting+'_'+item; + divid = 'ltitools_'+setting+'time_'+item; + var num = form.elements[radioname].length; + if (num) { + var setvis = ''; + for (var i=0; i +// + +'; + } + my (%ordered,$total,%jstext); + $total = scalar(keys(%{$settings})); + foreach my $item (keys(%{$settings})) { + if (ref($settings->{$item}) eq 'HASH') { + my $num = $settings->{$item}{'order'}; + if ($num eq '') { + $num = $total - 1; + } + $ordered{$num} = $item; + } + } + my @jsarray = (); + foreach my $item (sort {$a <=> $b } (keys(%ordered))) { + push(@jsarray,$ordered{$item}); + } + my $jstext = ' var lti = Array('."'".join("','",@jsarray)."'".');'."\n"; return <<"ENDSCRIPT"; + +ENDSCRIPT + } else { +return <<"ENDSCRIPT"; + ENDSCRIPT } + return; } sub passwords_javascript { @@ -9371,7 +10050,7 @@ sub passwords_javascript { passmax => 'Warning: maximum password length must be a positive integer (or blank).', passnum => 'Warning: number of previous passwords to save must be a positive integer (or blank).', ); - } elsif ($prefix eq 'secrets') { + } elsif (($prefix eq 'ltisecrets') || ($prefix eq 'toolsecrets')) { %intalert = &Apache::lonlocal::texthash ( passmin => 'Warning: minimum secret length must be a positive integer greater than 6.', passmax => 'Warning: maximum secret length must be a positive integer (or blank).', @@ -9681,7 +10360,7 @@ sub build_category_rows { sub modifiable_userdata_row { my ($context,$item,$settings,$numinrow,$rowcount,$usertypes,$fieldsref,$titlesref, - $rowid,$customcss,$rowstyle) = @_; + $rowid,$customcss,$rowstyle,$itemdesc) = @_; my ($role,$rolename,$statustype); $role = $item; if ($context eq 'cancreate') { @@ -9702,6 +10381,8 @@ sub modifiable_userdata_row { } else { $rolename = $role; } + } elsif ($context eq 'lti') { + $rolename = &mt('Institutional data used (if available)'); } else { if ($role eq 'cr') { $rolename = &mt('Custom role'); @@ -9739,42 +10420,41 @@ sub modifiable_userdata_row { if ($rowid) { $rowid = ' id="'.$rowid.'"'; } - $output = ''. ''.$rolename.''. ''; my $rem; my %checks; if (ref($settings) eq 'HASH') { - if (ref($settings->{$context}) eq 'HASH') { + my $hashref; + if ($context eq 'lti') { + if (ref($settings) eq 'HASH') { + $hashref = $settings->{'instdata'}; + } + } elsif (ref($settings->{$context}) eq 'HASH') { if (ref($settings->{$context}->{$role}) eq 'HASH') { - my $hashref = $settings->{$context}->{$role}; - if ($role eq 'emailusername') { - if ($statustype) { - if (ref($settings->{$context}->{$role}->{$statustype}) eq 'HASH') { - $hashref = $settings->{$context}->{$role}->{$statustype}; - if (ref($hashref) eq 'HASH') { - foreach my $field (@fields) { - if ($hashref->{$field}) { - $checks{$field} = $hashref->{$field}; - } - } - } - } + $hashref = $settings->{'lti_instdata'}; + } + if ($role eq 'emailusername') { + if ($statustype) { + if (ref($settings->{$context}->{$role}->{$statustype}) eq 'HASH') { + $hashref = $settings->{$context}->{$role}->{$statustype}; } - } else { - if (ref($hashref) eq 'HASH') { - foreach my $field (@fields) { - if ($hashref->{$field}) { - $checks{$field} = ' checked="checked" '; - } - } + } + } + } + if (ref($hashref) eq 'HASH') { + foreach my $field (@fields) { + if ($hashref->{$field}) { + if ($role eq 'emailusername') { + $checks{$field} = $hashref->{$field}; + } else { + $checks{$field} = ' checked="checked" '; } } } } } - my $total = scalar(@fields); for (my $i=0; $i<$total; $i++) { $rem = $i%($numinrow); @@ -9788,7 +10468,7 @@ sub modifiable_userdata_row { unless ($role eq 'emailusername') { if (exists($checks{$fields[$i]})) { $check = $checks{$fields[$i]}; - } else { + } elsif ($context ne 'lti') { if ($role eq 'st') { if (ref($settings) ne 'HASH') { $check = ' checked="checked" '; @@ -9798,6 +10478,7 @@ sub modifiable_userdata_row { } $output .= ''; } } @@ -10184,13 +10868,16 @@ sub modify_login { if ($addedfile ne '') { push(@allnew,$addedfile); } + my $modified = []; foreach my $lang (@allnew) { my $formelem = 'loginhelpurl_'.$lang; if ($lang eq $env{'form.loginhelpurl_add_lang'}) { $formelem = 'loginhelpurl_add_file'; } - (my $result,$newurl{$lang}) = &publishlogo($r,'upload',$formelem,$dom,$confname, - "help/$lang",'','',$newfile{$lang}); + (my $result,$newurl{$lang}) = + &Apache::lonconfigsettings::publishlogo($r,'upload',$formelem,$dom,$confname, + "help/$lang",'','',$newfile{$lang}, + $modified); if ($result eq 'ok') { $loginhash{'login'}{'helpurl'}{$lang} = $newurl{$lang}; $changes{'helpurl'}{$lang} = 1; @@ -10203,6 +10890,7 @@ sub modify_login { } } } + &update_modify_urls($r,$modified); } else { $error = &mt("Upload of custom log-in help file(s) failed because an author role could not be assigned to a Domain Configuration user ([_1]) in domain: [_2]. Error was: [_3].",$confname,$dom,$author_ok); } @@ -10260,11 +10948,14 @@ sub modify_login { if ($switchserver) { $error = &mt("Upload of custom markup is not permitted to this server: [_1]",$switchserver); } elsif ($author_ok eq 'ok') { + my $modified = []; foreach my $lonhost (@newhosts) { my $formelem = 'loginheadtag_'.$lonhost; - (my $result,$newheadtagurls{$lonhost}) = &publishlogo($r,'upload',$formelem,$dom,$confname, - "login/headtag/$lonhost",'','', - $env{'form.loginheadtag_'.$lonhost.'.filename'}); + (my $result,$newheadtagurls{$lonhost}) = + &Apache::lonconfigsettings::publishlogo($r,'upload',$formelem,$dom,$confname, + "login/headtag/$lonhost",'','', + $env{'form.loginheadtag_'.$lonhost.'.filename'}, + $modified); if ($result eq 'ok') { $loginhash{'login'}{'headtag'}{$lonhost}{'url'} = $newheadtagurls{$lonhost}; $changes{'headtag'}{$lonhost} = 1; @@ -10281,6 +10972,7 @@ sub modify_login { } } } + &update_modify_urls($r,$modified); } else { $error = &mt("Upload of custom markup file(s) failed because an author role could not be assigned to a Domain Configuration user ([_1]) in domain: [_2]. Error was: [_3].",$confname,$dom,$author_ok); } @@ -10355,11 +11047,14 @@ sub modify_login { if ($switchserver) { $error = &mt("Upload of SSO Button Image is not permitted to this server: [_1].",$switchserver); } elsif ($author_ok eq 'ok') { + my $modified = []; foreach my $lonhost (@newsamlimgs) { my $formelem = 'saml_img_'.$lonhost; - my ($result,$imgurl) = &publishlogo($r,'upload',$formelem,$dom,$confname, - "login/saml/$lonhost",'','', - $env{'form.saml_img_'.$lonhost.'.filename'}); + my ($result,$imgurl) = + &Apache::lonconfigsettings::publishlogo($r,'upload',$formelem,$dom,$confname, + "login/saml/$lonhost",'','', + $env{'form.saml_img_'.$lonhost.'.filename'}, + $modified); if ($result eq 'ok') { $currsaml{$lonhost}{'img'} = $imgurl; $loginhash{'login'}{'saml'}{$lonhost}{'img'} = $imgurl; @@ -10370,6 +11065,7 @@ sub modify_login { $errors .= '
  • '.$puberror.'
    • '; } } + &update_modify_urls($r,$modified); } else { $error = &mt("Upload of SSO button image file(s) failed because an author role could not be assigned to a Domain Configuration user ([_1]) in domain: [_2]. Error was: [_3].",$confname,$dom,$author_ok); } @@ -11074,12 +11770,15 @@ sub modify_colors { $error = &mt("Upload of [_1] image for $role page(s) is not permitted to this server: [_2]",$choices{$img},$switchserver); } else { if ($author_ok eq 'ok') { + my $modified = []; my ($result,$logourl) = - &publishlogo($r,'upload',$role.'_'.$img, - $dom,$confname,$img,$width,$height); + &Apache::lonconfigsettings::publishlogo($r,'upload',$role.'_'.$img, + $dom,$confname,$img,$width,$height, + '',$modified); if ($result eq 'ok') { $confhash->{$role}{$img} = $logourl; $changes{$role}{'images'}{$img} = 1; + &update_modify_urls($r,$modified); } else { $error = &mt("Upload of [_1] image for $role page(s) failed because an error occurred publishing the file in RES space. Error was: [_2].",$choices{img},$result); } @@ -11101,12 +11800,15 @@ sub modify_colors { # is confname an author? if ($switchserver eq '') { if ($author_ok eq 'ok') { + my $modified = []; my ($result,$logourl) = - &publishlogo($r,'copy',$domconfig->{$role}{$img}, - $dom,$confname,$img,$width,$height); + &Apache::lonconfigsettings::publishlogo($r,'copy',$domconfig->{$role}{$img}, + $dom,$confname,$img,$width,$height, + '',$modified); if ($result eq 'ok') { $confhash->{$role}{$img} = $logourl; $changes{$role}{'images'}{$img} = 1; + &update_modify_urls($r,$modified); } } } @@ -11400,228 +12102,16 @@ sub check_authorstatus { return $author_ok; } -sub publishlogo { - my ($r,$action,$formname,$dom,$confname,$subdir,$thumbwidth,$thumbheight,$savefileas) = @_; - my ($output,$fname,$logourl); - 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; - push(@{$modified_urls},[$copyfile,$source]); - my $metaoutput = - &write_metadata($dom,$confname,$formname,$targetdir,$file,$logfile); - unless ($registered_cleanup) { - my $handlers = $r->get_handlers('PerlCleanupHandler'); - $r->set_handlers('PerlCleanupHandler' => [\¬ifysubscribed,@{$handlers}]); - $registered_cleanup=1; - } - } 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) = &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); - push(@{$modified_urls},[$copyfile,$outfile]); - unless ($registered_cleanup) { - my $handlers = $r->get_handlers('PerlCleanupHandler'); - $r->set_handlers('PerlCleanupHandler' => [\¬ifysubscribed,@{$handlers}]); - $registered_cleanup=1; - } - } else { - print $logfile "\nUnable to write ".$copyfile. - ':'.$!."\n"; - } - } - } - } - } - } else { - $output = $versionresult; - } - } - return ($output,$logourl); -} - -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'); +sub update_modify_urls { + my ($r,$modified) = @_; + if ((ref($modified) eq 'ARRAY') && (@{$modified})) { + push(@{$modified_urls},$modified); + unless ($registered_cleanup) { + my $handlers = $r->get_handlers('PerlCleanupHandler'); + $r->set_handlers('PerlCleanupHandler' => [\¬ifysubscribed,@{$handlers}]); + $registered_cleanup=1; } } - return $output; } sub notifysubscribed { @@ -11672,15 +12162,21 @@ sub subscribed_hosts { sub check_switchserver { my ($dom,$confname) = @_; - my ($allowed,$switchserver); - my $home = &Apache::lonnet::homeserver($confname,$dom); - if ($home eq 'no_host') { + my ($allowed,$switchserver,$home); + if ($confname eq '') { $home = &Apache::lonnet::domain($dom,'primary'); + } else { + $home = &Apache::lonnet::homeserver($confname,$dom); + if ($home eq 'no_host') { + $home = &Apache::lonnet::domain($dom,'primary'); + } } my @ids=&Apache::lonnet::current_machine_ids(); foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } } if (!$allowed) { - $switchserver=''.&mt('Switch Server').''; + $switchserver=''.&mt('Switch Server').''; } return $switchserver; } @@ -11697,7 +12193,7 @@ sub modify_quotas { $context = $action; } if ($context eq 'requestcourses') { - @usertools = ('official','unofficial','community','textbook'); + @usertools = ('official','unofficial','community','textbook','lti'); @options =('norequest','approval','validate','autolimit'); %validations = &Apache::lonnet::auto_courserequest_checks($dom); %titles = &courserequest_titles(); @@ -11712,7 +12208,7 @@ sub modify_quotas { @usertools = ('author'); %titles = &authorrequest_titles(); } else { - @usertools = ('aboutme','blog','webdav','portfolio'); + @usertools = ('aboutme','blog','webdav','portfolio','timezone'); %titles = &tool_titles(); } my %domdefaults = &Apache::lonnet::get_domain_defaults($dom,1); @@ -11746,7 +12242,7 @@ sub modify_quotas { my @approvalnotify = &Apache::loncommon::get_env_multiple('form.'.$context.'notifyapproval'); @approvalnotify = sort(@approvalnotify); $confhash{'notify'}{'approval'} = join(',',@approvalnotify); - my @crstypes = ('official','unofficial','community','textbook'); + my @crstypes = ('official','unofficial','community','textbook','lti'); my @hasuniquecode = &Apache::loncommon::get_env_multiple('form.uniquecode'); foreach my $type (@hasuniquecode) { if (grep(/^\Q$type\E$/,@crstypes)) { @@ -11868,7 +12364,7 @@ sub modify_quotas { &Apache::lonnet::logthis($error); $errors .= '
  • '.$error.'
    • '; } - } + } } elsif ($domconfig{$action}{$type}{$key}{'image'}) { $confhash{$type}{$key}{'image'} = $domconfig{$action}{$type}{$key}{'image'}; @@ -12403,11 +12899,14 @@ sub process_textbook_image { $error = &mt('Upload of textbook image is not permitted to this server: [_1]', $switchserver); } elsif ($author_ok eq 'ok') { + my $modified = []; my ($result,$imageurl) = - &publishlogo($r,'upload',$caller,$dom,$confname, - "$type/$cdom/$cnum/cover",$width,$height); + &Apache::lonconfigsettings::publishlogo($r,'upload',$caller,$dom,$confname, + "$type/$cdom/$cnum/cover",$width,$height, + '',$modified); if ($result eq 'ok') { $url = $imageurl; + &update_modify_urls($r,$modified); } else { $error = &mt("Upload of [_1] failed because an error occurred publishing the file in RES space. Error was: [_2].",$filename,$result); } @@ -12422,361 +12921,809 @@ sub process_textbook_image { sub modify_ltitools { my ($r,$dom,$action,$lastactref,%domconfig) = @_; - my %domdefaults = &Apache::lonnet::get_domain_defaults($dom,1); - my ($newid,@allpos,%changes,%confhash,%encconfig,$errors,$resulttext); + my (%currtoolsec,%secchanges,%newtoolsec,%newkeyset); + &fetch_secrets($dom,'toolsec',\%domconfig,\%currtoolsec,\%secchanges,\%newtoolsec,\%newkeyset); + my $confname = $dom.'-domainconfig'; my $servadm = $r->dir_config('lonAdmEMail'); my ($configuserok,$author_ok,$switchserver) = &config_check($dom,$confname,$servadm); - 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 %lt = <itools_names(); - if ($env{'form.ltitools_add'}) { - my $title = $env{'form.ltitools_add_title'}; - $title =~ s/(`)/'/g; - ($newid,my $error) = &get_ltitools_id($dom,$title); - if ($newid) { - my $position = $env{'form.ltitools_add_pos'}; - $position =~ s/\D+//g; - if ($position ne '') { - $allpos[$position] = $newid; - } - $changes{$newid} = 1; - foreach my $item ('title','url','key','secret','lifetime') { - $env{'form.ltitools_add_'.$item} =~ s/(`)/'/g; - if ($item eq 'lifetime') { - $env{'form.ltitools_add_'.$item} =~ s/[^\d.]//g; + + my ($resulttext,$ltitoolsoutput,$is_home,$errors,%ltitoolschg,%newtoolsenc,%newltitools); + my $toolserror = + &Apache::courseprefs::process_ltitools($r,$dom,$confname,$domconfig{'ltitools'},\%ltitoolschg,'domain', + $lastactref,$configuserok,$switchserver,$author_ok); + + my $home = &Apache::lonnet::domain($dom,'primary'); + unless (($home eq 'no_host') || ($home eq '')) { + my @ids=&Apache::lonnet::current_machine_ids(); + foreach my $id (@ids) { if ($id eq $home) { $is_home=1; last; } } + } + + if (keys(%ltitoolschg)) { + foreach my $id (keys(%ltitoolschg)) { + if (ref($ltitoolschg{$id}) eq 'HASH') { + foreach my $inner (keys(%{$ltitoolschg{$id}})) { + if (($inner eq 'secret') || ($inner eq 'key')) { + if ($is_home) { + $newtoolsenc{$id}{$inner} = $ltitoolschg{$id}{$inner}; + } + } } - if ($env{'form.ltitools_add_'.$item}) { - if (($item eq 'key') || ($item eq 'secret')) { - $encconfig{$newid}{$item} = $env{'form.ltitools_add_'.$item}; - } else { - $confhash{$newid}{$item} = $env{'form.ltitools_add_'.$item}; + } + } + $ltitoolsoutput = &Apache::courseprefs::store_ltitools($dom,'','domain',\%ltitoolschg,$domconfig{'ltitools'}); + if (keys(%ltitoolschg)) { + %newltitools = %ltitoolschg; + } + } + if (ref($domconfig{'ltitools'}) eq 'HASH') { + foreach my $id (%{$domconfig{'ltitools'}}) { + next if ($id !~ /^\d+$/); + unless (exists($ltitoolschg{$id})) { + if (ref($domconfig{'ltitools'}{$id}) eq 'HASH') { + foreach my $inner (keys(%{$domconfig{'ltitools'}{$id}})) { + if (($inner eq 'secret') || ($inner eq 'key')) { + if ($is_home) { + $newtoolsenc{$id}{$inner} = $domconfig{'ltitools'}{$id}{$inner}; + } + } else { + $newltitools{$id}{$inner} = $domconfig{'ltitools'}{$id}{$inner}; + } } + } else { + $newltitools{$id} = $domconfig{'ltitools'}{$id}; } } - if ($env{'form.ltitools_add_version'} eq 'LTI-1p0') { - $confhash{$newid}{'version'} = $env{'form.ltitools_add_version'}; + } + } + if ($toolserror) { + $errors = '
  • '.$toolserror.'
    • '; + } + if ((keys(%ltitoolschg) == 0) && (keys(%secchanges) == 0)) { + $resulttext = &mt('No changes made.'); + if ($errors) { + $resulttext .= '
    '.&mt('The following errors occurred: ').''; + } + return $resulttext; + } + my %ltitoolshash = ( + $action => { %newltitools } + ); + if (keys(%secchanges)) { + $ltitoolshash{'toolsec'} = \%newtoolsec; + } + my $putresult = &Apache::lonnet::put_dom('configuration',\%ltitoolshash,$dom); + if ($putresult eq 'ok') { + my %keystore; + if ($is_home) { + my %toolsenchash = ( + $action => { %newtoolsenc } + ); + &Apache::lonnet::put_dom('encconfig',\%toolsenchash,$dom,undef,1); + my $cachetime = 24*60*60; + &Apache::lonnet::do_cache_new('ltitoolsenc',$dom,\%newtoolsenc,$cachetime); + &store_security($dom,'ltitools',\%secchanges,\%newkeyset,\%keystore,$lastactref); + } + $resulttext = &mt('Changes made:').''. ''; } else { $resulttext .= '
  • '.&mt('Default quota for content uploaded via Course Editor remains default: [_1] MB',$staticdefaults{'uploadquota'}).'
    • '; } + } elsif ($item eq 'coursequota') { + if (ref($defaultshash{'coursedefaults'}{'coursequota'}) eq 'HASH') { + $resulttext .= '
  • '.&mt('Default cumulative quota for all group portfolio spaces in course set as follows:').''. + '
    • '; + } else { + $resulttext .= '
  • '.&mt('Default cumulative quota for all group portfolio spaces in course remains default: [_1] MB',$staticdefaults{'coursequota'}).'
    • '; + } } elsif ($item eq 'mysqltables') { if (ref($defaultshash{'coursedefaults'}{'mysqltables'}) eq 'HASH') { $resulttext .= '
  • '.&mt('Lifetime of "Temporary" MySQL tables (student performance data) on homeserver').''; @@ -18458,6 +19396,7 @@ sub modify_wafproxy { } } } + $output .= ''; } else { $output = ''. &mt('An error occurred: [_1]',$putresult).''; @@ -18811,7 +19750,7 @@ sub modify_usersessions { } } else { if ($type eq 'version') { - $newvalue .= ' '.&mt('(or later)'); + $newvalue .= ' '.&mt('(or later)'); } $resulttext .= '
  • '.&mt('[_1] set to: [_2].',$lt{$type},$newvalue).'
    • '; } @@ -19694,7 +20633,7 @@ function updateNewSpares(formname,lonhos function checkNewSpares(lonhost,type) { var newSpare = document.getElementById('newspare_'+type+'_'+lonhost); var chosen = newSpare.options[newSpare.selectedIndex].value; - if (chosen != '') { + if (chosen != '') { var othertype; var othernewSpare; if (type == 'primary') { @@ -19828,7 +20767,7 @@ function toggleDisplay(domForm,caller) { var dispval = 'block'; var selfcreateRegExp = /^cancreate_emailverified/; if (caller == 'emailoptions') { - optionsElement = domForm.cancreate_email; + optionsElement = domForm.cancreate_email; } if (caller == 'studentsubmission') { optionsElement = domForm.postsubmit;
    '. ''; + my $prefix = 'canmodify'; if ($role eq 'emailusername') { unless ($checks{$fields[$i]} =~ /^(required|optional)$/) { $checks{$fields[$i]} = 'omit'; @@ -9808,13 +10489,16 @@ sub modifiable_userdata_row { $checked='checked="checked" '; } $output .= ''.(' ' x2); } $output .= ''.$fieldtitles{$fields[$i]}.''; } else { + if ($context eq 'lti') { + $prefix = 'lti'; + } $output .= ''; } @@ -9901,7 +10585,7 @@ sub insttypes_row { $output .= ''. '