--- loncom/interface/domainprefs.pm 2023/07/05 17:08:22 1.160.6.118.2.14 +++ loncom/interface/domainprefs.pm 2024/12/29 04:27:32 1.160.6.125 @@ -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.14 2023/07/05 17:08:22 raeburn Exp $ +# $Id: domainprefs.pm,v 1.160.6.125 2024/12/29 04:27:32 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, textbook, and lti). -In each case the radio buttons allow the selection of one of four values: +(official, unofficial, community, and textbook). 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,7 +167,6 @@ 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(); @@ -175,9 +174,7 @@ 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; @@ -221,78 +218,13 @@ sub handler { 'serverstatuses','requestcourses','helpsettings', 'coursedefaults','usersessions','loadbalancing', 'requestauthor','selfenrollment','inststatus', - 'passwords','ltitools','toolsec','lti','ltisec', - 'wafproxy','ipaccess'],$dom); - my %encconfig = - &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') && - (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'}; - } - } - } - } - } - if (ref($domconfig{'ltisec'}) eq 'HASH') { - if (ref($domconfig{'ltisec'}{'linkprot'}) eq 'HASH') { - if (ref($encconfig{'linkprot'}) eq 'HASH') { - foreach my $id (keys(%{$domconfig{'ltisec'}{'linkprot'}})) { - unless ($id =~ /^\d+$/) { - delete($domconfig{'ltisec'}{'linkprot'}{$id}); - } - if ((ref($domconfig{'ltisec'}{'linkprot'}{$id}) eq 'HASH') && - (ref($encconfig{'linkprot'}{$id}) eq 'HASH')) { - foreach my $item ('key','secret') { - $domconfig{'ltisec'}{'linkprot'}{$id}{$item} = $encconfig{'linkprot'}{$id}{$item}; - } - } - } - } - } - } + 'passwords','wafproxy','ipaccess'],$dom); my @prefs_order = ('rolecolors','login','ipaccess','defaults','wafproxy','passwords', 'quotas','autoenroll','autoupdate','autocreate','directorysrch', 'contacts','usercreation','selfcreation','usermodification', 'scantron','requestcourses','requestauthor','coursecategories', 'serverstatuses','helpsettings','coursedefaults', - 'ltitools','selfenrollment','usersessions','lti'); + 'selfenrollment','usersessions'); my %existing; if (ref($domconfig{'loadbalancing'}) eq 'HASH') { %existing = %{$domconfig{'loadbalancing'}}; @@ -368,7 +300,7 @@ sub handler { modify => \&modify_passwords, }, 'quotas' => - { text => 'Blogs, personal pages/timezones, webDAV/quotas, portfolio', + { text => 'Blogs, personal web pages, webDAV/quotas, portfolios', help => 'Domain_Configuration_Quotas', header => [{col1 => 'User affiliation', col2 => 'Available tools', @@ -576,33 +508,7 @@ sub handler { print => \&print_loadbalancing, modify => \&modify_loadbalancing, }, - 'ltitools' => - {text => 'External Tools (LTI)', - help => 'Domain_Configuration_LTI_Tools', - 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' => - {text => 'LTI Link Protection and LTI Consumers', - help => 'Domain_Configuration_LTI_Provider', - header => [{col1 => 'Encryption of shared secrets', - col2 => 'Settings'}, - {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', @@ -617,7 +523,7 @@ sub handler { header => [{col1 => 'Log-in Service', col2 => 'Server Setting',}, {col1 => 'Log-in Page Items', - col2 => 'Settings'}, + col2 => ''}, {col1 => 'Log-in Help', col2 => 'Value'}, {col1 => 'Custom HTML in document head', @@ -797,10 +703,6 @@ 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 'wafproxy') { @@ -820,7 +722,7 @@ sub print_config_box { } elsif ($action eq 'defaults') { $output = &defaults_javascript($settings); } elsif ($action eq 'passwords') { - $output = &passwords_javascript($action); + $output = &passwords_javascript(); } elsif ($action eq 'helpsettings') { my (%privs,%levelscurrent); my %full=(); @@ -837,11 +739,6 @@ sub print_config_box { $output = &Apache::lonuserutils::custom_roledefs_js($context,$crstype,$formname,\%full, \@templateroles); - } elsif ($action eq 'ltitools') { - $output .= &Apache::lonconfigsettings::ltitools_javascript($settings); - } elsif ($action eq 'lti') { - $output .= &passwords_javascript('ltisecrets')."\n". - <i_javascript($dom,$settings); } elsif ($action eq 'wafproxy') { $output .= &wafproxy_javascript($dom); } elsif ($action eq 'autoupdate') { @@ -868,7 +765,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))) { @@ -892,8 +789,7 @@ 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 'ltitools')) { + ($action eq 'helpsettings') || ($action eq 'contacts') || ($action eq 'wafproxy')) { $output .= $item->{'print'}->('top',$dom,$settings,\$rowtotal); } elsif ($action eq 'passwords') { $output .= $item->{'print'}->('top',$dom,$confname,$settings,\$rowtotal); @@ -928,9 +824,7 @@ sub print_config_box { if (($action eq 'autoupdate') || ($action eq 'usercreation') || ($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 'ltitools')) { + ($action eq 'contacts') || ($action eq 'passwords') || ($action eq 'defaults')) { if ($action eq 'coursecategories') { $output .= &print_coursecategories('middle',$dom,$item,$settings,\$rowtotal); $colspan = ' colspan="2"'; @@ -1186,6 +1080,7 @@ 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'}; @@ -1516,7 +1411,7 @@ sub print_login { ''. ''. ''."\n"; - my (%saml,%samltext,%samlimg,%samlalt,%samlurl,%samltitle,%samlwindow,%samlnotsso,%styleon,%styleoff); + my (%saml,%samltext,%samlimg,%samlalt,%samlurl,%samltitle,%samlnotsso,%styleon,%styleoff); foreach my $lonhost (keys(%domservers)) { $samlurl{$lonhost} = '/adm/sso'; $styleon{$lonhost} = 'display:none'; @@ -1531,7 +1426,6 @@ sub print_login { $samlalt{$lonhost} = $settings->{'saml'}{$lonhost}{'alt'}; $samlurl{$lonhost} = $settings->{'saml'}{$lonhost}{'url'}; $samltitle{$lonhost} = $settings->{'saml'}{$lonhost}{'title'}; - $samlwindow{$lonhost} = $settings->{'saml'}{$lonhost}{'window'}; $samlnotsso{$lonhost} = $settings->{'saml'}{$lonhost}{'notsso'}; $styleon{$lonhost} = ''; $styleoff{$lonhost} = 'display:none'; @@ -1549,12 +1443,6 @@ sub print_login { $samlon = $samloff; $samloff = ' '; } - my $samlwinon = ''; - my $samlwinoff = ' checked="checked"'; - if ($samlwindow{$lonhost}) { - $samlwinon = $samlwinoff; - $samlwinoff = ''; - } my $css_class = $itemcount%2?' class="LC_odd_row"':''; $datatable .= ''. ''. ''. ''; @@ -1845,7 +1727,7 @@ sub print_rolecolors { my %choices = &color_font_choices(); my @bgs = ('pgbg','tabbg','sidebg'); my @links = ('link','alink','vlink'); - my @images = ('img'); + my @images = (); my %alt_text = &Apache::lonlocal::texthash(img => "Banner for $role role"); my %designhash = &Apache::loncommon::get_domainconf($dom); my %defaultdesign = %Apache::loncommon::defaultdesign; @@ -1853,10 +1735,6 @@ sub print_rolecolors { my %defaults = &role_defaults($role,\@bgs,\@links,\@images); if (ref($settings) eq 'HASH') { if (ref($settings->{$role}) eq 'HASH') { - if ($settings->{$role}->{'img'} ne '') { - $designs{'img'} = $settings->{$role}->{'img'}; - $is_custom{'img'} = 1; - } if ($settings->{$role}->{'font'} ne '') { $designs{'font'} = $settings->{$role}->{'font'}; $is_custom{'font'} = 1; @@ -1879,10 +1757,6 @@ sub print_rolecolors { } } } else { - if ($designhash{$dom.'.'.$role.'.img'} ne '') { - $designs{img} = $designhash{$dom.'.'.$role.'.img'}; - $is_custom{'img'} = 1; - } if ($designhash{$dom.'.'.$role.'.fontmenu'} ne '') { $designs{fontmenu} = $designhash{$dom.'.'.$role.'.fontmenu'}; $is_custom{'fontmenu'} = 1; @@ -1932,7 +1806,6 @@ sub role_defaults { } } else { %defaults = ( - img => $defaultdesign{$role.'.img'}, font => $defaultdesign{$role.'.font'}, fontmenu => $defaultdesign{$role.'.fontmenu'}, ); @@ -1997,7 +1870,7 @@ sub display_color_options { $logincolors = &login_text_colors($img,$role,$logintext,$phase,$choices, $designs,$defaults); - } else { + } else { if ($img ne 'domlogo') { $datatable.= &logo_display_options($img,$defaults,$designs); } @@ -2262,7 +2135,7 @@ sub print_quotas { my $typecount = 0; my ($css_class,%titles); if ($context eq 'requestcourses') { - @usertools = ('official','unofficial','community','textbook','lti'); + @usertools = ('official','unofficial','community','textbook'); @options =('norequest','approval','validate','autolimit'); %validations = &Apache::lonnet::auto_courserequest_checks($dom); %titles = &courserequest_titles(); @@ -2271,7 +2144,7 @@ sub print_quotas { @options = ('norequest','approval','automatic'); %titles = &authorrequest_titles(); } else { - @usertools = ('aboutme','blog','webdav','portfolio','timezone'); + @usertools = ('aboutme','blog','webdav','portfolio'); %titles = &tool_titles(); } if (ref($types) eq 'ARRAY') { @@ -2375,12 +2248,9 @@ 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}) { + if ($settings->{$item}->{$type} == 0) { $checked = ''; } elsif ($settings->{$item}->{$type} == 1) { $checked = 'checked="checked" '; @@ -2729,7 +2599,7 @@ sub print_studentcode { my ($settings,$rowtotal) = @_; my $rownum = 0; my ($output,%current); - my @crstypes = ('official','unofficial','community','textbook','lti'); + my @crstypes = ('official','unofficial','community','textbook'); if (ref($settings) eq 'HASH') { if (ref($settings->{'uniquecode'}) eq 'HASH') { foreach my $type (@crstypes) { @@ -2979,132 +2849,6 @@ $jstext{'templates'}; ENDSCRIPT } -sub ltitools_javascript { - my ($settings) = @_; - my $togglejs = <itools_toggle_js(); - unless (ref($settings) eq 'HASH') { - return $togglejs; - } - my (%ordered,$total,%jstext); - $total = 0; - foreach my $item (keys(%{$settings})) { - if (ref($settings->{$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 wafproxy_javascript { my ($dom) = @_; return <<"ENDSCRIPT"; @@ -3220,312 +2964,6 @@ function toggleWAF() { ENDSCRIPT } -sub lti_javascript { - my ($dom,$settings) = @_; - my $togglejs = <i_toggle_js($dom); - my $linkprot_js = &Apache::courseprefs::linkprot_javascript(); - unless (ref($settings) eq 'HASH') { - return $togglejs.' - -'; - } - 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"; - - -$togglejs - -ENDSCRIPT -} - -sub lti_toggle_js { - my ($dom) = @_; - my %lcauthparmtext = &Apache::lonlocal::texthash ( - localauth => 'Local auth argument', - krb => 'Kerberos domain', - ); - my $crsincalert = &mt('"User\'s identity sent" needs to be set to "Yes" first,[_1] before setting "Course\'s identity sent" to "Yes"',"\n"); - &js_escape(\$crsincalert); - my %servers = &Apache::lonnet::get_servers($dom,'library'); - my $primary = &Apache::lonnet::domain($dom,'primary'); - my $course_servers = "'".join("','",keys(%servers))."'"; - return <<"ENDSCRIPT"; - - -ENDSCRIPT -} - sub autoupdate_javascript { return <<"ENDSCRIPT"; - -ENDSCRIPT - } else { -return <<"ENDSCRIPT"; - ENDSCRIPT } - return; } sub passwords_javascript { - my ($prefix) = @_; - my %intalert; - if ($prefix eq 'passwords') { - %intalert = &Apache::lonlocal::texthash ( - authcheck => 'Warning: disallowing login for an authenticated user if the stored cost is less than the default will require a password reset by/for the user.', - authcost => 'Warning: bcrypt encryption cost for internal authentication must be an integer.', - passmin => 'Warning: minimum password length must be a positive integer greater than 6.', - 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 '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).', - ); - } + my %intalert = &Apache::lonlocal::texthash ( + authcheck => 'Warning: disallowing login for an authenticated user if the stored cost is less than the default will require a password reset by/for the user.', + authcost => 'Warning: bcrypt encryption cost for internal authentication must be an integer.', + passmin => 'Warning: minimum password length must be a positive integer greater than 6.', + passmax => 'Warning: maximum password length must be a positive integer (or blank).', + passexp => 'Warning: days before password expiration must be a positive integer (or blank).', + passnum => 'Warning: number of previous passwords to save must be a positive integer (or blank).', + ); &js_escape(\%intalert); my $defmin = $Apache::lonnet::passwdmin; - my $intauthjs; - if ($prefix eq 'passwords') { $intauthjs = <<"ENDSCRIPT"; + my $intauthjs = <<"ENDSCRIPT"; function warnIntAuth(field) { if (field.name == 'intauth_check') { @@ -10054,17 +8481,11 @@ function warnIntAuth(field) { return; } -ENDSCRIPT - - } - - $intauthjs .= <<"ENDSCRIPT"; - -function warnInt$prefix(field) { +function warnIntPass(field) { field.value.replace(/^\s+/,''); field.value.replace(/\s+\$/,''); var regexdigit=/^\\d+\$/; - if (field.name == '${prefix}_min') { + if (field.name == 'passwords_min') { if (field.value == '') { alert('$intalert{passmin}'); field.value = '$defmin'; @@ -10084,15 +8505,29 @@ function warnInt$prefix(field) { field.value = ''; } if (field.value != '') { - if (!regexdigit.test(field.value)) { - if (field.name == '${prefix}_max') { - alert('$intalert{passmax}'); + if (field.name == 'passwords_expire') { + var regexpposnum=/^\\d+(|\\.\\d*)\$/; + if (!regexpposnum.test(field.value)) { + alert('$intalert{passexp}'); + field.value = ''; } else { - if (field.name == '${prefix}_numsaved') { - alert('$intalert{passnum}'); + var expval = parseFloat(field.value); + if (expval == 0) { + alert('$intalert{passexp}'); + field.value = ''; + } + } + } else { + if (!regexdigit.test(field.value)) { + if (field.name == 'passwords_max') { + alert('$intalert{passmax}'); + } else { + if (field.name == 'passwords_numsaved') { + alert('$intalert{passnum}'); + } } + field.value = ''; } - field.value = ''; } } } @@ -10335,7 +8770,7 @@ sub build_category_rows { sub modifiable_userdata_row { my ($context,$item,$settings,$numinrow,$rowcount,$usertypes,$fieldsref,$titlesref, - $rowid,$customcss,$rowstyle,$itemdesc) = @_; + $rowid,$customcss,$rowstyle) = @_; my ($role,$rolename,$statustype); $role = $item; if ($context eq 'cancreate') { @@ -10356,8 +8791,6 @@ 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'); @@ -10395,41 +8828,42 @@ sub modifiable_userdata_row { if ($rowid) { $rowid = ' id="'.$rowid.'"'; } + $output = ''. ''. '
'.$choices{'hostid'}.''.$choices{'samllanding'}.''.$choices{'samloptions'}.'
'.$domservers{$lonhost}.''. - ''. + '
'.&mt('SSO').'
'. ''. - ''. - ''. - '
'.&mt('SSO').''. + ''.&mt('Non-SSO').'
'.&mt('Text').''.&mt('Image').''.&mt('Alt Text').'
'; if ($samlimg{$lonhost}) { $datatable .= '
'. @@ -1584,21 +1474,13 @@ sub print_login { $datatable .= ''; } $datatable .= '

'. - ''. - ''. - ''. - ''. - ''. + ''. - ''. - ''. - ''. '
'.&mt('SSO').''. - ''.&mt('Non-SSO').'
'.&mt('URL').''.&mt('Tool Tip').''.&mt('Pop-up if iframe').''.&mt('Text').'
'.(' 'x2).'
 
'.$rolename.''; my $rem; my %checks; if (ref($settings) 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}) eq 'HASH') { if (ref($settings->{$context}->{$role}) eq 'HASH') { - $hashref = $settings->{'lti_instdata'}; - } - if ($role eq 'emailusername') { - if ($statustype) { - if (ref($settings->{$context}->{$role}->{$statustype}) eq 'HASH') { - $hashref = $settings->{$context}->{$role}->{$statustype}; + 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}; + } + } + } + } } - } - } - } - 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" '; + } else { + if (ref($hashref) eq 'HASH') { + foreach my $field (@fields) { + if ($hashref->{$field}) { + $checks{$field} = ' checked="checked" '; + } + } } } } } } + my $total = scalar(@fields); for (my $i=0; $i<$total; $i++) { $rem = $i%($numinrow); @@ -10443,7 +8877,7 @@ sub modifiable_userdata_row { unless ($role eq 'emailusername') { if (exists($checks{$fields[$i]})) { $check = $checks{$fields[$i]}; - } elsif ($context ne 'lti') { + } else { if ($role eq 'st') { if (ref($settings) ne 'HASH') { $check = ' checked="checked" '; @@ -10453,7 +8887,6 @@ sub modifiable_userdata_row { } $output .= ''; } } @@ -10676,7 +9106,7 @@ sub modify_login { my ($r,$dom,$confname,$lastactref,%domconfig) = @_; my ($resulttext,$errors,$colchgtext,%changes,%colchanges,%newfile,%newurl, %curr_loginvia,%loginhash,@currlangs,@newlangs,$addedfile,%title,@offon, - %currsaml,%saml,%samltext,%samlimg,%samlalt,%samlurl,%samltitle,%samlwindow,%samlnotsso); + %currsaml,%saml,%samltext,%samlimg,%samlalt,%samlurl,%samltitle,%samlnotsso); %title = ( coursecatalog => 'Display course catalog', adminmail => 'Display administrator E-mail address', helpdesk => 'Display "Contact Helpdesk" link', @@ -10700,7 +9130,6 @@ sub modify_login { $samlalt{$lonhost} = $domconfig{login}{'saml'}{$lonhost}{'alt'}; $samlimg{$lonhost} = $domconfig{login}{'saml'}{$lonhost}{'img'}; $samltitle{$lonhost} = $domconfig{login}{'saml'}{$lonhost}{'title'}; - $samlwindow{$lonhost} = $domconfig{login}{'saml'}{$lonhost}{'window'}; $samlnotsso{$lonhost} = $domconfig{login}{'saml'}{$lonhost}{'notsso'}; } } @@ -10843,16 +9272,13 @@ 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}) = - &Apache::lonconfigsettings::publishlogo($r,'upload',$formelem,$dom,$confname, - "help/$lang",'','',$newfile{$lang}, - $modified); + (my $result,$newurl{$lang}) = &publishlogo($r,'upload',$formelem,$dom,$confname, + "help/$lang",'','',$newfile{$lang}); if ($result eq 'ok') { $loginhash{'login'}{'helpurl'}{$lang} = $newurl{$lang}; $changes{'helpurl'}{$lang} = 1; @@ -10865,7 +9291,6 @@ 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); } @@ -10923,14 +9348,11 @@ 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}) = - &Apache::lonconfigsettings::publishlogo($r,'upload',$formelem,$dom,$confname, - "login/headtag/$lonhost",'','', - $env{'form.loginheadtag_'.$lonhost.'.filename'}, - $modified); + (my $result,$newheadtagurls{$lonhost}) = &publishlogo($r,'upload',$formelem,$dom,$confname, + "login/headtag/$lonhost",'','', + $env{'form.loginheadtag_'.$lonhost.'.filename'}); if ($result eq 'ok') { $loginhash{'login'}{'headtag'}{$lonhost}{'url'} = $newheadtagurls{$lonhost}; $changes{'headtag'}{$lonhost} = 1; @@ -10947,7 +9369,6 @@ 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); } @@ -10966,13 +9387,10 @@ sub modify_login { if ($env{'form.saml_img_'.$lonhost.'.filename'}) { push(@newsamlimgs,$lonhost); } - foreach my $item ('text','alt','url','title','window','notsso') { + foreach my $item ('text','alt','url','title','notsso') { $env{'form.saml_'.$item.'_'.$lonhost} =~ s/^\s+|\s+$//g; } if ($saml{$lonhost}) { - if ($env{'form.saml_window_'.$lonhost} ne '1') { - $env{'form.saml_window_'.$lonhost} = ''; - } if (grep(/^\Q$lonhost\E$/,@delsamlimg)) { #FIXME Need to obsolete published image delete($currsaml{$lonhost}{'img'}); @@ -10990,16 +9408,13 @@ sub modify_login { if ($env{'form.saml_title_'.$lonhost} ne $samltitle{$lonhost}) { $changes{'saml'}{$lonhost} = 1; } - if ($env{'form.saml_window_'.$lonhost} ne $samlwindow{$lonhost}) { - $changes{'saml'}{$lonhost} = 1; - } if ($env{'form.saml_notsso_'.$lonhost} ne $samlnotsso{$lonhost}) { $changes{'saml'}{$lonhost} = 1; } } else { $changes{'saml'}{$lonhost} = 1; } - foreach my $item ('text','alt','url','title','window','notsso') { + foreach my $item ('text','alt','url','title','notsso') { $currsaml{$lonhost}{$item} = $env{'form.saml_'.$item.'_'.$lonhost}; } } else { @@ -11022,14 +9437,11 @@ 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) = - &Apache::lonconfigsettings::publishlogo($r,'upload',$formelem,$dom,$confname, - "login/saml/$lonhost",'','', - $env{'form.saml_img_'.$lonhost.'.filename'}, - $modified); + my ($result,$imgurl) = &publishlogo($r,'upload',$formelem,$dom,$confname, + "login/saml/$lonhost",'','', + $env{'form.saml_img_'.$lonhost.'.filename'}); if ($result eq 'ok') { $currsaml{$lonhost}{'img'} = $imgurl; $loginhash{'login'}{'saml'}{$lonhost}{'img'} = $imgurl; @@ -11040,7 +9452,6 @@ 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); } @@ -11204,22 +9615,19 @@ sub modify_login { alt => 'Alt text for button image', url => 'SSO URL', title => 'Tooltip for SSO link', - window => 'Pop-up window if iframe', notsso => 'Text for non-SSO log-in', ); foreach my $lonhost (sort(keys(%{$changes{$item}}))) { if (ref($currsaml{$lonhost}) eq 'HASH') { $resulttext .= '
  • '.&mt("$title{$item} in use for [_1]","$lonhost"). '
      '; - foreach my $key ('text','img','alt','url','title','window','notsso') { + foreach my $key ('text','img','alt','url','title','notsso') { if ($currsaml{$lonhost}{$key} eq '') { $resulttext .= '
    • '.&mt("$notlt{$key} not in use").'
      • '; } else { my $value = "'$currsaml{$lonhost}{$key}'"; if ($key eq 'img') { $value = ''; - } elsif ($key eq 'window') { - $value = 'On'; } $resulttext .= '
    • '.&mt("$notlt{$key} set to: [_1]", $value).'
      • '; @@ -11317,7 +9725,6 @@ sub check_exempt_addresses { sub color_font_choices { my %choices = &Apache::lonlocal::texthash ( - img => "Header", bgs => "Background colors", links => "Link colors", images => "Images", @@ -11666,11 +10073,15 @@ sub modify_colors { @images = ('img','logo','domlogo','login'); @bgs = ('pgbg','mainbg','sidebg'); } else { - @images = ('img'); + @images = (); @bgs = ('pgbg','tabbg','sidebg'); } my %defaults = &role_defaults($role,\@bgs,\@links,\@images,\@logintext); - unless ($env{'form.'.$role.'_font'} eq $defaults{'font'}) { + $env{'form.'.$role.'_font'} = lc($env{'form.'.$role.'_font'}); + if ($env{'form.'.$role.'_font'} =~ /^\w+/) { + $env{'form.'.$role.'_font'} = '#'.$env{'form.'.$role.'_font'}; + } + unless ($env{'form.'.$role.'_font'} eq lc($defaults{'font'})) { $confhash->{$role}{'font'} = $env{'form.'.$role.'_font'}; } if ($role eq 'login') { @@ -11688,7 +10099,7 @@ sub modify_colors { if ($env{'form.'.$role.'_fontmenu'} =~ /^\w+/) { $env{'form.'.$role.'_fontmenu'} = '#'.$env{'form.'.$role.'_fontmenu'}; } - unless($env{'form.'.$role.'_fontmenu'} eq lc($defaults{'fontmenu'})) { + unless ($env{'form.'.$role.'_fontmenu'} eq lc($defaults{'fontmenu'})) { $confhash->{$role}{'fontmenu'} = $env{'form.'.$role.'_fontmenu'}; } } @@ -11717,7 +10128,7 @@ sub modify_colors { $domconfig->{$role} = {}; } foreach my $img (@images) { - if ($role eq 'login') { + if ($role eq 'login') { if (($img eq 'img') || ($img eq 'logo')) { if (defined($env{'form.login_showlogo_'.$img})) { $confhash->{$role}{'showlogo'}{$img} = 1; @@ -11745,15 +10156,12 @@ 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) = - &Apache::lonconfigsettings::publishlogo($r,'upload',$role.'_'.$img, - $dom,$confname,$img,$width,$height, - '',$modified); + &publishlogo($r,'upload',$role.'_'.$img, + $dom,$confname,$img,$width,$height); 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); } @@ -11775,15 +10183,12 @@ sub modify_colors { # is confname an author? if ($switchserver eq '') { if ($author_ok eq 'ok') { - my $modified = []; my ($result,$logourl) = - &Apache::lonconfigsettings::publishlogo($r,'copy',$domconfig->{$role}{$img}, - $dom,$confname,$img,$width,$height, - '',$modified); + &publishlogo($r,'copy',$domconfig->{$role}{$img}, + $dom,$confname,$img,$width,$height); if ($result eq 'ok') { $confhash->{$role}{$img} = $logourl; $changes{$role}{'images'}{$img} = 1; - &update_modify_urls($r,$modified); } } } @@ -12077,16 +10482,228 @@ sub check_authorstatus { return $author_ok; } -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; +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'); } } + return $output; } sub notifysubscribed { @@ -12137,21 +10754,15 @@ sub subscribed_hosts { sub check_switchserver { my ($dom,$confname) = @_; - my ($allowed,$switchserver,$home); - if ($confname eq '') { + my ($allowed,$switchserver); + my $home = &Apache::lonnet::homeserver($confname,$dom); + if ($home eq 'no_host') { $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; } @@ -12168,7 +10779,7 @@ sub modify_quotas { $context = $action; } if ($context eq 'requestcourses') { - @usertools = ('official','unofficial','community','textbook','lti'); + @usertools = ('official','unofficial','community','textbook'); @options =('norequest','approval','validate','autolimit'); %validations = &Apache::lonnet::auto_courserequest_checks($dom); %titles = &courserequest_titles(); @@ -12183,7 +10794,7 @@ sub modify_quotas { @usertools = ('author'); %titles = &authorrequest_titles(); } else { - @usertools = ('aboutme','blog','webdav','portfolio','timezone'); + @usertools = ('aboutme','blog','webdav','portfolio'); %titles = &tool_titles(); } my %domdefaults = &Apache::lonnet::get_domain_defaults($dom,1); @@ -12217,7 +10828,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','lti'); + my @crstypes = ('official','unofficial','community','textbook'); my @hasuniquecode = &Apache::loncommon::get_env_multiple('form.uniquecode'); foreach my $type (@hasuniquecode) { if (grep(/^\Q$type\E$/,@crstypes)) { @@ -12339,7 +10950,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'}; @@ -12837,6 +11448,7 @@ sub modify_quotas { $resulttext .= '
    • '.&mt('Validated course requests identified as processed by: [_1]', ''.$changes{'validation'}{'dc'}.'').'
      • '; } + $resulttext .= '
    • '; } } } @@ -12874,14 +11486,11 @@ 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) = - &Apache::lonconfigsettings::publishlogo($r,'upload',$caller,$dom,$confname, - "$type/$cdom/$cnum/cover",$width,$height, - '',$modified); + &publishlogo($r,'upload',$caller,$dom,$confname, + "$type/$cdom/$cnum/cover",$width,$height); 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); } @@ -12894,1134 +11503,6 @@ sub process_textbook_image { return ($url,$error); } -sub modify_ltitools { - my ($r,$dom,$action,$lastactref,%domconfig) = @_; - 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 ($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}; - } - } - } - } - } - $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 ($toolserror) { - $errors = '
  • '.$toolserror.'
    • '; - } - if ((keys(%ltitoolschg) == 0) && (keys(%secchanges) == 0)) { - $resulttext = &mt('No changes made.'); - if ($errors) { - $resulttext .= '
    '.&mt('The following errors occurred: ').'
      '. - $errors.'
    '; - } - 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:').'
      '; - if (keys(%secchanges) > 0) { - $resulttext .= <i_security_results($dom,'ltitools',\%secchanges,\%newtoolsec,\%newkeyset,\%keystore); - } - if (keys(%ltitoolschg) > 0) { - $resulttext .= $ltitoolsoutput; - } - my $cachetime = 24*60*60; - &Apache::lonnet::do_cache_new('ltitools',$dom,\%newltitools,$cachetime); - if (ref($lastactref) eq 'HASH') { - $lastactref->{'ltitools'} = 1; - } - } else { - $errors .= '
    • '.&mt('Failed to save changes').'
      • '; - } - if ($errors) { - $resulttext .= '

      '.&mt('The following errors occurred: ').'

        '. - $errors.'

      '; - } - return $resulttext; -} - -sub fetch_secrets { - my ($dom,$context,$domconfig,$currsec,$secchanges,$newsec,$newkeyset) = @_; - my %keyset; - %{$currsec} = (); - $newsec->{'private'}{'keys'} = []; - $newsec->{'encrypt'} = {}; - $newsec->{'rules'} = {}; - if ($context eq 'ltisec') { - $newsec->{'linkprot'} = {}; - } - if (ref($domconfig->{$context}) eq 'HASH') { - %{$currsec} = %{$domconfig->{$context}}; - if ($context eq 'ltisec') { - if (ref($currsec->{'linkprot'}) eq 'HASH') { - foreach my $id (keys(%{$currsec->{'linkprot'}})) { - unless ($id =~ /^\d+$/) { - delete($currsec->{'linkprot'}{$id}); - } - } - } - } - if (ref($currsec->{'private'}) eq 'HASH') { - if (ref($currsec->{'private'}{'keys'}) eq 'ARRAY') { - $newsec->{'private'}{'keys'} = $currsec->{'private'}{'keys'}; - map { $keyset{$_} = 1; } @{$currsec->{'private'}{'keys'}}; - } - } - } - my @items= ('crs','dom'); - if ($context eq 'ltisec') { - push(@items,'consumers'); - } - foreach my $item (@items) { - my $formelement; - if (($context eq 'toolsec') || ($item eq 'consumers')) { - $formelement = 'form.'.$context.'_'.$item; - } else { - $formelement = 'form.'.$context.'_'.$item.'linkprot'; - } - if ($env{$formelement}) { - $newsec->{'encrypt'}{$item} = 1; - if (ref($currsec->{'encrypt'}) eq 'HASH') { - unless ($currsec->{'encrypt'}{$item}) { - $secchanges->{'encrypt'} = 1; - } - } else { - $secchanges->{'encrypt'} = 1; - } - } elsif (ref($currsec->{'encrypt'}) eq 'HASH') { - if ($currsec->{'encrypt'}{$item}) { - $secchanges->{'encrypt'} = 1; - } - } - } - my $secrets; - if ($context eq 'ltisec') { - $secrets = 'ltisecrets'; - } else { - $secrets = 'toolsecrets'; - } - unless (exists($currsec->{'rules'})) { - $currsec->{'rules'} = {}; - } - &password_rule_changes($secrets,$newsec->{'rules'},$currsec->{'rules'},$secchanges); - - my @ids=&Apache::lonnet::current_machine_ids(); - my %servers = &Apache::lonnet::get_servers($dom,'library'); - - foreach my $hostid (keys(%servers)) { - if (($hostid ne '') && (grep(/^\Q$hostid\E$/,@ids))) { - my $keyitem = 'form.'.$context.'_privkey_'.$hostid; - if (exists($env{$keyitem})) { - $env{$keyitem} =~ s/(`)/'/g; - if ($keyset{$hostid}) { - if ($env{'form.'.$context.'_changeprivkey_'.$hostid}) { - if ($env{$keyitem} ne '') { - $secchanges->{'private'} = 1; - $newkeyset->{$hostid} = $env{$keyitem}; - } - } - } elsif ($env{$keyitem} ne '') { - unless (grep(/^\Q$hostid\E$/,@{$newsec->{'private'}{'keys'}})) { - push(@{$newsec->{'private'}{'keys'}},$hostid); - } - $secchanges->{'private'} = 1; - $newkeyset->{$hostid} = $env{$keyitem}; - } - } - } - } -} - -sub store_security { - my ($dom,$context,$secchanges,$newkeyset,$keystore) = @_; - return unless ((ref($secchanges) eq 'HASH') && (ref($newkeyset) eq 'HASH') && - (ref($keystore) eq 'HASH')); - if (keys(%{$secchanges})) { - if ($secchanges->{'private'}) { - my $who = &escape($env{'user.name'}.':'.$env{'user.domain'}); - foreach my $hostid (keys(%{$newkeyset})) { - my $storehash = { - key => $newkeyset->{$hostid}, - who => $env{'user.name'}.':'.$env{'user.domain'}, - }; - $keystore->{$hostid} = &Apache::lonnet::store_dom($storehash,$context,'private', - $dom,$hostid); - } - } - } -} - -sub lti_security_results { - my ($dom,$context,$secchanges,$newsec,$newkeyset,$keystore) = @_; - my $output; - my %domdefaults = &Apache::lonnet::get_domain_defaults($dom); - my $needs_update; - foreach my $item (keys(%{$secchanges})) { - if ($item eq 'encrypt') { - $needs_update = 1; - my %encrypted; - if ($context eq 'lti') { - %encrypted = ( - crs => { - on => &mt('Encryption of stored link protection secrets defined in courses enabled'), - off => &mt('Encryption of stored link protection secrets defined in courses disabled'), - }, - dom => { - on => &mt('Encryption of stored link protection secrets defined in domain enabled'), - off => &mt('Encryption of stored link protection secrets defined in domain disabled'), - }, - consumers => { - on => &mt('Encryption of stored consumer secrets defined in domain enabled'), - off => &mt('Encryption of stored consumer secrets defined in domain disabled'), - }, - ); - } else { - %encrypted = ( - crs => { - on => &mt('Encryption of stored external tool secrets defined in courses enabled'), - off => &mt('Encryption of stored external tool secrets defined in courses disabled'), - }, - dom => { - on => &mt('Encryption of stored external tool secrets defined in domain enabled'), - off => &mt('Encryption of stored external tool secrets defined in domain disabled'), - }, - ); - - } - my @types= ('crs','dom'); - if ($context eq 'lti') { - foreach my $type (@types) { - undef($domdefaults{'linkprotenc_'.$type}); - } - push(@types,'consumers'); - undef($domdefaults{'ltienc_consumers'}); - } elsif ($context eq 'ltitools') { - foreach my $type (@types) { - undef($domdefaults{'toolenc_'.$type}); - } - } - foreach my $type (@types) { - my $shown = $encrypted{$type}{'off'}; - if (ref($newsec->{$item}) eq 'HASH') { - if ($newsec->{$item}{$type}) { - if ($context eq 'lti') { - if ($type eq 'consumers') { - $domdefaults{'ltienc_consumers'} = 1; - } else { - $domdefaults{'linkprotenc_'.$type} = 1; - } - } elsif ($context eq 'ltitools') { - $domdefaults{'toolenc_'.$type} = 1; - } - $shown = $encrypted{$type}{'on'}; - } - } - $output .= '
    • '.$shown.'
      • '; - } - } elsif ($item eq 'rules') { - my %titles = &Apache::lonlocal::texthash( - min => 'Minimum password length', - max => 'Maximum password length', - chars => 'Required characters', - ); - foreach my $rule ('min','max') { - if ($newsec->{rules}{$rule} eq '') { - if ($rule eq 'min') { - $output .= '
    • '.&mt('[_1] not set.',$titles{$rule}); - ' '.&mt('Default of [_1] will be used', - $Apache::lonnet::passwdmin).'
      • '; - } else { - $output .= '
    • '.&mt('[_1] set to none',$titles{$rule}).'
      • '; - } - } else { - $output .= '
    • '.&mt('[_1] set to [_2]',$titles{$rule},$newsec->{rules}{$rule}).'
      • '; - } - } - if (ref($newsec->{'rules'}{'chars'}) eq 'ARRAY') { - if (@{$newsec->{'rules'}{'chars'}} > 0) { - my %rulenames = &Apache::lonlocal::texthash( - uc => 'At least one upper case letter', - lc => 'At least one lower case letter', - num => 'At least one number', - spec => 'At least one non-alphanumeric', - ); - my $needed = '
      • '. - join('
      • ',map {$rulenames{$_} } @{$newsec->{'rules'}{'chars'}}). - '
      '; - $output .= '
    • '.&mt('[_1] set to: [_2]',$titles{'chars'},$needed).'
      • '; - } else { - $output .= '
    • '.&mt('[_1] set to none',$titles{'chars'}).'
      • '; - } - } else { - $output .= '
    • '.&mt('[_1] set to none',$titles{'chars'}).'
      • '; - } - } elsif ($item eq 'private') { - $needs_update = 1; - if ($context eq 'lti') { - undef($domdefaults{'ltiprivhosts'}); - } elsif ($context eq 'ltitools') { - undef($domdefaults{'toolprivhosts'}); - } - if (keys(%{$newkeyset})) { - my @privhosts; - foreach my $hostid (sort(keys(%{$newkeyset}))) { - if ($keystore->{$hostid} eq 'ok') { - $output .= '
    • '.&mt('Encryption key for storage of shared secrets saved for [_1]',$hostid).'
      • '; - unless (grep(/^\Q$hostid\E$/,@privhosts)) { - push(@privhosts,$hostid); - } - } - } - if (@privhosts) { - if ($context eq 'lti') { - $domdefaults{'ltiprivhosts'} = \@privhosts; - } elsif ($context eq 'ltitools') { - $domdefaults{'toolprivhosts'} = \@privhosts; - } - } - } - } elsif ($item eq 'linkprot') { - next; - } - } - if ($needs_update) { - my $cachetime = 24*60*60; - &Apache::lonnet::do_cache_new('domdefaults',$dom,\%domdefaults,$cachetime); - } - return $output; -} - -sub modify_lti { - my ($r,$dom,$action,$lastactref,%domconfig) = @_; - my %domdefaults = &Apache::lonnet::get_domain_defaults($dom,1); - my ($newid,@allpos,%changes,%confhash,%ltienc,$errors,$resulttext); - my (%posslti,%posslticrs,%posscrstype); - my @courseroles = ('cc','in','ta','ep','st'); - my @ltiroles = qw(Learner Instructor ContentDeveloper TeachingAssistant Mentor Member Manager Administrator); - my @lticourseroles = qw(Instructor TeachingAssistant Mentor Learner); - my @coursetypes = ('official','unofficial','community','textbook','placement','lti'); - my %coursetypetitles = &Apache::lonlocal::texthash ( - official => 'Official', - unofficial => 'Unofficial', - community => 'Community', - textbook => 'Textbook', - placement => 'Placement Test', - lti => 'LTI Provider', - ); - my %fieldtitles = &Apache::loncommon::personal_data_fieldtitles(); - my %lt = <i_names(); - map { $posslti{$_} = 1; } @ltiroles; - map { $posslticrs{$_} = 1; } @lticourseroles; - map { $posscrstype{$_} = 1; } @coursetypes; - - my %menutitles = <imenu_titles(); - my (%currltisec,%secchanges,%newltisec,%newltienc,%newkeyset); - - &fetch_secrets($dom,'ltisec',\%domconfig,\%currltisec,\%secchanges,\%newltisec,\%newkeyset); - - my (%linkprotchg,$linkprotoutput,$is_home); - my $proterror = &Apache::courseprefs::process_linkprot($dom,'',$currltisec{'linkprot'}, - \%linkprotchg,'domain'); - 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; } } - } - - if (keys(%linkprotchg)) { - $secchanges{'linkprot'} = 1; - my %oldlinkprot; - if (ref($currltisec{'linkprot'}) eq 'HASH') { - %oldlinkprot = %{$currltisec{'linkprot'}}; - } - foreach my $id (keys(%linkprotchg)) { - if (ref($linkprotchg{$id}) eq 'HASH') { - foreach my $inner (keys(%{$linkprotchg{$id}})) { - if (($inner eq 'secret') || ($inner eq 'key')) { - if ($is_home) { - $newltienc{$id}{$inner} = $linkprotchg{$id}{$inner}; - } - } - } - } else { - $newltisec{'linkprot'}{$id} = $linkprotchg{$id}; - } - } - $linkprotoutput = &Apache::courseprefs::store_linkprot($dom,'','domain',\%linkprotchg,\%oldlinkprot); - if (keys(%linkprotchg)) { - %{$newltisec{'linkprot'}} = %linkprotchg; - } - } - if (ref($currltisec{'linkprot'}) eq 'HASH') { - foreach my $id (%{$currltisec{'linkprot'}}) { - next if ($id !~ /^\d+$/); - unless (exists($linkprotchg{$id})) { - if (ref($currltisec{'linkprot'}{$id}) eq 'HASH') { - foreach my $inner (keys(%{$currltisec{'linkprot'}{$id}})) { - if (($inner eq 'secret') || ($inner eq 'key')) { - if ($is_home) { - $newltienc{$id}{$inner} = $currltisec{'linkprot'}{$id}{$inner}; - } - } else { - $newltisec{'linkprot'}{$id}{$inner} = $currltisec{'linkprot'}{$id}{$inner}; - } - } - } else { - $newltisec{'linkprot'}{$id} = $currltisec{'linkprot'}{$id}; - } - } - } - } - if ($proterror) { - $errors .= '
    • '.$proterror.'
      • '; - } - my (@items,%deletions,%itemids); - if ($env{'form.lti_add'}) { - my $consumer = $env{'form.lti_consumer_add'}; - $consumer =~ s/(`)/'/g; - ($newid,my $error) = &get_lti_id($dom,$consumer); - if ($newid) { - $itemids{'add'} = $newid; - push(@items,'add'); - $changes{$newid} = 1; - } else { - my $error = &mt('Failed to acquire unique ID for new LTI configuration'); - $errors .= '
    • '.$error.'
      • '; - } - } - if (ref($domconfig{$action}) eq 'HASH') { - my @todelete = &Apache::loncommon::get_env_multiple('form.lti_del'); - if (@todelete) { - map { $deletions{$_} = 1; } @todelete; - } - my $maxnum = $env{'form.lti_maxnum'}; - for (my $i=0; $i<$maxnum; $i++) { - my $itemid = $env{'form.lti_id_'.$i}; - $itemid =~ s/\D+//g; - if (ref($domconfig{$action}{$itemid}) eq 'HASH') { - if ($deletions{$itemid}) { - $changes{$itemid} = $domconfig{$action}{$itemid}{'consumer'}; - } else { - push(@items,$i); - $itemids{$i} = $itemid; - } - } - } - } - my (%keystore,$secstored); - if ($is_home) { - &store_security($dom,'lti',\%secchanges,\%newkeyset,\%keystore); - } - - my ($cipher,$privnum); - if ((@items > 0) && ($is_home)) { - ($cipher,$privnum) = &get_priv_creds($dom,$home,$secchanges{'encrypt'}, - $newltisec{'encrypt'},$keystore{$home}); - } - foreach my $idx (@items) { - my $itemid = $itemids{$idx}; - next unless ($itemid); - my %currlti; - unless ($idx eq 'add') { - if (ref($domconfig{$action}) eq 'HASH') { - if (ref($domconfig{$action}{$itemid}) eq 'HASH') { - %currlti = %{$domconfig{$action}{$itemid}}; - } - } - } - my $position = $env{'form.lti_pos_'.$itemid}; - $position =~ s/\D+//g; - if ($position ne '') { - $allpos[$position] = $itemid; - } - foreach my $item ('consumer','lifetime','requser','crsinc') { - my $formitem = 'form.lti_'.$item.'_'.$idx; - $env{$formitem} =~ s/(`)/'/g; - if ($item eq 'lifetime') { - $env{$formitem} =~ s/[^\d.]//g; - } - if ($env{$formitem} ne '') { - $confhash{$itemid}{$item} = $env{$formitem}; - unless (($idx eq 'add') || ($changes{$itemid})) { - if ($currlti{$item} ne $confhash{$itemid}{$item}) { - $changes{$itemid} = 1; - } - } - } - } - if ($env{'form.lti_version_'.$idx} eq 'LTI-1p0') { - $confhash{$itemid}{'version'} = $env{'form.lti_version_'.$idx}; - } - if ($confhash{$itemid}{'requser'}) { - if ($env{'form.lti_mapuser_'.$idx} eq 'sourcedid') { - $confhash{$itemid}{'mapuser'} = 'lis_person_sourcedid'; - } elsif ($env{'form.lti_mapuser_'.$idx} eq 'email') { - $confhash{$itemid}{'mapuser'} = 'lis_person_contact_email_primary'; - } elsif ($env{'form.lti_mapuser_'.$idx} eq 'other') { - my $mapuser = $env{'form.lti_customuser_'.$idx}; - $mapuser =~ s/(`)/'/g; - $mapuser =~ s/^\s+|\s+$//g; - $confhash{$itemid}{'mapuser'} = $mapuser; - } - my @possmakeuser = &Apache::loncommon::get_env_multiple('form.lti_makeuser_'.$idx); - my @makeuser; - foreach my $ltirole (sort(@possmakeuser)) { - if ($posslti{$ltirole}) { - push(@makeuser,$ltirole); - } - } - $confhash{$itemid}{'makeuser'} = \@makeuser; - if (@makeuser) { - my $lcauth = $env{'form.lti_lcauth_'.$idx}; - if ($lcauth =~ /^(internal|krb4|krb5|localauth)$/) { - $confhash{$itemid}{'lcauth'} = $lcauth; - if ($lcauth ne 'internal') { - my $lcauthparm = $env{'form.lti_lcauthparm_'.$idx}; - $lcauthparm =~ s/^(\s+|\s+)$//g; - $lcauthparm =~ s/`//g; - if ($lcauthparm ne '') { - $confhash{$itemid}{'lcauthparm'} = $lcauthparm; - } - } - } else { - $confhash{$itemid}{'lcauth'} = 'lti'; - } - } - my @possinstdata = &Apache::loncommon::get_env_multiple('form.lti_instdata_'.$idx); - if (@possinstdata) { - foreach my $field (@possinstdata) { - if (exists($fieldtitles{$field})) { - push(@{$confhash{$itemid}{'instdata'}}); - } - } - } - if ($env{'form.lti_callback_'.$idx}) { - if ($env{'form.lti_callbackparam_'.$idx}) { - my $callback = $env{'form.lti_callbackparam_'.$idx}; - $callback =~ s/^\s+|\s+$//g; - $confhash{$itemid}{'callback'} = $callback; - } - } - foreach my $field ('topmenu','inlinemenu') { - if ($env{'form.lti_'.$field.'_'.$idx}) { - $confhash{$itemid}{$field} = 1; - } - } - if ($env{'form.lti_topmenu_'.$idx} || $env{'form.lti_inlinemenu_'.$idx}) { - $confhash{$itemid}{lcmenu} = []; - my @possmenu = &Apache::loncommon::get_env_multiple('form.lti_menuitem_'.$idx); - foreach my $field (@possmenu) { - if (exists($menutitles{$field})) { - if ($field eq 'grades') { - next unless ($env{'form.lti_inlinemenu_'.$idx}); - } - push(@{$confhash{$itemid}{lcmenu}},$field); - } - } - } - if ($confhash{$itemid}{'crsinc'}) { - if (($env{'form.lti_mapcrs_'.$idx} eq 'course_offering_sourcedid') || - ($env{'form.lti_mapcrs_'.$idx} eq 'context_id')) { - $confhash{$itemid}{'mapcrs'} = $env{'form.lti_mapcrs_'.$idx}; - } elsif ($env{'form.lti_mapcrs_'.$idx} eq 'other') { - my $mapcrs = $env{'form.lti_mapcrsfield_'.$idx}; - $mapcrs =~ s/(`)/'/g; - $mapcrs =~ s/^\s+|\s+$//g; - $confhash{$itemid}{'mapcrs'} = $mapcrs; - } - my @posstypes = &Apache::loncommon::get_env_multiple('form.lti_mapcrstype_'.$idx); - my @crstypes; - foreach my $type (sort(@posstypes)) { - if ($posscrstype{$type}) { - push(@crstypes,$type); - } - } - $confhash{$itemid}{'mapcrstype'} = \@crstypes; - if ($env{'form.lti_storecrs_'.$idx}) { - $confhash{$itemid}{'storecrs'} = 1; - } - if ($env{'form.lti_makecrs_'.$idx}) { - $confhash{$itemid}{'makecrs'} = 1; - } - foreach my $ltirole (@lticourseroles) { - my $possrole = $env{'form.lti_maprole_'.$ltirole.'_'.$idx}; - if (grep(/^\Q$possrole\E$/,@courseroles)) { - $confhash{$itemid}{'maproles'}{$ltirole} = $possrole; - } - } - my @possenroll = &Apache::loncommon::get_env_multiple('form.lti_selfenroll_'.$idx); - my @selfenroll; - foreach my $type (sort(@possenroll)) { - if ($posslticrs{$type}) { - push(@selfenroll,$type); - } - } - $confhash{$itemid}{'selfenroll'} = \@selfenroll; - if ($env{'form.lti_crssec_'.$idx}) { - if ($env{'form.lti_crssecsrc_'.$idx} eq 'course_section_sourcedid') { - $confhash{$itemid}{'section'} = $env{'form.lti_crssecsrc_'.$idx}; - } elsif ($env{'form.lti_crssecsrc_'.$idx} eq 'other') { - my $section = $env{'form.lti_customsection_'.$idx}; - $section =~ s/(`)/'/g; - $section =~ s/^\s+|\s+$//g; - if ($section ne '') { - $confhash{$itemid}{'section'} = $section; - } - } - } - foreach my $field ('passback','roster') { - if ($env{'form.lti_'.$field.'_'.$idx}) { - $confhash{$itemid}{$field} = 1; - } - } - if ($env{'form.lti_passback_'.$idx}) { - if ($env{'form.lti_passbackformat_'.$idx} eq '1.0') { - $confhash{$itemid}{'passbackformat'} = '1.0'; - } else { - $confhash{$itemid}{'passbackformat'} = '1.1'; - } - } - } - unless (($idx eq 'add') || ($changes{$itemid})) { - if ($confhash{$itemid}{'crsinc'}) { - foreach my $field ('mapcrs','storecrs','makecrs','section','passback','roster') { - if ($currlti{$field} ne $confhash{$itemid}{$field}) { - $changes{$itemid} = 1; - } - } - unless ($changes{$itemid}) { - if ($currlti{'passback'} eq $confhash{$itemid}{'passback'}) { - if ($currlti{'passbackformat'} ne $confhash{$itemid}{'passbackformat'}) { - $changes{$itemid} = 1; - } - } - } - foreach my $field ('mapcrstype','selfenroll') { - unless ($changes{$itemid}) { - if (ref($currlti{$field}) eq 'ARRAY') { - if (ref($confhash{$itemid}{$field}) eq 'ARRAY') { - my @diffs = &Apache::loncommon::compare_arrays($currlti{$field}, - $confhash{$itemid}{$field}); - if (@diffs) { - $changes{$itemid} = 1; - } - } elsif (@{$currlti{$field}} > 0) { - $changes{$itemid} = 1; - } - } elsif (ref($confhash{$itemid}{$field}) eq 'ARRAY') { - if (@{$confhash{$itemid}{$field}} > 0) { - $changes{$itemid} = 1; - } - } - } - } - unless ($changes{$itemid}) { - if (ref($currlti{'maproles'}) eq 'HASH') { - if (ref($confhash{$itemid}{'maproles'}) eq 'HASH') { - foreach my $ltirole (keys(%{$currlti{'maproles'}})) { - if ($currlti{'maproles'}{$ltirole} ne - $confhash{$itemid}{'maproles'}{$ltirole}) { - $changes{$itemid} = 1; - last; - } - } - unless ($changes{$itemid}) { - foreach my $ltirole (keys(%{$confhash{$itemid}{'maproles'}})) { - if ($confhash{$itemid}{'maproles'}{$ltirole} ne - $currlti{'maproles'}{$ltirole}) { - $changes{$itemid} = 1; - last; - } - } - } - } elsif (keys(%{$currlti{'maproles'}}) > 0) { - $changes{$itemid} = 1; - } - } elsif (ref($confhash{$itemid}{'maproles'}) eq 'HASH') { - unless ($changes{$itemid}) { - if (keys(%{$confhash{$itemid}{'maproles'}}) > 0) { - $changes{$itemid} = 1; - } - } - } - } - } - unless ($changes{$itemid}) { - foreach my $field ('mapuser','lcauth','lcauthparm','topmenu','inlinemenu','callback') { - if ($currlti{$field} ne $confhash{$itemid}{$field}) { - $changes{$itemid} = 1; - } - } - unless ($changes{$itemid}) { - foreach my $field ('makeuser','lcmenu') { - if (ref($currlti{$field}) eq 'ARRAY') { - if (ref($confhash{$itemid}{$field}) eq 'ARRAY') { - my @diffs = &Apache::loncommon::compare_arrays($currlti{$field}, - $confhash{$itemid}{$field}); - if (@diffs) { - $changes{$itemid} = 1; - } - } elsif (@{$currlti{$field}} > 0) { - $changes{$itemid} = 1; - } - } elsif (ref($confhash{$itemid}{$field}) eq 'ARRAY') { - if (@{$confhash{$itemid}{$field}} > 0) { - $changes{$itemid} = 1; - } - } - } - } - } - } - } - if ($is_home) { - my $keyitem = 'form.lti_key_'.$idx; - $env{$keyitem} =~ s/(`)/'/g; - if ($env{$keyitem} ne '') { - $ltienc{$itemid}{'key'} = $env{$keyitem}; - unless ($changes{$itemid}) { - if ($currlti{'key'} ne $env{$keyitem}) { - $changes{$itemid} = 1; - } - } - } - my $secretitem = 'form.lti_secret_'.$idx; - $env{$secretitem} =~ s/(`)/'/g; - if ($currlti{'usable'}) { - if ($env{'form.lti_changesecret_'.$idx}) { - if ($env{$secretitem} ne '') { - if ($privnum && $cipher) { - $ltienc{$itemid}{'secret'} = $cipher->encrypt_hex($env{$secretitem}); - $confhash{$itemid}{'cipher'} = $privnum; - } else { - $ltienc{$itemid}{'secret'} = $env{$secretitem}; - } - $changes{$itemid} = 1; - } - } else { - $ltienc{$itemid}{'secret'} = $currlti{'secret'}; - $confhash{$itemid}{'cipher'} = $currlti{'cipher'}; - } - if (ref($ltienc{$itemid}) eq 'HASH') { - if (($ltienc{$itemid}{'key'} ne '') && ($ltienc{$itemid}{'secret'} ne '')) { - $confhash{$itemid}{'usable'} = 1; - } - } - } elsif ($env{$secretitem} ne '') { - if ($privnum && $cipher) { - $ltienc{$itemid}{'secret'} = $cipher->encrypt_hex($env{$secretitem}); - $confhash{$itemid}{'cipher'} = $privnum; - } else { - $ltienc{$itemid}{'secret'} = $env{$secretitem}; - } - if (ref($ltienc{$itemid}) eq 'HASH') { - if (($ltienc{$itemid}{'key'} ne '') && ($ltienc{$itemid}{'key'} ne '')) { - $confhash{$itemid}{'usable'} = 1; - } - } - $changes{$itemid} = 1; - } - } - unless ($changes{$itemid}) { - foreach my $key (keys(%currlti)) { - if (ref($currlti{$key}) eq 'HASH') { - if (ref($confhash{$itemid}{$key}) eq 'HASH') { - foreach my $innerkey (keys(%{$currlti{$key}})) { - unless (exists($confhash{$itemid}{$key}{$innerkey})) { - $changes{$itemid} = 1; - last; - } - } - } elsif (keys(%{$currlti{$key}}) > 0) { - $changes{$itemid} = 1; - } - } - last if ($changes{$itemid}); - } - } - } - if (@allpos > 0) { - my $idx = 0; - foreach my $itemid (@allpos) { - if ($itemid ne '') { - $confhash{$itemid}{'order'} = $idx; - if (ref($domconfig{$action}) eq 'HASH') { - if (ref($domconfig{$action}{$itemid}) eq 'HASH') { - if ($domconfig{$action}{$itemid}{'order'} ne $idx) { - $changes{$itemid} = 1; - } - } - } - $idx ++; - } - } - } - - if ((keys(%changes) == 0) && (keys(%secchanges) == 0)) { - return &mt('No changes made.'); - } - - my %ltihash = ( - $action => { %confhash } - ); - my %ltienchash; - - if ($is_home) { - %ltienchash = ( - $action => { %ltienc } - ); - } - if (keys(%secchanges)) { - $ltihash{'ltisec'} = \%newltisec; - if ($secchanges{'linkprot'}) { - if ($is_home) { - $ltienchash{'linkprot'} = \%newltienc; - } - } - } - my $putresult = &Apache::lonnet::put_dom('configuration',\%ltihash,$dom); - if ($putresult eq 'ok') { - if (keys(%ltienchash)) { - &Apache::lonnet::put_dom('encconfig',\%ltienchash,$dom,undef,1); - } - $resulttext = &mt('Changes made:').'
        '; - if (keys(%secchanges) > 0) { - $resulttext .= <i_security_results($dom,'lti',\%secchanges,\%newltisec,\%newkeyset,\%keystore); - if (exists($secchanges{'linkprot'})) { - $resulttext .= $linkprotoutput; - } - } - if (keys(%changes) > 0) { - my $cachetime = 24*60*60; - &Apache::lonnet::do_cache_new('lti',$dom,\%confhash,$cachetime); - if (ref($lastactref) eq 'HASH') { - $lastactref->{'lti'} = 1; - } - my %bynum; - foreach my $itemid (sort(keys(%changes))) { - if (ref($confhash{$itemid}) eq 'HASH') { - my $position = $confhash{$itemid}{'order'}; - $bynum{$position} = $itemid; - } - } - foreach my $pos (sort { $a <=> $b } keys(%bynum)) { - my $itemid = $bynum{$pos}; - if (ref($confhash{$itemid}) eq 'HASH') { - $resulttext .= '
      • '.$confhash{$itemid}{'consumer'}.'
          '; - my $position = $pos + 1; - $resulttext .= '
        • '.&mt('Order: [_1]',$position).'
          • '; - foreach my $item ('version','lifetime') { - if ($confhash{$itemid}{$item} ne '') { - $resulttext .= '
        • '.$lt{$item}.': '.$confhash{$itemid}{$item}.'
          • '; - } - } - if ($ltienc{$itemid}{'key'} ne '') { - $resulttext .= '
        • '.$lt{'key'}.': '.$ltienc{$itemid}{'key'}.'
          • '; - } - if ($ltienc{$itemid}{'secret'} ne '') { - $resulttext .= '
        • '.$lt{'secret'}.': ['.&mt('not shown').']
          • '; - } - if ($confhash{$itemid}{'requser'}) { - if ($confhash{$itemid}{'callback'}) { - $resulttext .= '
        • '.&mt('Callback setting').': '.$confhash{$itemid}{'callback'}.'
          • '; - } else { - $resulttext .= '
        • '.&mt('Callback to logout LON-CAPA on log out from Consumer').'
          • '; - } - if ($confhash{$itemid}{'mapuser'}) { - my $shownmapuser; - if ($confhash{$itemid}{'mapuser'} eq 'lis_person_sourcedid') { - $shownmapuser = $lt{'sourcedid'}.' (lis_person_sourcedid)'; - } elsif ($confhash{$itemid}{'mapuser'} eq 'lis_person_contact_email_primary') { - $shownmapuser = $lt{'email'}.' (lis_person_contact_email_primary)'; - } else { - $shownmapuser = &mt('Other').' ('.$confhash{$itemid}{'mapuser'}.')'; - } - $resulttext .= '
        • '.&mt('LON-CAPA username').': '.$shownmapuser.'
          • '; - } - if (ref($confhash{$itemid}{'makeuser'}) eq 'ARRAY') { - if (@{$confhash{$itemid}{'makeuser'}} > 0) { - $resulttext .= '
        • '.&mt('Following roles may create user accounts: [_1]', - join(', ',@{$confhash{$itemid}{'makeuser'}})).'
          '; - if ($confhash{$itemid}{'lcauth'} eq 'lti') { - $resulttext .= &mt('New users will only be able to authenticate via LTI').'
          • '; - } else { - $resulttext .= &mt('New users will be assigned LON-CAPA authentication: [_1]', - $confhash{$itemid}{'lcauth'}); - if ($confhash{$itemid}{'lcauth'} eq 'internal') { - $resulttext .= '; '.&mt('a randomly generated password will be created'); - } elsif ($confhash{$itemid}{'lcauth'} eq 'localauth') { - if ($confhash{$itemid}{'lcauthparm'} ne '') { - $resulttext .= ' '.&mt('with argument: [_1]',$confhash{$itemid}{'lcauthparm'}); - } - } else { - $resulttext .= '; '.&mt('Kerberos domain: [_1]',$confhash{$itemid}{'lcauthparm'}); - } - } - $resulttext .= ''; - } else { - $resulttext .= '
        • '.&mt('User account creation not permitted.').'
          • '; - } - } - if (ref($confhash{$itemid}{'instdata'}) eq 'ARRAY') { - if (@{$confhash{$itemid}{'instdata'}} > 0) { - $resulttext .= '
        • '.&mt('Institutional data will be used when creating a new user for: [_1]', - join(', ',map { $fieldtitles{$_}; } @{$confhash{$itemid}{'instdata'}})).'
          • '; - } else { - $resulttext .= '
        • '.&mt('No institutional data used when creating a new user.').'
          • '; - } - } - foreach my $item ('topmenu','inlinemenu') { - $resulttext .= '
        • '.$lt{$item}.': '; - if ($confhash{$itemid}{$item}) { - $resulttext .= &mt('Yes'); - } else { - $resulttext .= &mt('No'); - } - $resulttext .= '
          • '; - } - if (ref($confhash{$itemid}{'lcmenu'}) eq 'ARRAY') { - if (@{$confhash{$itemid}{'lcmenu'}} > 0) { - $resulttext .= '
        • '.&mt('Menu items:').' '. - join(', ', map { $menutitles{$_}; } (@{$confhash{$itemid}{'lcmenu'}})).'
          • '; - } else { - $resulttext .= '
        • '.&mt('No menu items displayed in header or online menu').'
          • '; - } - } - if ($confhash{$itemid}{'crsinc'}) { - if (ref($confhash{$itemid}{'maproles'}) eq 'HASH') { - my $rolemaps; - foreach my $role (@ltiroles) { - if ($confhash{$itemid}{'maproles'}{$role}) { - $rolemaps .= (' 'x2).$role.'='. - &Apache::lonnet::plaintext($confhash{$itemid}{'maproles'}{$role}, - 'Course').','; - } - } - if ($rolemaps) { - $rolemaps =~ s/,$//; - $resulttext .= '
        • '.&mt('Role mapping:').$rolemaps.'
          • '; - } - } - if ($confhash{$itemid}{'mapcrs'}) { - $resulttext .= '
        • '.&mt('Unique course identifier').': '.$confhash{$itemid}{'mapcrs'}.'
          • '; - } - if (ref($confhash{$itemid}{'mapcrstype'}) eq 'ARRAY') { - if (@{$confhash{$itemid}{'mapcrstype'}} > 0) { - $resulttext .= '
        • '.&mt('Mapping for the following LON-CAPA course types: [_1]', - join(', ',map { $coursetypetitles{$_}; } @coursetypes)). - '
          • '; - } else { - $resulttext .= '
        • '.&mt('No mapping to LON-CAPA courses').'
          • '; - } - } - if ($confhash{$itemid}{'storecrs'}) { - $resulttext .= '
        • '.&mt('Store mapping of course identifier to LON-CAPA CourseID').': '.$confhash{$itemid}{'storecrs'}.'
          • '; - } - if ($confhash{$itemid}{'makecrs'}) { - $resulttext .= '
        • '.&mt('Instructor may create course (if absent).').'
          • '; - } else { - $resulttext .= '
        • '.&mt('Instructor may not create course (if absent).').'
          • '; - } - if (ref($confhash{$itemid}{'selfenroll'}) eq 'ARRAY') { - if (@{$confhash{$itemid}{'selfenroll'}} > 0) { - $resulttext .= '
        • '.&mt('Self-enrollment for following roles: [_1]', - join(', ',@{$confhash{$itemid}{'selfenroll'}})). - '
          • '; - } else { - $resulttext .= '
        • '.&mt('Self-enrollment not permitted').'
          • '; - } - } - if ($confhash{$itemid}{'section'}) { - if ($confhash{$itemid}{'section'} eq 'course_section_sourcedid') { - $resulttext .= '
        • '.&mt('User section from standard field:'). - ' (course_section_sourcedid)'.'
          • '; - } else { - $resulttext .= '
        • '.&mt('User section from:').' '. - $confhash{$itemid}{'section'}.'
          • '; - } - } else { - $resulttext .= '
        • '.&mt('No section assignment').'
          • '; - } - foreach my $item ('passback','roster','topmenu','inlinemenu') { - $resulttext .= '
        • '.$lt{$item}.': '; - if ($confhash{$itemid}{$item}) { - $resulttext .= &mt('Yes'); - if ($item eq 'passback') { - if ($confhash{$itemid}{'passbackformat'} eq '1.0') { - $resulttext .= ' ('.&mt('Outcomes Extension (1.0)').')'; - } elsif ($confhash{$itemid}{'passbackformat'} eq '1.1') { - $resulttext .= ' ('.&mt('Outcomes Service (1.1)').')'; - } - } - } else { - $resulttext .= &mt('No'); - } - $resulttext .= '
          • '; - } - if (ref($confhash{$itemid}{'lcmenu'}) eq 'ARRAY') { - if (@{$confhash{$itemid}{'lcmenu'}} > 0) { - $resulttext .= '
        • '.&mt('Menu items:').' '. - join(', ', map { $menutitles{$_}; } (@{$confhash{$itemid}{'lcmenu'}})).'
          • '; - } else { - $resulttext .= '
        • '.&mt('No menu items displayed in header or online menu').'
          • '; - } - } - } - } - $resulttext .= '
        • '; - } - } - if (keys(%deletions)) { - foreach my $itemid (sort { $a <=> $b } keys(%deletions)) { - $resulttext .= '
      • '.&mt('Deleted: [_1]',$changes{$itemid}).'
        • '; - } - } - } - $resulttext .= '
      '; - if (ref($lastactref) eq 'HASH') { - if (($secchanges{'encrypt'}) || ($secchanges{'private'})) { - $lastactref->{'domdefaults'} = 1; - } - } - } else { - $errors .= '
    • '.&mt('Failed to save changes').'
      • '; - } - if ($errors) { - $resulttext .= &mt('The following errors occurred: ').'
        '. - $errors.'
      '; - } - return $resulttext; -} - -sub get_priv_creds { - my ($dom,$home,$encchg,$encrypt,$storedsec) = @_; - my ($needenc,$cipher,$privnum); - my %domdefs = &Apache::lonnet::get_domain_defaults($dom); - if (($encchg) && (ref($encrypt) eq 'HASH')) { - $needenc = $encrypt->{'consumers'} - } else { - $needenc = $domdefs{'ltienc_consumers'}; - } - if ($needenc) { - if (($storedsec eq 'ok') || ((ref($domdefs{'ltiprivhosts'}) eq 'ARRAY') && - (grep(/^\Q$home\E$/,@{$domdefs{'ltiprivhosts'}})))) { - my %privhash = &Apache::lonnet::restore_dom('lti','private',$dom,$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 get_lti_id { - my ($domain,$consumer) = @_; - # get lock on lti db - my $lockhash = { - lock => $env{'user.name'}. - ':'.$env{'user.domain'}, - }; - my $tries = 0; - my $gotlock = &Apache::lonnet::newput_dom('lti',$lockhash,$domain); - my ($id,$error); - - while (($gotlock ne 'ok') && ($tries<10)) { - $tries ++; - sleep (0.1); - $gotlock = &Apache::lonnet::newput_dom('lti',$lockhash,$domain); - } - if ($gotlock eq 'ok') { - my %currids = &Apache::lonnet::dump_dom('lti',$domain); - 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) { - unless (&Apache::lonnet::newput_dom('lti',{ $id => $consumer },$domain) eq 'ok') { - $error = 'nostore'; - } - } else { - $error = 'nonumber'; - } - } - my $dellockoutcome = &Apache::lonnet::del_dom('lti',['lock'],$domain); - } else { - $error = 'nolock'; - } - return ($id,$error); -} - sub modify_autoenroll { my ($dom,$lastactref,%domconfig) = @_; my ($resulttext,%changes); @@ -14781,7 +12262,7 @@ sub modify_contacts { $contacts_hash{'contacts'}{'overrides'}{$type}{'include'} = $includeloc{$type}.':'.&escape($includestr{$type}); $newsetting{'override_'.$type}{'include'} = $contacts_hash{'contacts'}{'overrides'}{$type}{'include'}; } - } + } } } if (keys(%currsetting) > 0) { @@ -15231,7 +12712,7 @@ sub modify_contacts { } } else { $resulttext = ''. - &mt('An error occurred: [_1]',$putresult).''; + &mt('An error occurred: [_1].',$putresult).''; } return $resulttext; } @@ -15403,6 +12884,7 @@ sub modify_passwords { } if ($env{'form.passwords_customfile.filename'} ne '') { my $servadm = $r->dir_config('lonAdmEMail'); + my $servadm = $r->dir_config('lonAdmEMail'); my ($configuserok,$author_ok,$switchserver) = &config_check($dom,$confname,$servadm); my $error; @@ -15411,15 +12893,12 @@ sub modify_passwords { $error = &mt("Upload of file containing domain-specific text is not permitted to this server: [_1]",$switchserver); } else { if ($author_ok eq 'ok') { - my $modified = []; my ($result,$customurl) = - &Apache::lonconfigsettings::publishlogo($r,'upload','passwords_customfile',$dom, - $confname,'customtext/resetpw','','',$customfn, - $modified); + &publishlogo($r,'upload','passwords_customfile',$dom, + $confname,'customtext/resetpw','','',$customfn); if ($result eq 'ok') { $newvalues{'resetcustom'} = $customurl; $changes{'reset'} = 1; - &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].",$customfn,$result); } @@ -15472,7 +12951,56 @@ sub modify_passwords { $updatedefaults = 1; } } - &password_rule_changes('passwords',\%newvalues,\%current,\%changes); + foreach my $rule ('min','max','numsaved') { + $env{'form.passwords_'.$rule} =~ s/^\s+|\s+$//g; + my $ruleok; + if ($rule eq 'min') { + if ($env{'form.passwords_'.$rule} =~ /^\d+$/) { + if ($env{'form.passwords_'.$rule} >= $Apache::lonnet::passwdmin) { + $ruleok = 1; + } + } + } elsif (($env{'form.passwords_'.$rule} =~ /^\d+$/) && + ($env{'form.passwords_'.$rule} ne '0')) { + $ruleok = 1; + } + if ($ruleok) { + $newvalues{$rule} = $env{'form.passwords_'.$rule}; + if (exists($current{$rule})) { + if ($newvalues{$rule} ne $current{$rule}) { + $changes{'rules'} = 1; + } + } elsif ($rule eq 'min') { + if ($staticdefaults{$rule} ne $newvalues{$rule}) { + $changes{'rules'} = 1; + } + } else { + $changes{'rules'} = 1; + } + } elsif (exists($current{$rule})) { + $changes{'rules'} = 1; + } + } + my @posschars = &Apache::loncommon::get_env_multiple('form.passwords_chars'); + my @chars; + foreach my $item (sort(@posschars)) { + if ($item =~ /^(uc|lc|num|spec)$/) { + push(@chars,$item); + } + } + $newvalues{'chars'} = \@chars; + unless ($changes{'rules'}) { + if (ref($current{'chars'}) eq 'ARRAY') { + my @diffs = &Apache::loncommon::compare_arrays($current{'chars'},\@chars); + if (@diffs > 0) { + $changes{'rules'} = 1; + } + } else { + if (@chars > 0) { + $changes{'rules'} = 1; + } + } + } my %crsownerchg = ( by => [], for => [], @@ -15732,71 +13260,6 @@ sub modify_passwords { return $resulttext; } -sub password_rule_changes { - my ($prefix,$newvalues,$current,$changes) = @_; - return unless ((ref($newvalues) eq 'HASH') && - (ref($current) eq 'HASH') && - (ref($changes) eq 'HASH')); - my (@rules,%staticdefaults); - if ($prefix eq 'passwords') { - @rules = ('min','max','numsaved'); - } elsif (($prefix eq 'ltisecrets') || ($prefix eq 'toolsecrets')) { - @rules = ('min','max'); - } - $staticdefaults{'min'} = $Apache::lonnet::passwdmin; - foreach my $rule (@rules) { - $env{'form.'.$prefix.'_'.$rule} =~ s/^\s+|\s+$//g; - my $ruleok; - if ($rule eq 'min') { - if ($env{'form.'.$prefix.'_'.$rule} =~ /^\d+$/) { - if ($env{'form.'.$prefix.'_'.$rule} >= $staticdefaults{$rule}) { - $ruleok = 1; - } - } - } elsif (($env{'form.'.$prefix.'_'.$rule} =~ /^\d+$/) && - ($env{'form.'.$prefix.'_'.$rule} ne '0')) { - $ruleok = 1; - } - if ($ruleok) { - $newvalues->{$rule} = $env{'form.'.$prefix.'_'.$rule}; - if (exists($current->{$rule})) { - if ($newvalues->{$rule} ne $current->{$rule}) { - $changes->{'rules'} = 1; - } - } elsif ($rule eq 'min') { - if ($staticdefaults{$rule} ne $newvalues->{$rule}) { - $changes->{'rules'} = 1; - } - } else { - $changes->{'rules'} = 1; - } - } elsif (exists($current->{$rule})) { - $changes->{'rules'} = 1; - } - } - my @posschars = &Apache::loncommon::get_env_multiple('form.'.$prefix.'_chars'); - my @chars; - foreach my $item (sort(@posschars)) { - if ($item =~ /^(uc|lc|num|spec)$/) { - push(@chars,$item); - } - } - $newvalues->{'chars'} = \@chars; - unless ($changes->{'rules'}) { - if (ref($current->{'chars'}) eq 'ARRAY') { - my @diffs = &Apache::loncommon::compare_arrays($current->{'chars'},\@chars); - if (@diffs > 0) { - $changes->{'rules'} = 1; - } - } else { - if (@chars > 0) { - $changes->{'rules'} = 1; - } - } - } - return; -} - sub modify_usercreation { my ($dom,%domconfig) = @_; my ($resulttext,%curr_usercreation,%changes,%authallowed,%cancreate,%save_usercreate); @@ -15881,7 +13344,7 @@ sub modify_usercreation { } my @authen_contexts = ('author','course','domain'); - my @authtypes = ('int','krb4','krb5','loc','lti'); + my @authtypes = ('int','krb4','krb5','loc'); my %authhash; foreach my $item (@authen_contexts) { my @authallowed = &Apache::loncommon::get_env_multiple('form.'.$item.'_auth'); @@ -16096,6 +13559,7 @@ sub modify_selfcreation { # Populate $cancreate{'selfcreate'} array reference with types of user, for which self-creation of user accounts # is permitted. # + my ($emailrules,$emailruleorder) = &Apache::lonnet::inst_userrules($dom,'email'); my (@statuses,%email_rule); @@ -17073,7 +14537,7 @@ sub modify_defaults { my %domdefaults = &Apache::lonnet::get_domain_defaults($dom,1); my @items = ('auth_def','auth_arg_def','lang_def','timezone_def','datelocale_def', 'portal_def'); - my @authtypes = ('internal','krb4','krb5','localauth','lti'); + my @authtypes = ('internal','krb4','krb5','localauth'); foreach my $item (@items) { $newvalues{$item} = $env{'form.'.$item}; if ($item eq 'auth_def') { @@ -17110,58 +14574,16 @@ sub modify_defaults { } } elsif ($item eq 'portal_def') { if ($newvalues{$item} ne '') { - if ($newvalues{$item} =~ /^https?\:\/\/(([a-zA-Z0-9]|[a-zA-Z0-9][a-zA-Z0-9\-]*[a-zA-Z0-9])\.)*([A-Za-z]|[A-Za-z][A-Za-z0-9\-]*[A-Za-z0-9])\/?$/) { - foreach my $field ('email','web') { - if ($env{'form.'.$item.'_'.$field}) { - $newvalues{$item.'_'.$field} = $env{'form.'.$item.'_'.$field}; - } - } - } else { + unless ($newvalues{$item} =~ /^https?\:\/\/(([a-zA-Z0-9]|[a-zA-Z0-9][a-zA-Z0-9\-]*[a-zA-Z0-9])\.)*([A-Za-z]|[A-Za-z][A-Za-z0-9\-]*[A-Za-z0-9])\/?$/) { push(@errors,$item); } } } if (grep(/^\Q$item\E$/,@errors)) { $newvalues{$item} = $domdefaults{$item}; - if ($item eq 'portal_def') { - if ($domdefaults{$item}) { - foreach my $field ('email','web') { - if (exists($domdefaults{$item.'_'.$field})) { - $newvalues{$item.'_'.$field} = $domdefaults{$item.'_'.$field}; - } - } - } - } } elsif ($domdefaults{$item} ne $newvalues{$item}) { $changes{$item} = 1; } - if ($item eq 'portal_def') { - unless (grep(/^\Q$item\E$/,@errors)) { - if ($newvalues{$item} eq '') { - foreach my $field ('email','web') { - if (exists($domdefaults{$item.'_'.$field})) { - delete($domdefaults{$item.'_'.$field}); - } - } - } else { - unless ($changes{$item}) { - foreach my $field ('email','web') { - if ($domdefaults{$item.'_'.$field} ne $newvalues{$item.'_'.$field}) { - $changes{$item} = 1; - last; - } - } - } - foreach my $field ('email','web') { - if ($newvalues{$item.'_'.$field}) { - $domdefaults{$item.'_'.$field} = $newvalues{$item.'_'.$field}; - } elsif (exists($domdefaults{$item.'_'.$field})) { - delete($domdefaults{$item.'_'.$field}); - } - } - } - } - } $domdefaults{$item} = $newvalues{$item}; } my %staticdefaults = ( @@ -17358,25 +14780,11 @@ sub modify_defaults { krb4 => 'krb4', krb5 => 'krb5', localauth => 'loc', - lti => 'lti', ); $value = $authnames{$shortauth{$value}}; } $resulttext .= '
    • '.&mt('[_1] set to "[_2]"',$title->{$item},$value).'
      • '; - $mailmsgtext .= "$title->{$item} set to $value\n"; - if ($item eq 'portal_def') { - if ($env{'form.'.$item} ne '') { - foreach my $field ('email','web') { - $value = $env{'form.'.$item.'_'.$field}; - if ($value) { - $value = &mt('Yes'); - } else { - $value = &mt('No'); - } - $resulttext .= '
    • '.&mt('[_1] set to "[_2]"',$title->{$field},$value).'
      • '; - } - } - } + $mailmsgtext .= "$title->{$item} set to $value\n"; } } $resulttext .= '
    '; @@ -17431,15 +14839,12 @@ sub modify_scantron { $error = &mt("Upload of bubblesheet format file is not permitted to this server: [_1]",$switchserver); } else { if ($author_ok eq 'ok') { - my $modified = []; my ($result,$scantronurl) = - &Apache::lonconfigsettings::publishlogo($r,'upload','scantronformat',$dom, - $confname,'scantron','','',$custom, - $modified); + &publishlogo($r,'upload','scantronformat',$dom, + $confname,'scantron','','',$custom); if ($result eq 'ok') { $confhash{'scantron'}{'scantronformat'} = $scantronurl; $changes{'scantronformat'} = 1; - &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].",$custom,$result); } @@ -17591,8 +14996,8 @@ sub modify_scantron { $resulttext = &mt('No changes made to bubblesheet format settings'); } if ($errors) { - $resulttext .= '

    '.&mt('The following errors occurred: ').'

      '. - $errors.'

    '; + $resulttext .= &mt('The following errors occurred: ').'
      '. + $errors.'
    '; } return $resulttext; } @@ -18323,9 +15728,8 @@ sub modify_coursedefaults { 'uselcmath' => 'on', 'usejsme' => 'on', 'inline_chem' => 'on', - 'ltiauth' => 'off', ); - my @toggles = ('uselcmath','usejsme','inline_chem','ltiauth'); + my @toggles = ('uselcmath','usejsme','inline_chem'); my @numbers = ('anonsurvey_threshold','uploadquota_official','uploadquota_unofficial', 'uploadquota_community','uploadquota_textbook','mysqltables_official', 'mysqltables_unofficial','mysqltables_community','mysqltables_textbook'); @@ -18335,7 +15739,6 @@ sub modify_coursedefaults { uploadquota => 500, postsubmit => 60, mysqltables => 172800, - domexttool => 1, ); my %texoptions = ( MathJax => 'MathJax', @@ -18527,47 +15930,6 @@ sub modify_coursedefaults { $changes{'postsubmit'} = 1; } } - my (%newdomexttool,%newexttool,%olddomexttool,%oldexttool); - map { $newdomexttool{$_} = 1; } &Apache::loncommon::get_env_multiple('form.domexttool'); - map { $newexttool{$_} = 1; } &Apache::loncommon::get_env_multiple('form.exttool'); - if (ref($domconfig{'coursedefaults'}{'domexttool'}) eq 'HASH') { - %olddomexttool = %{$domconfig{'coursedefaults'}{'domexttool'}}; - } else { - foreach my $type (@types) { - if ($staticdefaults{'domexttool'}) { - $olddomexttool{$type} = 1; - } else { - $olddomexttool{$type} = 0; - } - } - } - if (ref($domconfig{'coursedefaults'}{'exttool'}) eq 'HASH') { - %oldexttool = %{$domconfig{'coursedefaults'}{'exttool'}}; - } else { - foreach my $type (@types) { - if ($staticdefaults{'exttool'}) { - $oldexttool{$type} = 1; - } else { - $oldexttool{$type} = 0; - } - } - } - foreach my $type (@types) { - unless ($newdomexttool{$type}) { - $newdomexttool{$type} = 0; - } - unless ($newexttool{$type}) { - $newexttool{$type} = 0; - } - if ($newdomexttool{$type} != $olddomexttool{$type}) { - $changes{'domexttool'} = 1; - } - if ($newexttool{$type} != $oldexttool{$type}) { - $changes{'exttool'} = 1; - } - } - $defaultshash{'coursedefaults'}{'domexttool'} = \%newdomexttool; - $defaultshash{'coursedefaults'}{'exttool'} = \%newexttool; } my $putresult = &Apache::lonnet::put_dom('configuration',\%defaultshash, $dom); @@ -18577,9 +15939,8 @@ sub modify_coursedefaults { if (($changes{'uploadquota'}) || ($changes{'postsubmit'}) || ($changes{'coursecredits'}) || ($changes{'uselcmath'}) || ($changes{'usejsme'}) || ($changes{'canclone'}) || ($changes{'mysqltables'}) || ($changes{'texengine'}) || - ($changes{'inline_chem'}) || ($changes{'ltiauth'}) || ($changes{'domexttool'}) || - ($changes{'exttool'})) { - foreach my $item ('uselcmath','usejsme','inline_chem','texengine','ltiauth') { + ($changes{'inline_chem'})) { + foreach my $item ('uselcmath','usejsme','inline_chem','texengine') { if ($changes{$item}) { $domdefaults{$item}=$defaultshash{'coursedefaults'}{$item}; } @@ -18622,20 +15983,6 @@ sub modify_coursedefaults { $domdefaults{'canclone'}=$defaultshash{'coursedefaults'}{'canclone'}; } } - if ($changes{'domexttool'}) { - if (ref($defaultshash{'coursedefaults'}{'domexttool'}) eq 'HASH') { - foreach my $type (@types) { - $domdefaults{$type.'domexttool'}=$defaultshash{'coursedefaults'}{'domexttool'}{$type}; - } - } - } - if ($changes{'exttool'}) { - if (ref($defaultshash{'coursedefaults'}{'exttool'}) eq 'HASH') { - foreach my $type (@types) { - $domdefaults{$type.'exttool'}=$defaultshash{'coursedefaults'}{'exttool'}{$type}; - } - } - } my $cachetime = 24*60*60; &Apache::lonnet::do_cache_new('domdefaults',$dom,\%domdefaults,$cachetime); if (ref($lastactref) eq 'HASH') { @@ -18675,6 +16022,7 @@ sub modify_coursedefaults { '
  • '.&mt('Official courses: [_1] MB',''.$defaultshash{'coursedefaults'}{'uploadquota'}{'official'}.'').'
    • '. '
  • '.&mt('Unofficial courses: [_1] MB',''.$defaultshash{'coursedefaults'}{'uploadquota'}{'unofficial'}.'').'
    • '. '
  • '.&mt('Textbook courses: [_1] MB',''.$defaultshash{'coursedefaults'}{'uploadquota'}{'textbook'}.'').'
    • '. + '
  • '.&mt('Communities: [_1] MB',''.$defaultshash{'coursedefaults'}{'uploadquota'}{'community'}.'').'
    • '. ''. ''; @@ -18757,40 +16105,6 @@ sub modify_coursedefaults { } else { $resulttext .= '
  • '.&mt('By default, only course owner and coordinators may clone a course.').'
    • '; } - } elsif ($item eq 'ltiauth') { - if ($env{'form.'.$item} eq '1') { - $resulttext .= '
  • '.&mt('LTI launch of deep-linked URL need not require re-authentication').'
    • '; - } else { - $resulttext .= '
  • '.&mt('LTI launch of deep-linked URL will require re-authentication').'
    • '; - } - } elsif ($item eq 'domexttool') { - my @noyes = (&mt('no'),&mt('yes')); - if (ref($defaultshash{'coursedefaults'}{'domexttool'}) eq 'HASH') { - $resulttext .= '
  • '.&mt('External Tools defined in the domain may be used as follows:').'
      '. - '
    • '.&mt('Official courses: [_1]',''.$noyes[$defaultshash{'coursedefaults'}{'domexttool'}{'official'}].'').'
      • '. - '
    • '.&mt('Unofficial courses: [_1]',''.$noyes[$defaultshash{'coursedefaults'}{'domexttool'}{'unofficial'}].'').'
      • '. - '
    • '.&mt('Textbook courses: [_1]',''.$noyes[$defaultshash{'coursedefaults'}{'domexttool'}{'textbook'}].'').'
      • '. - '
    • '.&mt('Placement tests: [_1]',''.$noyes[$defaultshash{'coursedefaults'}{'domexttool'}{'placement'}].'').'
      • '. - '
    • '.&mt('Communities: [_1]',''.$noyes[$defaultshash{'coursedefaults'}{'domexttool'}{'community'}].'').'
      • '. - '
    '. - '
    • '; - } else { - $resulttext .= '
  • '.&mt('External Tools defined in the domain may be used in all course types, by default').'
    • '; - } - } elsif ($item eq 'exttool') { - my @noyes = (&mt('no'),&mt('yes')); - if (ref($defaultshash{'coursedefaults'}{'exttool'}) eq 'HASH') { - $resulttext .= '
  • '.&mt('External Tools can be defined and configured in course containers as follows:').'
      '. - '
    • '.&mt('Official courses: [_1]',''.$noyes[$defaultshash{'coursedefaults'}{'exttool'}{'official'}].'').'
      • '. - '
    • '.&mt('Unofficial courses: [_1]',''.$noyes[$defaultshash{'coursedefaults'}{'exttool'}{'unofficial'}].'').'
      • '. - '
    • '.&mt('Textbook courses: [_1]',''.$noyes[$defaultshash{'coursedefaults'}{'exttool'}{'textbook'}].'').'
      • '. - '
    • '.&mt('Placement tests: [_1]',''.$noyes[$defaultshash{'coursedefaults'}{'exttool'}{'placement'}].'').'
      • '. - '
    • '.&mt('Communities: [_1]',''.$noyes[$defaultshash{'coursedefaults'}{'exttool'}{'community'}].'').'
      • '. - '
    '. - '
    • '; - } else { - $resulttext .= '
  • '.&mt('External Tools can not be defined in any course types, by default').'
    • '; - } } } $resulttext .= ''; @@ -19703,7 +17017,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).'
    • '; } @@ -20586,7 +17900,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') { @@ -20720,7 +18034,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; @@ -20775,7 +18089,7 @@ sub devalidate_remote_domconfs { my %servers = &Apache::lonnet::internet_dom_servers($dom); my %thismachine; map { $thismachine{$_} = 1; } &Apache::lonnet::current_machine_ids(); - my @posscached = ('domainconfig','domdefaults','ltitools','usersessions', + my @posscached = ('domainconfig','domdefaults','usersessions', 'directorysrch','passwdconf','cats','proxyalias','proxysaml', 'ipaccess'); my %cache_by_lonhost;
    '. ''; - my $prefix = 'canmodify'; if ($role eq 'emailusername') { unless ($checks{$fields[$i]} =~ /^(required|optional)$/) { $checks{$fields[$i]} = 'omit'; @@ -10464,16 +8897,13 @@ sub modifiable_userdata_row { $checked='checked="checked" '; } $output .= ''.(' ' x2); } $output .= ''.$fieldtitles{$fields[$i]}.''; } else { - if ($context eq 'lti') { - $prefix = 'lti'; - } $output .= ''; } @@ -10560,7 +8990,7 @@ sub insttypes_row { $output .= ''. '