--- loncom/interface/domainprefs.pm 2010/12/08 04:22:16 1.123.2.5 +++ loncom/interface/domainprefs.pm 2012/10/02 19:38:00 1.160.6.8 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Handler to set domain-wide configuration settings # -# $Id: domainprefs.pm,v 1.123.2.5 2010/12/08 04:22:16 raeburn Exp $ +# $Id: domainprefs.pm,v 1.160.6.8 2012/10/02 19:38:00 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -86,8 +86,8 @@ $dom,$settings,$rowtotal,$action. $dom is the domain, $settings is a reference to a hash of current settings for the current context, $rowtotal is a reference to the scalar used to record the -number of rows displayed on the page, and $action is the context (either quotas -or requestcourses). +number of rows displayed on the page, and $action is the context (quotas, +requestcourses or requestauthor). The print_quotas routine was orginally created to display/store information about default quota sizes for portfolio spaces for the different types of @@ -140,7 +140,7 @@ autolimit =over -- course requests will be processed autoatically up to a limit of +- course requests will be processed automatically up to a limit of N requests for the course type for the particular requestor. If N is undefined, there is no limit to the number of course requests which a course owner may submit and have processed automatically. @@ -171,6 +171,9 @@ use Locale::Language; use DateTime::TimeZone; use DateTime::Locale; +my $registered_cleanup; +my $modified_urls; + sub handler { my $r=shift; if ($r->header_only) { @@ -190,6 +193,10 @@ sub handler { "/adm/domainprefs:mau:0:0:Cannot modify domain settings"; return HTTP_NOT_ACCEPTABLE; } + + $registered_cleanup=0; + @{$modified_urls}=(); + &Apache::lonhtmlcommon::clear_breadcrumbs(); &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['phase','actions']); @@ -197,17 +204,26 @@ sub handler { if ( exists($env{'form.phase'}) ) { $phase = $env{'form.phase'}; } + my %servers = &Apache::lonnet::internet_dom_servers($dom); my %domconfig = &Apache::lonnet::get_dom('configuration',['login','rolecolors', - 'quotas','autoenroll','autoupdate','directorysrch', - 'usercreation','usermodification','contacts','defaults', - 'scantron','coursecategories','serverstatuses', - 'requestcourses','helpsettings','coursedefaults'],$dom); + 'quotas','autoenroll','autoupdate','autocreate', + 'directorysrch','usercreation','usermodification', + 'contacts','defaults','scantron','coursecategories', + 'serverstatuses','requestcourses','usersessions', + 'loadbalancing','requestauthor'],$dom); my @prefs_order = ('rolecolors','login','defaults','quotas','autoenroll', - 'autoupdate','directorysrch','contacts', + 'autoupdate','autocreate','directorysrch','contacts', 'usercreation','usermodification','scantron', - 'requestcourses','coursecategories','serverstatuses','helpsettings', - 'coursedefaults'); + 'requestcourses','requestauthor','coursecategories', + 'serverstatuses','usersessions'); + my %existing; + if (ref($domconfig{'loadbalancing'}) eq 'HASH') { + %existing = %{$domconfig{'loadbalancing'}}; + } + if ((keys(%servers) > 1) || (keys(%existing) > 0)) { + push(@prefs_order,'loadbalancing'); + } my %prefs = ( 'rolecolors' => { text => 'Default color schemes', @@ -224,10 +240,11 @@ sub handler { 'login' => { text => 'Log-in page options', help => 'Domain_Configuration_Login_Page', - header => [{col1 => 'Item', - col2 => '',}], + header => [{col1 => 'Log-in Page Items', + col2 => '',}, + {col1 => 'Log-in Help', + col2 => 'Value'}], }, - 'defaults' => { text => 'Default authentication/language/timezone/portal', help => 'Domain_Configuration_LangTZAuth', @@ -235,7 +252,7 @@ sub handler { col2 => 'Value'}], }, 'quotas' => - { text => 'User blogs, personal information pages and portfolios', + { text => 'Blogs, personal web pages, webDAV, portfolios', help => 'Domain_Configuration_Quotas', header => [{col1 => 'User affiliation', col2 => 'Available tools', @@ -252,8 +269,16 @@ sub handler { help => 'Domain_Configuration_Auto_Updates', header => [{col1 => 'Setting', col2 => 'Value',}, + {col1 => 'Setting', + col2 => 'Affiliation'}, {col1 => 'User population', - col2 => 'Updataeable user data'}], + col2 => 'Updateable user data'}], + }, + 'autocreate' => + { text => 'Auto-course creation settings', + help => 'Domain_Configuration_Auto_Creation', + header => [{col1 => 'Configuration Setting', + col2 => 'Value',}], }, 'directorysrch' => { text => 'Institutional directory searches', @@ -303,6 +328,14 @@ sub handler { {col1 => 'Setting', col2 => 'Value'}], }, + 'requestauthor' => + {text => 'Request authoring space', + help => 'Domain_Configuration_Request_Author', + header => [{col1 => 'User affiliation', + col2 => 'Availability/Processing of requests',}, + {col1 => 'Setting', + col2 => 'Value'}], + }, 'coursecategories' => { text => 'Cataloging of courses/communities', help => 'Domain_Configuration_Cataloging_Courses', @@ -320,47 +353,57 @@ sub handler { col3 => 'Specific IPs', }], }, - 'helpsettings' => - {text => 'Help page settings', - help => 'Domain_Configuration_Help_Settings', - header => [{col1 => 'Authenticated Help Settings', - col2 => ''}, - {col1 => 'Unauthenticated Help Settings', - col2 => ''}], - }, - 'coursedefaults' => - {text => 'Course/Community defaults', - help => 'Domain_Configuration_Course_Defaults', - header => [{col1 => 'Defaults which can be overridden for each course by a DC', - col2 => 'Value',}], + 'usersessions' => + {text => 'User session hosting/offloading', + help => 'Domain_Configuration_User_Sessions', + header => [{col1 => 'Domain server', + col2 => 'Servers to offload sessions to when busy'}, + {col1 => 'Hosting of users from other domains', + col2 => 'Rules'}, + {col1 => "Hosting domain's own users elsewhere", + col2 => 'Rules'}], }, - 'privacy' => - {text => 'User Privacy', - help => 'Domain_Configuration_User_Privacy', - header => [{col1 => 'Setting', - col2 => 'Value',}], + 'loadbalancing' => + {text => 'Dedicated Load Balancer(s)', + help => 'Domain_Configuration_Load_Balancing', + header => [{col1 => 'Balancers', + col2 => 'Default destinations', + col3 => 'User affliation', + col4 => 'Overrides'}, + ], }, ); - my %servers = &dom_servers($dom); if (keys(%servers) > 1) { $prefs{'login'} = { text => 'Log-in page options', help => 'Domain_Configuration_Login_Page', header => [{col1 => 'Log-in Service', col2 => 'Server Setting',}, {col1 => 'Log-in Page Items', - col2 => ''}], + col2 => ''}, + {col1 => 'Log-in Help', + col2 => 'Value'}], }; } my @roles = ('student','coordinator','author','admin'); my @actions = &Apache::loncommon::get_env_multiple('form.actions'); &Apache::lonhtmlcommon::add_breadcrumb ({href=>"javascript:changePage(document.$phase,'pickactions')", - text=>"Pick functionality"}); + text=>"Settings to display/modify"}); my $confname = $dom.'-domainconfig'; if ($phase eq 'process') { &Apache::lonconfigsettings::make_changes($r,$dom,$phase,$context,\@prefs_order,\%prefs,\%domconfig,$confname,\@roles); } elsif ($phase eq 'display') { - &Apache::lonconfigsettings::display_settings($r,$dom,$phase,$context,\@prefs_order,\%prefs,\%domconfig,$confname); + my $js = &recaptcha_js(); + if ((keys(%servers) > 1) || (keys(%existing) > 0)) { + my ($othertitle,$usertypes,$types) = + &Apache::loncommon::sorted_inst_types($dom); + $js .= &lonbalance_targets_js($dom,$types,\%servers, + $domconfig{'loadbalancing'}). + &new_spares_js(). + &common_domprefs_js(). + &Apache::loncommon::javascript_array_indexof(); + } + &Apache::lonconfigsettings::display_settings($r,$dom,$phase,$context,\@prefs_order,\%prefs,\%domconfig,$confname,$js); } else { if (keys(%domconfig) == 0) { my $primarylibserv = &Apache::lonnet::domain($dom,'primary'); @@ -418,6 +461,8 @@ sub process_changes { $output = &modify_autoenroll($dom,%domconfig); } elsif ($action eq 'autoupdate') { $output = &modify_autoupdate($dom,%domconfig); + } elsif ($action eq 'autocreate') { + $output = &modify_autocreate($dom,%domconfig); } elsif ($action eq 'directorysrch') { $output = &modify_directorysrch($dom,%domconfig); } elsif ($action eq 'usercreation') { @@ -436,10 +481,12 @@ sub process_changes { $output = &modify_serverstatuses($dom,%domconfig); } elsif ($action eq 'requestcourses') { $output = &modify_quotas($dom,$action,%domconfig); - } elsif ($action eq 'helpsettings') { - $output = &modify_helpsettings($r,$dom,$confname,%domconfig); - } elsif ($action eq 'coursedefaults') { - $output = &modify_coursedefaults($dom,%domconfig); + } elsif ($action eq 'requestauthor') { + $output = &modify_quotas($dom,$action,%domconfig); + } elsif ($action eq 'usersessions') { + $output = &modify_usersessions($dom,%domconfig); + } elsif ($action eq 'loadbalancing') { + $output = &modify_loadbalancing($dom,%domconfig); } return $output; } @@ -465,16 +512,21 @@ sub print_config_box { } if ($numheaders > 1) { my $colspan = ''; - if (($action eq 'rolecolors') || ($action eq 'coursecategories') || ($action eq 'helpsettings')) { + my $rightcolspan = ''; + if (($action eq 'rolecolors') || ($action eq 'coursecategories') || + (($action eq 'login') && ($numheaders < 3))) { $colspan = ' colspan="2"'; } + if ($action eq 'usersessions') { + $rightcolspan = ' colspan="3"'; + } $output .= ' - + '; $rowtotal ++; if ($action eq 'autoupdate') { @@ -486,12 +538,18 @@ sub print_config_box { } elsif ($action eq 'coursecategories') { $output .= &print_coursecategories('top',$dom,$item,$settings,\$rowtotal); } elsif ($action eq 'login') { - $output .= &print_login('top',$dom,$confname,$phase,$settings,\$rowtotal); - $colspan = ' colspan="2"'; + if ($numheaders == 3) { + $colspan = ' colspan="2"'; + $output .= &print_login('service',$dom,$confname,$phase,$settings,\$rowtotal); + } else { + $output .= &print_login('page',$dom,$confname,$phase,$settings,\$rowtotal); + } } elsif ($action eq 'requestcourses') { $output .= &print_quotas($dom,$settings,\$rowtotal,$action); - } elsif ($action eq 'helpsettings') { - $output .= &print_helpsettings('top',$dom,$confname,$settings,\$rowtotal); + } elsif ($action eq 'requestauthor') { + $output .= &print_quotas($dom,$settings,\$rowtotal,$action); + } elsif ($action eq 'usersessions') { + $output .= &print_usersessions('top',$dom,$settings,\$rowtotal); } elsif ($action eq 'rolecolors') { $output .= &print_rolecolors($phase,'student',$dom,$confname,$settings,\$rowtotal); } @@ -509,7 +567,18 @@ sub print_config_box { '; $rowtotal ++; if ($action eq 'autoupdate') { - $output .= &print_autoupdate('bottom',$dom,$settings,\$rowtotal); + $output .= &print_autoupdate('middle',$dom,$settings,\$rowtotal).' +
'.&mt($item->{'header'}->[0]->{'col1'}).''.&mt($item->{'header'}->[0]->{'col2'}).''.&mt($item->{'header'}->[0]->{'col2'}).'
+ + + + + + + + '. + &print_autoupdate('bottom',$dom,$settings,\$rowtotal); + $rowtotal ++; } elsif ($action eq 'usercreation') { $output .= &print_usercreation('middle',$dom,$settings,\$rowtotal).'
'.&mt($item->{'header'}->[2]->{'col1'}).''.&mt($item->{'header'}->[2]->{'col2'}).'
@@ -534,17 +603,46 @@ sub print_config_box { '.&mt($item->{'header'}->[2]->{'col1'}).' '.&mt($item->{'header'}->[2]->{'col2'}).' '. - &print_usermodification('bottom',$dom,$settings,\$rowtotal); $rowtotal ++; } elsif ($action eq 'coursecategories') { $output .= &print_coursecategories('bottom',$dom,$item,$settings,\$rowtotal); } elsif ($action eq 'login') { - $output .= &print_login('bottom',$dom,$confname,$phase,$settings,\$rowtotal); + if ($numheaders == 3) { + $output .= &print_login('page',$dom,$confname,$phase,$settings,\$rowtotal).' + + + + + + + + + '. + &print_login('help',$dom,$confname,$phase,$settings,\$rowtotal); + $rowtotal ++; + } else { + $output .= &print_login('help',$dom,$confname,$phase,$settings,\$rowtotal); + } } elsif ($action eq 'requestcourses') { - $output .= &print_courserequestmail($dom,$settings,\$rowtotal); - } elsif ($action eq 'helpsettings') { - $output .= &print_helpsettings('bottom',$dom,$confname,$settings,\$rowtotal); + $output .= &print_requestmail($dom,$action,$settings,\$rowtotal); + } elsif ($action eq 'requestauthor') { + $output .= &print_requestmail($dom,$action,$settings,\$rowtotal); + } elsif ($action eq 'usersessions') { + $output .= &print_usersessions('middle',$dom,$settings,\$rowtotal).' +
'.&mt($item->{'header'}->[2]->{'col1'}).''.&mt($item->{'header'}->[2]->{'col2'}).'
+ + + + + + + + '. + &print_usersessions('bottom',$dom,$settings,\$rowtotal); + $rowtotal ++; + } elsif ($action eq 'coursedefaults') { + $output .= &print_coursedefaults('bottom',$dom,$settings,\$rowtotal); } elsif ($action eq 'rolecolors') { $output .= &print_rolecolors($phase,'coordinator',$dom,$confname,$settings,\$rowtotal).'
'.&mt($item->{'header'}->[2]->{'col1'}).''.&mt($item->{'header'}->[2]->{'col2'}).'
@@ -603,22 +701,30 @@ sub print_config_box { } $output .= ''; if ($item->{'header'}->[0]->{'col3'}) { - $output .= ''. - &mt($item->{'header'}->[0]->{'col3'}); + if (defined($item->{'header'}->[0]->{'col4'})) { + $output .= ''. + &mt($item->{'header'}->[0]->{'col3'}); + } else { + $output .= ''. + &mt($item->{'header'}->[0]->{'col3'}); + } if ($action eq 'serverstatuses') { $output .= '
('.&mt('IP1,IP2 etc.').')'; } $output .= ''; } + if ($item->{'header'}->[0]->{'col4'}) { + $output .= ''. + &mt($item->{'header'}->[0]->{'col4'}); + } $output .= ''; $rowtotal ++; - if ($action eq 'login') { - $output .= &print_login('bottom',$dom,$confname,$phase,$settings, - \$rowtotal); - } elsif ($action eq 'quotas') { + if ($action eq 'quotas') { $output .= &print_quotas($dom,$settings,\$rowtotal,$action); } elsif ($action eq 'autoenroll') { $output .= &print_autoenroll($dom,$settings,\$rowtotal); + } elsif ($action eq 'autocreate') { + $output .= &print_autocreate($dom,$settings,\$rowtotal); } elsif ($action eq 'directorysrch') { $output .= &print_directorysrch($dom,$settings,\$rowtotal); } elsif ($action eq 'contacts') { @@ -630,9 +736,9 @@ sub print_config_box { } elsif ($action eq 'serverstatuses') { $output .= &print_serverstatuses($dom,$settings,\$rowtotal); } elsif ($action eq 'helpsettings') { - $output .= &print_helpsettings('top',$dom,$confname,$settings,\$rowtotal); - } elsif ($action eq 'coursedefaults') { - $output .= &print_coursedefaults($dom,$settings,\$rowtotal); + $output .= &print_helpsettings($dom,$confname,$settings,\$rowtotal); + } elsif ($action eq 'loadbalancing') { + $output .= &print_loadbalancing($dom,$settings,\$rowtotal); } } $output .= ' @@ -644,18 +750,20 @@ sub print_config_box { } sub print_login { - my ($position,$dom,$confname,$phase,$settings,$rowtotal) = @_; + my ($caller,$dom,$confname,$phase,$settings,$rowtotal) = @_; my ($css_class,$datatable); my %choices = &login_choices(); - my $itemcount = 1; - if ($position eq 'top') { - my %servers = &dom_servers($dom); + if ($caller eq 'service') { + my %servers = &Apache::lonnet::internet_dom_servers($dom); my $choice = $choices{'disallowlogin'}; $css_class = ' class="LC_odd_row"'; - $datatable .= ''.$choices{'disallowlogin'}.''. + $datatable .= ''.$choice.''. ''. - ''."\n"; + ''. + ''. + ''. + ''."\n"; my %disallowed; if (ref($settings) eq 'HASH') { if (ref($settings->{'loginvia'}) eq 'HASH') { @@ -664,156 +772,269 @@ sub print_login { } foreach my $lonhost (sort(keys(%servers))) { my $direct = 'selected="selected"'; - if ($disallowed{$lonhost} eq '') { - $direct = ''; + if (ref($disallowed{$lonhost}) eq 'HASH') { + if ($disallowed{$lonhost}{'server'} ne '') { + $direct = ''; + } } $datatable .= ''. - ''; + $datatable .= ''. + ''; + my ($custom,$exempt); + if (ref($disallowed{$lonhost}) eq 'HASH') { + $custom = $disallowed{$lonhost}{'custompath'}; + $exempt = $disallowed{$lonhost}{'exempt'}; + } + $datatable .= ''. + ''. + ''; } $datatable .= '
'.$choices{'hostid'}.''.$choices{'serverurl'}.'
'.$choices{'server'}.''.$choices{'serverpath'}.''.$choices{'custompath'}.''.$choices{'exempt'}.'
'.$servers{$lonhost}.'
'; return $datatable; - } - - my %defaultchecked = ( - 'coursecatalog' => 'on', - 'adminmail' => 'off', - 'newuser' => 'off', - ); - my @toggles = ('coursecatalog','adminmail','newuser'); - my (%checkedon,%checkedoff); - foreach my $item (@toggles) { - if ($defaultchecked{$item} eq 'on') { - $checkedon{$item} = ' checked="checked" '; - $checkedoff{$item} = ' '; - } elsif ($defaultchecked{$item} eq 'off') { - $checkedoff{$item} = ' checked="checked" '; - $checkedon{$item} = ' '; - } - } - my $loginheader = 'image'; - my @images = ('img','logo','domlogo','login'); - my @logintext = ('textcol','bgcol'); - my @bgs = ('pgbg','mainbg','sidebg'); - my @links = ('link','alink','vlink'); - my %designhash = &Apache::loncommon::get_domainconf($dom); - my %defaultdesign = %Apache::loncommon::defaultdesign; - my (%is_custom,%designs); - my %defaults = ( - font => $defaultdesign{'login.font'}, - ); - foreach my $item (@images) { - $defaults{$item} = $defaultdesign{'login.'.$item}; - $defaults{'showlogo'}{$item} = 1; - } - foreach my $item (@bgs) { - $defaults{'bgs'}{$item} = $defaultdesign{'login.'.$item}; - } - foreach my $item (@logintext) { - $defaults{'logintext'}{$item} = $defaultdesign{'login.'.$item}; - } - foreach my $item (@links) { - $defaults{'links'}{$item} = $defaultdesign{'login.'.$item}; - } - if (ref($settings) eq 'HASH') { + } elsif ($caller eq 'page') { + my %defaultchecked = ( + 'coursecatalog' => 'on', + 'adminmail' => 'off', + 'newuser' => 'off', + ); + my @toggles = ('coursecatalog','adminmail','newuser'); + my (%checkedon,%checkedoff); foreach my $item (@toggles) { - if ($settings->{$item} eq '1') { - $checkedon{$item} = ' checked="checked" '; + if ($defaultchecked{$item} eq 'on') { + $checkedon{$item} = ' checked="checked" '; $checkedoff{$item} = ' '; - } elsif ($settings->{$item} eq '0') { - $checkedoff{$item} = ' checked="checked" '; + } elsif ($defaultchecked{$item} eq 'off') { + $checkedoff{$item} = ' checked="checked" '; $checkedon{$item} = ' '; } } + my @images = ('img','logo','domlogo','login'); + my @logintext = ('textcol','bgcol'); + my @bgs = ('pgbg','mainbg','sidebg'); + my @links = ('link','alink','vlink'); + my %designhash = &Apache::loncommon::get_domainconf($dom); + my %defaultdesign = %Apache::loncommon::defaultdesign; + my (%is_custom,%designs); + my %defaults = ( + font => $defaultdesign{'login.font'}, + ); foreach my $item (@images) { - if (defined($settings->{$item})) { - $designs{$item} = $settings->{$item}; - $is_custom{$item} = 1; - } - if (defined($settings->{'showlogo'}{$item})) { - $designs{'showlogo'}{$item} = $settings->{'showlogo'}{$item}; - } + $defaults{$item} = $defaultdesign{'login.'.$item}; + $defaults{'showlogo'}{$item} = 1; } - foreach my $item (@logintext) { - if ($settings->{$item} ne '') { - $designs{'logintext'}{$item} = $settings->{$item}; - $is_custom{$item} = 1; - } + foreach my $item (@bgs) { + $defaults{'bgs'}{$item} = $defaultdesign{'login.'.$item}; } - if ($settings->{'loginheader'} ne '') { - $loginheader = $settings->{'loginheader'}; + foreach my $item (@logintext) { + $defaults{'logintext'}{$item} = $defaultdesign{'login.'.$item}; } - if ($settings->{'font'} ne '') { - $designs{'font'} = $settings->{'font'}; - $is_custom{'font'} = 1; + foreach my $item (@links) { + $defaults{'links'}{$item} = $defaultdesign{'login.'.$item}; } - foreach my $item (@bgs) { - if ($settings->{$item} ne '') { - $designs{'bgs'}{$item} = $settings->{$item}; - $is_custom{$item} = 1; + if (ref($settings) eq 'HASH') { + foreach my $item (@toggles) { + if ($settings->{$item} eq '1') { + $checkedon{$item} = ' checked="checked" '; + $checkedoff{$item} = ' '; + } elsif ($settings->{$item} eq '0') { + $checkedoff{$item} = ' checked="checked" '; + $checkedon{$item} = ' '; + } } - } - foreach my $item (@links) { - if ($settings->{$item} ne '') { - $designs{'links'}{$item} = $settings->{$item}; - $is_custom{$item} = 1; + foreach my $item (@images) { + if (defined($settings->{$item})) { + $designs{$item} = $settings->{$item}; + $is_custom{$item} = 1; + } + if (defined($settings->{'showlogo'}{$item})) { + $designs{'showlogo'}{$item} = $settings->{'showlogo'}{$item}; + } } - } - } else { - if ($designhash{$dom.'.login.font'} ne '') { - $designs{'font'} = $designhash{$dom.'.login.font'}; - $is_custom{'font'} = 1; - } - foreach my $item (@images) { - if ($designhash{$dom.'.login.'.$item} ne '') { - $designs{$item} = $designhash{$dom.'.login.'.$item}; - $is_custom{$item} = 1; + foreach my $item (@logintext) { + if ($settings->{$item} ne '') { + $designs{'logintext'}{$item} = $settings->{$item}; + $is_custom{$item} = 1; + } + } + if ($settings->{'font'} ne '') { + $designs{'font'} = $settings->{'font'}; + $is_custom{'font'} = 1; + } + foreach my $item (@bgs) { + if ($settings->{$item} ne '') { + $designs{'bgs'}{$item} = $settings->{$item}; + $is_custom{$item} = 1; + } + } + foreach my $item (@links) { + if ($settings->{$item} ne '') { + $designs{'links'}{$item} = $settings->{$item}; + $is_custom{$item} = 1; + } + } + } else { + if ($designhash{$dom.'.login.font'} ne '') { + $designs{'font'} = $designhash{$dom.'.login.font'}; + $is_custom{'font'} = 1; + } + foreach my $item (@images) { + if ($designhash{$dom.'.login.'.$item} ne '') { + $designs{$item} = $designhash{$dom.'.login.'.$item}; + $is_custom{$item} = 1; + } + } + foreach my $item (@bgs) { + if ($designhash{$dom.'.login.'.$item} ne '') { + $designs{'bgs'}{$item} = $designhash{$dom.'.login.'.$item}; + $is_custom{$item} = 1; + } + } + foreach my $item (@links) { + if ($designhash{$dom.'.login.'.$item} ne '') { + $designs{'links'}{$item} = $designhash{$dom.'.login.'.$item}; + $is_custom{$item} = 1; + } } } - foreach my $item (@bgs) { - if ($designhash{$dom.'.login.'.$item} ne '') { - $designs{'bgs'}{$item} = $designhash{$dom.'.login.'.$item}; - $is_custom{$item} = 1; + my %alt_text = &Apache::lonlocal::texthash ( img => 'Log-in banner', + logo => 'Institution Logo', + domlogo => 'Domain Logo', + login => 'Login box'); + my $itemcount = 1; + foreach my $item (@toggles) { + $css_class = $itemcount%2?' class="LC_odd_row"':''; + $datatable .= + ''.$choices{$item}. + ''. + ' '. + ''; + $itemcount ++; + } + $datatable .= &display_color_options($dom,$confname,$phase,'login',$itemcount,\%choices,\%is_custom,\%defaults,\%designs,\@images,\@bgs,\@links,\%alt_text,$rowtotal,\@logintext); + $datatable .= ''; + } elsif ($caller eq 'help') { + my ($defaulturl,$defaulttype,%url,%type,%lt,%langchoices); + my $switchserver = &check_switchserver($dom,$confname); + my $itemcount = 1; + $defaulturl = '/adm/loginproblems.html'; + $defaulttype = 'default'; + %lt = &Apache::lonlocal::texthash ( + del => 'Delete?', + rep => 'Replace:', + upl => 'Upload:', + default => 'Default', + custom => 'Custom', + ); + %langchoices = &Apache::lonlocal::texthash(&get_languages_hash()); + my @currlangs; + if (ref($settings) eq 'HASH') { + if (ref($settings->{'helpurl'}) eq 'HASH') { + foreach my $key (sort(keys(%{$settings->{'helpurl'}}))) { + next if ($settings->{'helpurl'}{$key} eq ''); + $url{$key} = $settings->{'helpurl'}{$key}.'?inhibitmenu=yes'; + $type{$key} = 'custom'; + unless ($key eq 'nolang') { + push(@currlangs,$key); + } + } + } elsif ($settings->{'helpurl'} ne '') { + $type{'nolang'} = 'custom'; + $url{'nolang'} = $settings->{'helpurl'}.'?inhibitmenu=yes'; + } + } + foreach my $lang ('nolang',sort(@currlangs)) { + $css_class = $itemcount%2 ? ' class="LC_odd_row"' : ''; + $datatable .= ''; + if ($url{$lang} eq '') { + $url{$lang} = $defaulturl; + } + if ($type{$lang} eq '') { + $type{$lang} = $defaulttype; + } + $datatable .= ''; + if ($lang eq 'nolang') { + $datatable .= &mt('Log-in help page if no specific language file: [_1]', + &Apache::loncommon::modal_link($url{$lang},$lt{$type{$lang}},600,500)); + } else { + $datatable .= &mt('Log-in help page for language: [_1] is [_2]', + $langchoices{$lang}, + &Apache::loncommon::modal_link($url{$lang},$lt{$type{$lang}},600,500)); + } + $datatable .= ''."\n". + ''; + if ($type{$lang} eq 'custom') { + $datatable .= ' '.$lt{'rep'}.''; + } else { + $datatable .= $lt{'upl'}; } + $datatable .='
'; + if ($switchserver) { + $datatable .= &mt('Upload to library server: [_1]',$switchserver); + } else { + $datatable .= ''; + } + $datatable .= ''; + $itemcount ++; } - foreach my $item (@links) { - if ($designhash{$dom.'.login.'.$item} ne '') { - $designs{'links'}{$item} = $designhash{$dom.'.login.'.$item}; - $is_custom{$item} = 1; + my @addlangs; + foreach my $lang (sort(keys(%langchoices))) { + next if ((grep(/^\Q$lang\E$/,@currlangs)) || ($lang eq 'x_chef')); + push(@addlangs,$lang); + } + if (@addlangs > 0) { + my %toadd; + map { $toadd{$_} = $langchoices{$_} ; } @addlangs; + $toadd{''} = &mt('Select'); + $css_class = $itemcount%2 ? ' class="LC_odd_row"' : ''; + $datatable .= ''. + &mt('Add log-in help page for a specific language:').' '. + &Apache::loncommon::select_form('','loginhelpurl_add_lang',\%toadd). + ''.$lt{'upl'}.'
'; + if ($switchserver) { + $datatable .= &mt('Upload to library server: [_1]',$switchserver); + } else { + $datatable .= ''; } + $datatable .= ''; + $itemcount ++; } + $datatable .= &captcha_choice('login',$settings,$itemcount); } - my %alt_text = &Apache::lonlocal::texthash ( img => 'Log-in banner', - logo => 'Institution Logo', - domlogo => 'Domain Logo', - login => 'Login box'); - my $itemcount = 1; - my ($css_class,$datatable); - foreach my $item (@toggles) { - $css_class = $itemcount%2?' class="LC_odd_row"':''; - $datatable .= - ''.$choices{$item}. - ''. - ' '. - ''; - $itemcount ++; - } - $datatable .= &display_color_options($dom,$confname,$phase,'login',$itemcount,\%choices,\%is_custom,\%defaults,\%designs,\@images,\@bgs,\@links,\%alt_text,$rowtotal,\@logintext,$loginheader); - $datatable .= ''; return $datatable; } @@ -824,7 +1045,10 @@ sub login_choices { adminmail => "Display Administrator's E-mail Address?", disallowlogin => "Login page requests redirected", hostid => "Server", - serverurl => "Redirect to log-in via:", + server => "Redirect to:", + serverpath => "Path", + custompath => "Custom", + exempt => "Exempt IP(s)", directlogin => "No redirect", newuser => "Link to create a user account", img => "Header", @@ -929,9 +1153,10 @@ sub print_rolecolors { sub display_color_options { my ($dom,$confname,$phase,$role,$itemcount,$choices,$is_custom,$defaults,$designs, - $images,$bgs,$links,$alt_text,$rowtotal,$logintext,$loginheader) = @_; + $images,$bgs,$links,$alt_text,$rowtotal,$logintext) = @_; + my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'}; my $css_class = $itemcount%2?' class="LC_odd_row"':''; - my $datatable = ''. + my $datatable = ''. ''.$choices->{'font'}.''; if (!$is_custom->{'font'}) { $datatable .= ''.&mt('Default in use:').' '.$defaults->{'font'}.''; @@ -971,8 +1196,7 @@ sub display_color_options { if ($role eq 'login') { if ($img eq 'login') { $login_hdr_pick = - &login_header_options($img,$role,$defaults,$is_custom,$choices, - $loginheader); + &login_header_options($img,$role,$defaults,$is_custom,$choices); $logincolors = &login_text_colors($img,$role,$logintext,$phase,$choices, $designs); @@ -1008,11 +1232,11 @@ sub display_color_options { $showfile = $imgfile; my $imgdir = $1; my $filename = $2; - if (-e "/home/httpd/html/$imgdir/tn-".$filename) { + if (-e "$londocroot/$imgdir/tn-".$filename) { $showfile = "/$imgdir/tn-".$filename; } else { - my $input = "/home/httpd/html".$imgfile; - my $output = '/home/httpd/html/'.$imgdir.'/tn-'.$filename; + my $input = $londocroot.$imgfile; + my $output = "$londocroot/$imgdir/tn-".$filename; if (!-e $output) { my ($width,$height) = &thumb_dimensions(); my ($fullwidth,$fullheight) = &check_dimensions($input); @@ -1020,7 +1244,7 @@ sub display_color_options { if ($fullwidth > $width && $fullheight > $height) { my $size = $width.'x'.$height; system("convert -sample $size $input $output"); - $showfile = '/'.$imgdir.'/tn-'.$filename; + $showfile = "/$imgdir/tn-".$filename; } } } @@ -1049,8 +1273,8 @@ sub display_color_options { } $datatable .= ''; if ($img eq 'login') { - $datatable .= $login_hdr_pick; - } + $datatable .= $login_hdr_pick; + } $datatable .= &image_changes($is_custom->{$img},$alt_text->{$img},$img_import, $showfile,$fullsize,$role,$img,$imgfile,$logincolors); } else { @@ -1064,7 +1288,9 @@ sub display_color_options { if ($switchserver) { $datatable .= &mt('Upload to library server: [_1]',$switchserver); } else { - $datatable .=' '; + if ($img ne 'login') { # suppress file selection for Log-in header + $datatable .=' '; + } } $datatable .= ''; } @@ -1153,20 +1379,10 @@ sub logo_display_options { } sub login_header_options { - my ($img,$role,$defaults,$is_custom,$choices,$loginheader) = @_; - my $image_checked = ' checked="checked" '; - my $text_checked = ' '; - if ($loginheader eq 'text') { - $image_checked = ' '; - $text_checked = ' checked="checked" '; - } - my $output = '   '. - '
'."\n"; + my ($img,$role,$defaults,$is_custom,$choices) = @_; + my $output = ''; if ((!$is_custom->{'textcol'}) || (!$is_custom->{'bgcol'})) { - $output .= &mt('Text default(s)').':
'; + $output .= &mt('Text default(s):').'
'; if (!$is_custom->{'textcol'}) { $output .= $choices->{'textcol'}.': '.$defaults->{'logintext'}{'textcol'}. '   '; @@ -1202,25 +1418,31 @@ sub login_text_colors { sub image_changes { my ($is_custom,$alt_text,$img_import,$showfile,$fullsize,$role,$img,$imgfile,$logincolors) = @_; my $output; - if (!$is_custom) { + if ($img eq 'login') { + # suppress image for Log-in header + } elsif (!$is_custom) { if ($img ne 'domlogo') { $output .= &mt('Default image:').'
'; } else { $output .= &mt('Default in use:').'
'; } } - if ($img_import) { - $output .= ''; - } - $output .= ''.$alt_text.''; - if ($is_custom) { - $output .= ''.$logincolors.' '.&mt('Replace:').'
'; + if ($img eq 'login') { # suppress image for Log-in header + $output .= ''.$logincolors; } else { - $output .= ''.$logincolors.&mt('Upload:').'
'; + if ($img_import) { + $output .= ''; + } + $output .= ''.$alt_text.''; + if ($is_custom) { + $output .= ''.$logincolors.' '.&mt('Replace:').'
'; + } else { + $output .= ''.$logincolors.&mt('Upload:').'
'; + } } return $output; } @@ -1250,14 +1472,19 @@ sub print_quotas { @options =('norequest','approval','validate','autolimit'); %validations = &Apache::lonnet::auto_courserequest_checks($dom); %titles = &courserequest_titles(); + } elsif ($context eq 'requestauthor') { + @usertools = ('author'); + @options = ('norequest','approval','automatic'); + %titles = &authorrequest_titles(); } else { - @usertools = ('aboutme','blog','portfolio'); + @usertools = ('aboutme','blog','webdav','portfolio'); %titles = &tool_titles(); } if (ref($types) eq 'ARRAY') { foreach my $type (@{$types}) { my $currdefquota; - unless ($context eq 'requestcourses') { + unless (($context eq 'requestcourses') || + ($context eq 'requestauthor')) { if (ref($settings) eq 'HASH') { if (ref($settings->{defaultquota}) eq 'HASH') { $currdefquota = $settings->{defaultquota}->{$type}; @@ -1316,16 +1543,38 @@ sub print_quotas { $cell{$item} .= ' '; + $titles{$option}.''; if ($option eq 'autolimit') { - $cell{$item} .= ''; } - $cell{$item} .= '  '; + $cell{$item} .= '
'; if ($option eq 'autolimit') { - $cell{$item} .= $titles{'unlimited'} + $cell{$item} .= $titles{'unlimited'}; + } + } + } elsif ($context eq 'requestauthor') { + my $curroption; + if (ref($settings) eq 'HASH') { + $curroption = $settings->{$type}; + } + if (!$curroption) { + $curroption = 'norequest'; + } + foreach my $option (@options) { + my $val = $option; + if ($option eq 'norequest') { + $val = 0; } + my $checked = ''; + if ($option eq $curroption) { + $checked = ' checked="checked"'; + } + $datatable .= '  '; } } else { my $checked = 'checked="checked" '; @@ -1352,7 +1601,8 @@ sub print_quotas { $datatable .= ''; } $datatable .= ''; - unless ($context eq 'requestcourses') { + unless (($context eq 'requestcourses') || + ($context eq 'requestauthor')) { $datatable .= ''. ''. $titles{$option}.''; if ($option eq 'autolimit') { - $defcell{$item} .= ''; } - $defcell{$item} .= '  '; + $defcell{$item} .= ' '; if ($option eq 'autolimit') { - $defcell{$item} .= $titles{'unlimited'} + $defcell{$item} .= $titles{'unlimited'}; + } + } + } elsif ($context eq 'requestauthor') { + my $curroption; + if (ref($settings) eq 'HASH') { + $curroption = $settings->{'default'}; + } + if (!$curroption) { + $curroption = 'norequest'; + } + foreach my $option (@options) { + my $val = $option; + if ($option eq 'norequest') { + $val = 0; + } + my $checked = ''; + if ($option eq $curroption) { + $checked = ' checked="checked"'; } + $datatable .= '  '; } } else { my $checked = 'checked="checked" '; @@ -1458,7 +1730,7 @@ sub print_quotas { $datatable .= ''; } $datatable .= ''; - unless ($context eq 'requestcourses') { + unless (($context eq 'requestcourses') || ($context eq 'requestauthor')) { $datatable .= ''. ' Mb'; @@ -1527,15 +1799,42 @@ sub print_quotas { '__LC_adv" value="'.$val.'"'.$checked.' />'. $titles{$option}.''; if ($option eq 'autolimit') { - $advcell{$item} .= ''; } - $advcell{$item} .= '  '; + $advcell{$item} .= ' '; if ($option eq 'autolimit') { - $advcell{$item} .= $titles{'unlimited'} + $advcell{$item} .= $titles{'unlimited'}; } } + } elsif ($context eq 'requestauthor') { + my $curroption; + if (ref($settings) eq 'HASH') { + $curroption = $settings->{'_LC_adv'}; + } + my $checked = ''; + if ($curroption eq '') { + $checked = ' checked="checked"'; + } + $datatable .= '  '; + foreach my $option (@options) { + my $val = $option; + if ($option eq 'norequest') { + $val = 0; + } + my $checked = ''; + if ($val eq $curroption) { + $checked = ' checked="checked"'; + } + $datatable .= '  '; + } } else { my $checked = 'checked="checked" '; if (ref($settings) eq 'HASH') { @@ -1565,8 +1864,8 @@ sub print_quotas { return $datatable; } -sub print_courserequestmail { - my ($dom,$settings,$rowtotal) = @_; +sub print_requestmail { + my ($dom,$action,$settings,$rowtotal) = @_; my ($now,$datatable,%dompersonnel,@domcoord,@currapproval,$rows); $now = time; $rows = 0; @@ -1597,9 +1896,14 @@ sub print_courserequestmail { my $numinrow = 4; my $numdc = @domcoord; my $css_class = 'class="LC_odd_row"'; - $datatable = ''. - ' '.&mt('Receive notification of course requests requiring approval.'). - ' '. + my $text; + if ($action eq 'requestcourses') { + $text = &mt('Receive notification of course requests requiring approval'); + } else { + $text = &mt('Receive notification of authoring space requests requiring approval') + } + $datatable = ''. + ' '.$text.''. ' '; if (@domcoord > 0) { $datatable .= ''; @@ -1646,7 +1950,7 @@ sub print_courserequestmail { sub print_autoenroll { my ($dom,$settings,$rowtotal) = @_; my $autorun = &Apache::lonnet::auto_run(undef,$dom), - my ($defdom,$runon,$runoff); + my ($defdom,$runon,$runoff,$coownerson,$coownersoff); if (ref($settings) eq 'HASH') { if (exists($settings->{'run'})) { if ($settings->{'run'} eq '0') { @@ -1665,6 +1969,18 @@ sub print_autoenroll { $runon = ' '; } } + if (exists($settings->{'co-owners'})) { + if ($settings->{'co-owners'} eq '0') { + $coownersoff = ' checked="checked" '; + $coownerson = ' '; + } else { + $coownerson = ' checked="checked" '; + $coownersoff = ' '; + } + } else { + $coownersoff = ' checked="checked" '; + $coownerson = ' '; + } if (exists($settings->{'sender_domain'})) { $defdom = $settings->{'sender_domain'}; } @@ -1695,8 +2011,16 @@ sub print_autoenroll { &mt('username').': '. '  '.&mt('domain'). - ': '.$domform.''; - $$rowtotal += 2; + ': '.$domform.''. + ''. + ''. + ''. + ''; + $$rowtotal += 3; return $datatable; } @@ -1738,9 +2062,17 @@ sub print_autoupdate { $classlistsoff.'value="0" />'.&mt('No').''. ''; $$rowtotal += 2; + } elsif ($position eq 'middle') { + my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom); + my $numinrow = 3; + my $locknamesettings; + $datatable .= &insttypes_row($settings,$types,$usertypes, + $dom,$numinrow,$othertitle, + 'lockablenames'); + $$rowtotal ++; } else { my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom); - my @fields = ('lastname','firstname','middlename','gen', + my @fields = ('lastname','firstname','middlename','generation', 'permanentemail','id'); my %fieldtitles = &Apache::loncommon::personal_data_fieldtitles(); my $numrows = 0; @@ -1761,6 +2093,56 @@ sub print_autoupdate { return $datatable; } +sub print_autocreate { + my ($dom,$settings,$rowtotal) = @_; + my (%createon,%createoff); + my $curr_dc; + my @types = ('xml','req'); + if (ref($settings) eq 'HASH') { + foreach my $item (@types) { + $createoff{$item} = ' checked="checked" '; + $createon{$item} = ' '; + if (exists($settings->{$item})) { + if ($settings->{$item}) { + $createon{$item} = ' checked="checked" '; + $createoff{$item} = ' '; + } + } + } + $curr_dc = $settings->{'xmldc'}; + } else { + foreach my $item (@types) { + $createoff{$item} = ' checked="checked" '; + $createon{$item} = ' '; + } + } + $$rowtotal += 2; + my $datatable=''. + ''. + ''. + ''. + ''; + $$rowtotal ++ ; + } else { + $datatable .= $dctable.''; + } + return $datatable; +} + sub print_directorysrch { my ($dom,$settings,$rowtotal) = @_; my $srchon = ' '; @@ -1878,12 +2260,13 @@ sub print_contacts { my ($dom,$settings,$rowtotal) = @_; my $datatable; my @contacts = ('adminemail','supportemail'); - my (%checked,%to,%otheremails); + my (%checked,%to,%otheremails,%bccemails); my @mailings = ('errormail','packagesmail','lonstatusmail','helpdeskmail', 'requestsmail'); foreach my $type (@mailings) { $otheremails{$type} = ''; } + $bccemails{'helpdeskmail'} = ''; if (ref($settings) eq 'HASH') { foreach my $item (@contacts) { if (exists($settings->{$item})) { @@ -1899,6 +2282,9 @@ sub print_contacts { } } $otheremails{$type} = $settings->{$type}{'others'}; + if ($type eq 'helpdeskmail') { + $bccemails{$type} = $settings->{$type}{'bcc'}; + } } } elsif ($type eq 'lonstatusmail') { $checked{'lonstatusmail'}{'adminemail'} = ' checked="checked" '; @@ -1942,107 +2328,34 @@ sub print_contacts { } $datatable .= '
'.&mt('Others').':  '. ''. - ''."\n"; + 'value="'.$otheremails{$type}.'" />'; + if ($type eq 'helpdeskmail') { + $datatable .= '
'.&mt('Bcc:').(' 'x6). + ''; + } + $datatable .= ''."\n"; } $$rowtotal += $rownum; return $datatable; } sub print_helpsettings { + my ($dom,$confname,$settings,$rowtotal) = @_; + my ($datatable,$itemcount); + $itemcount = 1; + my (%choices,%defaultchecked,@toggles); + $choices{'submitbugs'} = &mt('Display link to: [_1]?', + &Apache::loncommon::modal_link('http://bugs.loncapa.org', + &mt('LON-CAPA bug tracker'),600,500)); + %defaultchecked = ('submitbugs' => 'on'); + @toggles = ('submitbugs',); - my ($position,$dom,$confname,$settings,$rowtotal) = @_; - my ($css_class,$datatable); - - my $switchserver = &check_switchserver($dom,$confname); - - my $itemcount = 1; - - if ($position eq 'top') { - - my (%checkedon,%checkedoff,%choices,%defaultchecked,@toggles); - - %choices = - &Apache::lonlocal::texthash ( - submitbugs => 'Display "Submit a bug" link?', - ); - - %defaultchecked = ('submitbugs' => 'on'); - - @toggles = ('submitbugs',); - - foreach my $item (@toggles) { - if ($defaultchecked{$item} eq 'on') { - $checkedon{$item} = ' checked="checked" '; - $checkedoff{$item} = ' '; - } elsif ($defaultchecked{$item} eq 'off') { - $checkedoff{$item} = ' checked="checked" '; - $checkedon{$item} = ' '; - } - } - - if (ref($settings) eq 'HASH') { - foreach my $item (@toggles) { - if ($settings->{$item} eq '1') { - $checkedon{$item} = ' checked="checked" '; - $checkedoff{$item} = ' '; - } elsif ($settings->{$item} eq '0') { - $checkedoff{$item} = ' checked="checked" '; - $checkedon{$item} = ' '; - } - } - } - - foreach my $item (@toggles) { - $css_class = $itemcount%2 ? ' class="LC_odd_row"' : ''; - $datatable .= - ' - - - '. - ''; - $itemcount ++; - } - - } else { - - $css_class = $itemcount%2 ? ' class="LC_odd_row"' : ''; - - $datatable .= ''; - - if (ref($settings) eq 'HASH') { - if ($settings->{'loginhelpurl'} ne '') { - my($directory, $filename) = $settings->{'loginhelpurl'} =~ m/(.*\/)(.*)$/; - $datatable .= ''; - $datatable .= '' - } else { - $datatable .= ''; - $datatable .= ''; - } - } else { - $datatable .= ''; - $datatable .= ''; - } - - $datatable .= ''; - - } - - return $datatable; - + ($datatable,$itemcount) = &radiobutton_prefs($settings,\@toggles,\%defaultchecked, + \%choices,$itemcount); + return $datatable; } - sub radiobutton_prefs { my ($settings,$toggles,$defaultchecked,$choices,$itemcount) = @_; return unless ((ref($toggles) eq 'ARRAY') && (ref($defaultchecked) eq 'HASH') && @@ -2088,35 +2401,782 @@ sub radiobutton_prefs { } sub print_coursedefaults { - my ($dom,$settings,$rowtotal) = @_; + my ($position,$dom,$settings,$rowtotal) = @_; my ($css_class,$datatable); my $itemcount = 1; - my (%checkedon,%checkedoff,%choices,%defaultchecked,@toggles); - $css_class = $itemcount%2 ? ' class="LC_odd_row"' : ''; - my %choices = - &Apache::lonlocal::texthash ( - anonsurvey_threshold => 'Responder count needed before showing submissions for anonymous surveys', - ); - my $currdefresponder; - if (ref($settings) eq 'HASH') { - $currdefresponder = $settings->{'anonsurvey_threshold'}; + if ($position eq 'top') { + my (%checkedon,%checkedoff,%choices,%defaultchecked,@toggles); + %choices = + &Apache::lonlocal::texthash ( + canuse_pdfforms => 'Course/Community users can create/upload PDF forms', + ); + %defaultchecked = ('canuse_pdfforms' => 'off'); + @toggles = ('canuse_pdfforms',); + ($datatable,$itemcount) = &radiobutton_prefs($settings,\@toggles,\%defaultchecked, + \%choices,$itemcount); + $$rowtotal += $itemcount; + } else { + $css_class = $itemcount%2 ? ' class="LC_odd_row"' : ''; + my %choices = + &Apache::lonlocal::texthash ( + anonsurvey_threshold => 'Responder count needed before showing submissions for anonymous surveys', + ); + my $currdefresponder; + if (ref($settings) eq 'HASH') { + $currdefresponder = $settings->{'anonsurvey_threshold'}; + } + if (!$currdefresponder) { + $currdefresponder = 10; + } elsif ($currdefresponder < 1) { + $currdefresponder = 1; + } + $datatable .= + ''. + ''; } - if (!$currdefresponder) { - $currdefresponder = 10; - } elsif ($currdefresponder < 1) { - $currdefresponder = 1; + return $datatable; +} + +sub print_usersessions { + my ($position,$dom,$settings,$rowtotal) = @_; + my ($css_class,$datatable,%checked,%choices); + my (%by_ip,%by_location,@intdoms); + &build_location_hashes(\@intdoms,\%by_ip,\%by_location); + + my @alldoms = &Apache::lonnet::all_domains(); + my %serverhomes = %Apache::lonnet::serverhomeIDs; + my %servers = &Apache::lonnet::internet_dom_servers($dom); + my %altids = &id_for_thisdom(%servers); + my $itemcount = 1; + if ($position eq 'top') { + if (keys(%serverhomes) > 1) { + my %spareid = ¤t_offloads_to($dom,$settings,\%servers); + $datatable .= &spares_row($dom,\%servers,\%spareid,\%serverhomes,\%altids,$rowtotal); + } else { + $datatable .= ''; + $itemcount ++; + } + } } - $datatable .= - ''. - ''; $$rowtotal += $itemcount; return $datatable; } +sub build_location_hashes { + my ($intdoms,$by_ip,$by_location) = @_; + return unless((ref($intdoms) eq 'ARRAY') && (ref($by_ip) eq 'HASH') && + (ref($by_location) eq 'HASH')); + my %iphost = &Apache::lonnet::get_iphost(); + my $primary_id = &Apache::lonnet::domain($env{'request.role.domain'},'primary'); + my $primary_ip = &Apache::lonnet::get_host_ip($primary_id); + if (ref($iphost{$primary_ip}) eq 'ARRAY') { + foreach my $id (@{$iphost{$primary_ip}}) { + my $intdom = &Apache::lonnet::internet_dom($id); + unless(grep(/^\Q$intdom\E$/,@{$intdoms})) { + push(@{$intdoms},$intdom); + } + } + } + foreach my $ip (keys(%iphost)) { + if (ref($iphost{$ip}) eq 'ARRAY') { + foreach my $id (@{$iphost{$ip}}) { + my $location = &Apache::lonnet::internet_dom($id); + if ($location) { + next if (grep(/^\Q$location\E$/,@{$intdoms})); + if (ref($by_ip->{$ip}) eq 'ARRAY') { + unless(grep(/^\Q$location\E$/,@{$by_ip->{$ip}})) { + push(@{$by_ip->{$ip}},$location); + } + } else { + $by_ip->{$ip} = [$location]; + } + } + } + } + } + foreach my $ip (sort(keys(%{$by_ip}))) { + if (ref($by_ip->{$ip}) eq 'ARRAY') { + @{$by_ip->{$ip}} = sort(@{$by_ip->{$ip}}); + my $first = $by_ip->{$ip}->[0]; + if (ref($by_location->{$first}) eq 'ARRAY') { + unless (grep(/^\Q$ip\E$/,@{$by_location->{$first}})) { + push(@{$by_location->{$first}},$ip); + } + } else { + $by_location->{$first} = [$ip]; + } + } + } + return; +} + +sub current_offloads_to { + my ($dom,$settings,$servers) = @_; + my (%spareid,%otherdomconfigs); + if (ref($servers) eq 'HASH') { + foreach my $lonhost (sort(keys(%{$servers}))) { + my $gotspares; + if (ref($settings) eq 'HASH') { + if (ref($settings->{'spares'}) eq 'HASH') { + if (ref($settings->{'spares'}{$lonhost}) eq 'HASH') { + $spareid{$lonhost}{'primary'} = $settings->{'spares'}{$lonhost}{'primary'}; + $spareid{$lonhost}{'default'} = $settings->{'spares'}{$lonhost}{'default'}; + $gotspares = 1; + } + } + } + unless ($gotspares) { + my $gotspares; + my $serverhomeID = + &Apache::lonnet::get_server_homeID($servers->{$lonhost}); + my $serverhomedom = + &Apache::lonnet::host_domain($serverhomeID); + if ($serverhomedom ne $dom) { + if (ref($otherdomconfigs{$serverhomedom} eq 'HASH')) { + if (ref($otherdomconfigs{$serverhomedom}{'usersessions'}) eq 'HASH') { + if (ref($otherdomconfigs{$serverhomedom}{'usersessions'}{'spares'}) eq 'HASH') { + $spareid{$lonhost}{'primary'} = $otherdomconfigs{$serverhomedom}{'usersessions'}{'spares'}{'primary'}; + $spareid{$lonhost}{'default'} = $otherdomconfigs{$serverhomedom}{'usersessions'}{'spares'}{'default'}; + $gotspares = 1; + } + } + } else { + $otherdomconfigs{$serverhomedom} = + &Apache::lonnet::get_dom('configuration',['usersessions'],$serverhomedom); + if (ref($otherdomconfigs{$serverhomedom}) eq 'HASH') { + if (ref($otherdomconfigs{$serverhomedom}{'usersessions'}) eq 'HASH') { + if (ref($otherdomconfigs{$serverhomedom}{'usersessions'}{'spares'}) eq 'HASH') { + if (ref($otherdomconfigs{$serverhomedom}{'usersessions'}{'spares'}{$lonhost}) eq 'HASH') { + $spareid{$lonhost}{'primary'} = $otherdomconfigs{$serverhomedom}{'usersessions'}{'spares'}{'primary'}; + $spareid{$lonhost}{'default'} = $otherdomconfigs{$serverhomedom}{'usersessions'}{'spares'}{'default'}; + $gotspares = 1; + } + } + } + } + } + } + } + unless ($gotspares) { + if ($lonhost eq $Apache::lonnet::perlvar{'lonHostID'}) { + $spareid{$lonhost}{'primary'} = $Apache::lonnet::spareid{'primary'}; + $spareid{$lonhost}{'default'} = $Apache::lonnet::spareid{'default'}; + } else { + my $server_hostname = &Apache::lonnet::hostname($lonhost); + my $server_homeID = &Apache::lonnet::get_server_homeID($server_hostname); + if ($server_homeID eq $Apache::lonnet::perlvar{'lonHostID'}) { + $spareid{$lonhost}{'primary'} = $Apache::lonnet::spareid{'primary'}; + $spareid{$lonhost}{'default'} = $Apache::lonnet::spareid{'default'}; + } else { + my %what = ( + spareid => 1, + ); + my ($result,$returnhash) = + &Apache::lonnet::get_remote_globals($lonhost,\%what); + if ($result eq 'ok') { + if (ref($returnhash) eq 'HASH') { + if (ref($returnhash->{'spareid'}) eq 'HASH') { + $spareid{$lonhost}{'primary'} = $returnhash->{'spareid'}->{'primary'}; + $spareid{$lonhost}{'default'} = $returnhash->{'spareid'}->{'default'}; + } + } + } + } + } + } + } + } + return %spareid; +} + +sub spares_row { + my ($dom,$servers,$spareid,$serverhomes,$altids,$rowtotal) = @_; + my $css_class; + my $numinrow = 4; + my $itemcount = 1; + my $datatable; + my %typetitles = &sparestype_titles(); + if ((ref($servers) eq 'HASH') && (ref($spareid) eq 'HASH') && (ref($altids) eq 'HASH')) { + foreach my $server (sort(keys(%{$servers}))) { + my $serverhome = &Apache::lonnet::get_server_homeID($servers->{$server}); + my ($othercontrol,$serverdom); + if ($serverhome ne $server) { + $serverdom = &Apache::lonnet::host_domain($serverhome); + $othercontrol = &mt('Session offloading controlled by domain: [_1]',''.$serverdom.''); + } else { + $serverdom = &Apache::lonnet::host_domain($server); + if ($serverdom ne $dom) { + $othercontrol = &mt('Session offloading controlled by domain: [_1]',''.$serverdom.''); + } + } + next unless (ref($spareid->{$server}) eq 'HASH'); + $css_class = $itemcount%2 ? ' class="LC_odd_row"' : ''; + $datatable .= ' + '."\n"; + my (%current,%canselect); + my @choices = + &possible_newspares($server,$spareid->{$server},$serverhomes,$altids); + foreach my $type ('primary','default') { + if (ref($spareid->{$server}) eq 'HASH') { + if (ref($spareid->{$server}{$type}) eq 'ARRAY') { + my @spares = @{$spareid->{$server}{$type}}; + if (@spares > 0) { + if ($othercontrol) { + $current{$type} = join(', ',@spares); + } else { + $current{$type} .= '
'.&mt('Automatically assign co-ownership').' '. + '
'.&mt('Create pending official courses from XML files').' '. + ''. + '
'.&mt('Create pending requests for official courses (if validated)').' '. + ''; + my ($numdc,$dctable) = &active_dc_picker($dom,$curr_dc); + if ($numdc > 1) { + $datatable .= '
'. + &mt('Course creation processed as: (choose Dom. Coord.)'). + ''.$dctable.'
'.$choices{$item}.'  -   - '. - '
   '; - if ($switchserver) { - $datatable .= &mt('Upload to library server: [_1]',$switchserver); - } else { - $datatable .= &mt('Upload Custom Login Page Help File:'); - $datatable .=''; - } - $datatable .= '
'.$choices{'anonsurvey_threshold'}. + ''. + ''. + '
'. + &mt('Nothing to set here, as the cluster to which this domain belongs only contains one server.'); + } + } else { + if (keys(%by_location) == 0) { + $datatable .= ''. + &mt('Nothing to set here, as the cluster to which this domain belongs only contains one institution.'); + } else { + my %lt = &usersession_titles(); + my $numinrow = 5; + my $prefix; + my @types; + if ($position eq 'bottom') { + $prefix = 'remote'; + @types = ('version','excludedomain','includedomain'); + } else { + $prefix = 'hosted'; + @types = ('excludedomain','includedomain'); + } + my (%current,%checkedon,%checkedoff); + my @lcversions = &Apache::lonnet::all_loncaparevs(); + my @locations = sort(keys(%by_location)); + foreach my $type (@types) { + $checkedon{$type} = ''; + $checkedoff{$type} = ' checked="checked"'; + } + if (ref($settings) eq 'HASH') { + if (ref($settings->{$prefix}) eq 'HASH') { + foreach my $key (keys(%{$settings->{$prefix}})) { + $current{$key} = $settings->{$prefix}{$key}; + if ($key eq 'version') { + if ($current{$key} ne '') { + $checkedon{$key} = ' checked="checked"'; + $checkedoff{$key} = ''; + } + } elsif (ref($current{$key}) eq 'ARRAY') { + $checkedon{$key} = ' checked="checked"'; + $checkedoff{$key} = ''; + } + } + } + } + foreach my $type (@types) { + next if ($type ne 'version' && !@locations); + $css_class = $itemcount%2 ? ' class="LC_odd_row"' : ''; + $datatable .= ' + '.$lt{$type}.'
+   +   +
'; + if ($type eq 'version') { + my $selector = ' '; + $datatable .= &mt('remote server must be version: [_1] or later',$selector); + } else { + $datatable.= '
'.(' 'x2). + ''. + "\n". + '
'; + my $rem; + for (my $i=0; $i<@locations; $i++) { + my ($showloc,$value,$checkedtype); + if (ref($by_location{$locations[$i]}) eq 'ARRAY') { + my $ip = $by_location{$locations[$i]}->[0]; + if (ref($by_ip{$ip}) eq 'ARRAY') { + $value = join(':',@{$by_ip{$ip}}); + $showloc = join(', ',@{$by_ip{$ip}}); + if (ref($current{$type}) eq 'ARRAY') { + foreach my $loc (@{$by_ip{$ip}}) { + if (grep(/^\Q$loc\E$/,@{$current{$type}})) { + $checkedtype = ' checked="checked"'; + last; + } + } + } + } + } + $rem = $i%($numinrow); + if ($rem == 0) { + if ($i > 0) { + $datatable .= ''; + } + $datatable .= ''; + } + $datatable .= ''; + } + $rem = @locations%($numinrow); + my $colsleft = $numinrow - $rem; + if ($colsleft > 1 ) { + $datatable .= ''; + } elsif ($colsleft == 1) { + $datatable .= ''; + } + $datatable .= '
'. + ''. + '  
'; + } + $datatable .= '
'.$choices{'anonsurvey_threshold'}. - ''. - ''. - '
+ '.$server.' when busy, offloads to:
'; + my $numspares = scalar(@spares); + for (my $i=0; $i<@spares; $i++) { + my $rem = $i%($numinrow); + if ($rem == 0) { + if ($i > 0) { + $current{$type} .= ''; + } + $current{$type} .= ''; + } + $current{$type} .= ''."\n"; + } + my $rem = @spares%($numinrow); + my $colsleft = $numinrow - $rem; + if ($colsleft > 1 ) { + $current{$type} .= ''; + } elsif ($colsleft == 1) { + $current{$type} .= ''."\n"; + } + $current{$type} .= '
'. + '  
'; + } + } + } + if ($current{$type} eq '') { + $current{$type} = &mt('None specified'); + } + if ($othercontrol) { + if ($type eq 'primary') { + $canselect{$type} = $othercontrol; + } + } else { + $canselect{$type} = + &mt('Add new [_1]'.$type.'[_2]:','','').' '. + ''."\n"; + } + } else { + $current{$type} = &mt('Could not be determined'); + if ($type eq 'primary') { + $canselect{$type} = $othercontrol; + } + } + if ($type eq 'default') { + $datatable .= ''; + } + $datatable .= ''.$typetitles{$type}.''."\n". + ''.$current{$type}.''."\n". + ''.$canselect{$type}.''."\n"; + } + $itemcount ++; + } + } + $$rowtotal += $itemcount; + return $datatable; +} + +sub possible_newspares { + my ($server,$currspares,$serverhomes,$altids) = @_; + my $serverhostname = &Apache::lonnet::hostname($server); + my %excluded; + if ($serverhostname ne '') { + %excluded = ( + $serverhostname => 1, + ); + } + if (ref($currspares) eq 'HASH') { + foreach my $type (keys(%{$currspares})) { + if (ref($currspares->{$type}) eq 'ARRAY') { + if (@{$currspares->{$type}} > 0) { + foreach my $curr (@{$currspares->{$type}}) { + my $hostname = &Apache::lonnet::hostname($curr); + $excluded{$hostname} = 1; + } + } + } + } + } + my @choices; + if ((ref($serverhomes) eq 'HASH') && (ref($altids) eq 'HASH')) { + if (keys(%{$serverhomes}) > 1) { + foreach my $name (sort(keys(%{$serverhomes}))) { + unless ($excluded{$name}) { + if (exists($altids->{$serverhomes->{$name}})) { + push(@choices,$altids->{$serverhomes->{$name}}); + } else { + push(@choices,$serverhomes->{$name}); + } + } + } + } + } + return sort(@choices); +} + +sub print_loadbalancing { + my ($dom,$settings,$rowtotal) = @_; + my $primary_id = &Apache::lonnet::domain($dom,'primary'); + my $intdom = &Apache::lonnet::internet_dom($primary_id); + my $numinrow = 1; + my $datatable; + my %servers = &Apache::lonnet::internet_dom_servers($dom); + my (%currbalancer,%currtargets,%currrules,%existing); + if (ref($settings) eq 'HASH') { + %existing = %{$settings}; + } + if ((keys(%servers) > 1) || (keys(%existing) > 0)) { + &get_loadbalancers_config(\%servers,\%existing,\%currbalancer, + \%currtargets,\%currrules); + } else { + return; + } + my ($othertitle,$usertypes,$types) = + &Apache::loncommon::sorted_inst_types($dom); + my $rownum = 6; + if (ref($types) eq 'ARRAY') { + $rownum += scalar(@{$types}); + } + my @css_class = ('LC_odd_row','LC_even_row'); + my $balnum = 0; + my $islast; + my (@toshow,$disabledtext); + if (keys(%currbalancer) > 0) { + @toshow = sort(keys(%currbalancer)); + if (scalar(@toshow) < scalar(keys(%servers)) + 1) { + push(@toshow,''); + } + } else { + @toshow = (''); + $disabledtext = &mt('No existing load balancer'); + } + foreach my $lonhost (@toshow) { + if ($balnum == scalar(@toshow)-1) { + $islast = 1; + } else { + $islast = 0; + } + my $cssidx = $balnum%2; + my $targets_div_style = 'display: none'; + my $disabled_div_style = 'display: block'; + my $homedom_div_style = 'display: none'; + $datatable .= ''. + ''. + '

'; + if ($lonhost eq '') { + $datatable .= ''; + if (keys(%currbalancer) > 0) { + $datatable .= &mt('Add balancer:'); + } else { + $datatable .= &mt('Enable balancer:'); + } + $datatable .= ' '. + ''."\n". + ' '."\n"; + } else { + $datatable .= ''.$lonhost.'
'. + ''. + ''; + $targets_div_style = 'display: block'; + $disabled_div_style = 'display: none'; + if ($dom eq &Apache::lonnet::host_domain($lonhost)) { + $homedom_div_style = 'display: block'; + } + } + $datatable .= '

'. + '
'.$disabledtext.'
'."\n". + '
'.&mt('Offloads to:').'
'; + my ($numspares,@spares) = &count_servers($lonhost,%servers); + my @sparestypes = ('primary','default'); + my %typetitles = &sparestype_titles(); + foreach my $sparetype (@sparestypes) { + my $targettable; + for (my $i=0; $i<$numspares; $i++) { + my $checked; + if (ref($currtargets{$lonhost}) eq 'HASH') { + if (ref($currtargets{$lonhost}{$sparetype}) eq 'ARRAY') { + if (grep(/^\Q$spares[$i]\E$/,@{$currtargets{$lonhost}{$sparetype}})) { + $checked = ' checked="checked"'; + } + } + } + my ($chkboxval,$disabled); + if (($lonhost ne '') && (exists($servers{$lonhost}))) { + $chkboxval = $spares[$i]; + } + if (exists($currbalancer{$spares[$i]})) { + $disabled = ' disabled="disabled"'; + } + $targettable .= + ''; + my $rem = $i%($numinrow); + if ($rem == 0) { + if (($i > 0) && ($i < $numspares-1)) { + $targettable .= ''; + } + if ($i < $numspares-1) { + $targettable .= ''; + } + } + } + if ($targettable ne '') { + my $rem = $numspares%($numinrow); + my $colsleft = $numinrow - $rem; + if ($colsleft > 1 ) { + $targettable .= ''. + ' '; + } elsif ($colsleft == 1) { + $targettable .= ' '; + } + $datatable .= ''.$typetitles{$sparetype}.'
'. + ''.$targettable.'

'; + } + } + my $cssidx = $balnum%2; + $datatable .= '
'. + &loadbalancing_rules($dom,$intdom,$currrules{$lonhost}, + $othertitle,$usertypes,$types,\%servers, + \%currbalancer,$lonhost, + $targets_div_style,$homedom_div_style, + $css_class[$cssidx],$balnum,$islast); + $$rowtotal += $rownum; + $balnum ++; + } + $datatable .= ''; + return $datatable; +} + +sub get_loadbalancers_config { + my ($servers,$existing,$currbalancer,$currtargets,$currrules) = @_; + return unless ((ref($servers) eq 'HASH') && + (ref($existing) eq 'HASH') && (ref($currbalancer) eq 'HASH') && + (ref($currtargets) eq 'HASH') && (ref($currrules) eq 'HASH')); + if (keys(%{$existing}) > 0) { + my $oldlonhost; + foreach my $key (sort(keys(%{$existing}))) { + if ($key eq 'lonhost') { + $oldlonhost = $existing->{'lonhost'}; + $currbalancer->{$oldlonhost} = 1; + } elsif ($key eq 'targets') { + if ($oldlonhost) { + $currtargets->{$oldlonhost} = $existing->{'targets'}; + } + } elsif ($key eq 'rules') { + if ($oldlonhost) { + $currrules->{$oldlonhost} = $existing->{'rules'}; + } + } elsif (ref($existing->{$key}) eq 'HASH') { + $currbalancer->{$key} = 1; + $currtargets->{$key} = $existing->{$key}{'targets'}; + $currrules->{$key} = $existing->{$key}{'rules'}; + } + } + } else { + my ($balancerref,$targetsref) = + &Apache::lonnet::get_lonbalancer_config($servers); + if ((ref($balancerref) eq 'HASH') && (ref($targetsref) eq 'HASH')) { + foreach my $server (sort(keys(%{$balancerref}))) { + $currbalancer->{$server} = 1; + $currtargets->{$server} = $targetsref->{$server}; + } + } + } + return; +} + +sub loadbalancing_rules { + my ($dom,$intdom,$currrules,$othertitle,$usertypes,$types,$servers, + $currbalancer,$lonhost,$targets_div_style,$homedom_div_style, + $css_class,$balnum,$islast) = @_; + my $output; + my $num = 0; + my ($alltypes,$othertypes,$titles) = + &loadbalancing_titles($dom,$intdom,$usertypes,$types); + if ((ref($alltypes) eq 'ARRAY') && (ref($titles) eq 'HASH')) { + foreach my $type (@{$alltypes}) { + $num ++; + my $current; + if (ref($currrules) eq 'HASH') { + $current = $currrules->{$type}; + } + if (($type eq '_LC_external') || ($type eq '_LC_internetdom')) { + if ($dom ne &Apache::lonnet::host_domain($lonhost)) { + $current = ''; + } + } + $output .= &loadbalance_rule_row($type,$titles->{$type},$current, + $servers,$currbalancer,$lonhost,$dom, + $targets_div_style,$homedom_div_style, + $css_class,$balnum,$num,$islast); + } + } + return $output; +} + +sub loadbalancing_titles { + my ($dom,$intdom,$usertypes,$types) = @_; + my %othertypes = ( + '_LC_adv' => &mt('Advanced users from [_1]',$dom), + '_LC_author' => &mt('Users from [_1] with author role',$dom), + '_LC_internetdom' => &mt('Users not from [_1], but from [_2]',$dom,$intdom), + '_LC_external' => &mt('Users not from [_1]',$intdom), + ); + my @alltypes = ('_LC_adv','_LC_author','_LC_internetdom','_LC_external'); + if (ref($types) eq 'ARRAY') { + unshift(@alltypes,@{$types},'default'); + } + my %titles; + foreach my $type (@alltypes) { + if ($type =~ /^_LC_/) { + $titles{$type} = $othertypes{$type}; + } elsif ($type eq 'default') { + $titles{$type} = &mt('All users from [_1]',$dom); + if (ref($types) eq 'ARRAY') { + if (@{$types} > 0) { + $titles{$type} = &mt('Other users from [_1]',$dom); + } + } + } elsif (ref($usertypes) eq 'HASH') { + $titles{$type} = $usertypes->{$type}; + } + } + return (\@alltypes,\%othertypes,\%titles); +} + +sub loadbalance_rule_row { + my ($type,$title,$current,$servers,$currbalancer,$lonhost,$dom, + $targets_div_style,$homedom_div_style,$css_class,$balnum,$num,$islast) = @_; + my @rulenames = ('default','homeserver'); + my %ruletitles = &offloadtype_text(); + if ($type eq '_LC_external') { + push(@rulenames,'externalbalancer'); + } else { + push(@rulenames,'specific'); + } + push(@rulenames,'none'); + my $style = $targets_div_style; + if (($type eq '_LC_external') || ($type eq '_LC_internetdom')) { + $style = $homedom_div_style; + } + my $space; + if ($islast && $num == 1) { + $space = '
 
'; + } + my $output = + ''.$space. + '
'.$title.'
'."\n". + ''.$space. + '
'."\n"; + for (my $i=0; $i<@rulenames; $i++) { + my $rule = $rulenames[$i]; + my ($checked,$extra); + if ($rulenames[$i] eq 'default') { + $rule = ''; + } + if ($rulenames[$i] eq 'specific') { + if (ref($servers) eq 'HASH') { + my $default; + if (($current ne '') && (exists($servers->{$current}))) { + $checked = ' checked="checked"'; + } + unless ($checked) { + $default = ' selected="selected"'; + } + $extra = + ': '; + } + } elsif ($rule eq $current) { + $checked = ' checked="checked"'; + } + $output .= ''.$extra.'
'."\n"; + } + $output .= '
'."\n"; + return $output; +} + +sub offloadtype_text { + my %ruletitles = &Apache::lonlocal::texthash ( + 'default' => 'Offloads to default destinations', + 'homeserver' => "Offloads to user's home server", + 'externalbalancer' => "Offloads to Load Balancer in user's domain", + 'specific' => 'Offloads to specific server', + 'none' => 'No offload', + ); + return %ruletitles; +} + +sub sparestype_titles { + my %typestitles = &Apache::lonlocal::texthash ( + 'primary' => 'primary', + 'default' => 'default', + ); + return %typestitles; +} + sub contact_titles { my %titles = &Apache::lonlocal::texthash ( 'supportemail' => 'Support E-mail address', @@ -2136,8 +3196,9 @@ sub contact_titles { sub tool_titles { my %titles = &Apache::lonlocal::texthash ( - aboutme => 'Personal Information Page', + aboutme => 'Personal web page', blog => 'Blog', + webdav => 'WebDAV', portfolio => 'Portfolio', official => 'Official courses (with institutional codes)', unofficial => 'Unofficial courses', @@ -2160,6 +3221,15 @@ sub courserequest_titles { return %titles; } +sub authorrequest_titles { + my %titles = &Apache::lonlocal::texthash ( + norequest => 'Not allowed', + approval => 'Approval by Dom. Coord.', + automatic => 'Automatic approval', + ); + return %titles; +} + sub courserequest_conditions { my %conditions = &Apache::lonlocal::texthash ( approval => '(Processing of request subject to approval by Domain Coordinator).', @@ -2289,18 +3359,20 @@ sub print_usercreation { } my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom); + my $createsettings; + if (ref($settings) eq 'HASH') { + $createsettings = $settings->{cancreate}; + } if (ref($usertypes) eq 'HASH') { if (keys(%{$usertypes}) > 0) { - my $createsettings; - if (ref($settings) eq 'HASH') { - $createsettings = $settings->{cancreate}; - } $datatable .= &insttypes_row($createsettings,$types,$usertypes, $dom,$numinrow,$othertitle, 'statustocreate'); $$rowtotal ++; + $rownum ++; } } + $datatable .= &captcha_choice('cancreate',$createsettings,$rownum); } else { my @contexts = ('author','course','domain'); my @authtypes = ('int','krb4','krb5','loc'); @@ -2352,6 +3424,64 @@ sub print_usercreation { return $datatable; } +sub captcha_choice { + my ($context,$settings,$itemcount) = @_; + my ($keyentry,$currpub,$currpriv,%checked,$rowname,$pubtext,$privtext); + my %lt = &captcha_phrases(); + $keyentry = 'hidden'; + if ($context eq 'cancreate') { + $rowname = &mt('CAPTCHA validation (e-mail as username)'); + } elsif ($context eq 'login') { + $rowname = &mt('"Contact helpdesk" CAPTCHA validation'); + } + if (ref($settings) eq 'HASH') { + if ($settings->{'captcha'}) { + $checked{$settings->{'captcha'}} = ' checked="checked"'; + } else { + $checked{'original'} = ' checked="checked"'; + } + if ($settings->{'captcha'} eq 'recaptcha') { + $pubtext = $lt{'pub'}; + $privtext = $lt{'priv'}; + $keyentry = 'text'; + } + if (ref($settings->{'recaptchakeys'}) eq 'HASH') { + $currpub = $settings->{'recaptchakeys'}{'public'}; + $currpriv = $settings->{'recaptchakeys'}{'private'}; + } + } else { + $checked{'original'} = ' checked="checked"'; + } + my $css_class = $itemcount%2?' class="LC_odd_row"':''; + my $output = ''. + ''.$rowname.''."\n". + ''."\n". + '
'."\n"; + foreach my $option ('original','recaptcha','notused') { + $output .= ''; + unless ($option eq 'notused') { + $output .= (' 'x2)."\n"; + } + } +# +# Note: If reCAPTCHA is to be used for LON-CAPA servers in a domain, a domain coordinator should visit: +# https://www.google.com/recaptcha and generate a Public and Private key. For domains with multiple +# servers a single key pair will be used for all servers, so the internet domain (e.g., yourcollege.edu) +# specified for use with the key should be broad enough to accommodate all servers in the LON-CAPA domain. +# + $output .= '
'."\n". + ''.$pubtext.' '."\n". + '
'."\n". + ''.$privtext.' '."\n". + '
'."\n". + ''; + return $output; +} + sub user_formats_row { my ($type,$settings,$rules,$ruleorder,$numinrow,$rowcount) = @_; my $output; @@ -2526,6 +3656,12 @@ sub print_defaults { } elsif ($item eq 'datelocale_def') { my $includeempty = 1; $datatable .= &Apache::loncommon::select_datelocale($item,$domdefaults{$item},undef,$includeempty); + } elsif ($item eq 'lang_def') { + my %langchoices = &get_languages_hash(); + $langchoices{''} = 'No language preference'; + %langchoices = &Apache::lonlocal::texthash(%langchoices); + $datatable .= &Apache::loncommon::select_form($domdefaults{$item},$item, + \%langchoices); } else { my $size; if ($item eq 'portal_def') { @@ -2541,6 +3677,17 @@ sub print_defaults { return $datatable; } +sub get_languages_hash { + my %langchoices; + foreach my $id (&Apache::loncommon::languageids()) { + my $code = &Apache::loncommon::supportedlanguagecode($id); + if ($code ne '') { + $langchoices{$code} = &Apache::loncommon::plainlanguagedescription($id); + } + } + return %langchoices; +} + sub defaults_titles { my ($dom) = @_; my %titles = &Apache::lonlocal::texthash ( @@ -2674,7 +3821,7 @@ sub print_scantronformat { ''; if ($scantronurl) { $datatable .= ''. - &mt('Default scantron format file').''; + &mt('Default bubblesheet format file').''; } else { $datatable = &mt('File unavailable for display'); } @@ -2701,7 +3848,7 @@ sub print_scantronformat { } elsif ($scantronurl) { $datatable .= ''. ''. - &mt('Custom scantron format file').''. ' '. @@ -2730,7 +3877,7 @@ sub legacy_scantronformat { &publishlogo($r,'copy',$legacyfile,$dom,$confname,'scantron', '','',$newfile); if ($result ne 'ok') { - $error = &mt("An error occurred publishing the [_1] scantron format file in RES space. Error was: [_2].",$newfile,$result); + $error = &mt("An error occurred publishing the [_1] bubblesheet format file in RES space. Error was: [_2].",$newfile,$result); } } return ($url,$error); @@ -3002,7 +4149,7 @@ sub print_serverstatuses { sub serverstatus_pages { return ('userstatus','lonstatus','loncron','server-status','codeversions', 'clusterstatus','metadata_keywords','metadata_harvest', - 'takeoffline','takeonline','showenv','toggledebug'); + 'takeoffline','takeonline','showenv','toggledebug','ping','domconf'); } sub coursecategories_javascript { @@ -3310,14 +4457,19 @@ sub insttypes_row { my %lt = &Apache::lonlocal::texthash ( cansearch => 'Users allowed to search', statustocreate => 'Institutional affiliation(s) able to create own account (login/SSO)', + lockablenames => 'User preference to lock name', ); my $showdom; if ($context eq 'cansearch') { $showdom = ' ('.$dom.')'; } + my $class = 'LC_left_item'; + if ($context eq 'statustocreate') { + $class = 'LC_right_item'; + } my $output = ''. ''.$lt{$context}.$showdom. - ''; + '
'; my $rem; if (ref($types) eq 'ARRAY') { for (my $i=0; $i<@{$types}; $i++) { @@ -3346,10 +4498,12 @@ sub insttypes_row { $usertypes->{$types->[$i]}.''; } } - $rem = @{$types}%($numinrow); } my $colsleft = $numinrow - $rem; + if (($rem == 0) && (@{$types} > 0)) { + $output .= ''; + } if ($colsleft > 1) { $output .= '
'; } else { @@ -3445,13 +4599,13 @@ sub usertype_update_row { sub modify_login { my ($r,$dom,$confname,%domconfig) = @_; - my ($resulttext,$errors,$colchgtext,%changes,%colchanges); - my %title = ( coursecatalog => 'Display course catalog', - adminmail => 'Display administrator E-mail address', - newuser => 'Link for visitors to create a user account', - loginheader => 'Log-in box header'); - my @offon = ('off','on'); - my %curr_loginvia; + my ($resulttext,$errors,$colchgtext,%changes,%colchanges,%newfile,%newurl, + %curr_loginvia,%loginhash,@currlangs,@newlangs,$addedfile,%title,@offon); + %title = ( coursecatalog => 'Display course catalog', + adminmail => 'Display administrator E-mail address', + newuser => 'Link for visitors to create a user account', + loginheader => 'Log-in box header'); + @offon = ('off','on'); if (ref($domconfig{login}) eq 'HASH') { if (ref($domconfig{login}{loginvia}) eq 'HASH') { foreach my $lonhost (keys(%{$domconfig{login}{loginvia}})) { @@ -3459,7 +4613,6 @@ sub modify_login { } } } - my %loginhash; ($errors,%colchanges) = &modify_colors($r,$dom,$confname,['login'], \%domconfig,\%loginhash); my @toggles = ('coursecatalog','adminmail','newuser'); @@ -3472,24 +4625,180 @@ sub modify_login { \%loginhash); } - my %servers = &dom_servers($dom); + my %servers = &Apache::lonnet::internet_dom_servers($dom); + my @loginvia_attribs = ('serverpath','custompath','exempt'); if (keys(%servers) > 1) { foreach my $lonhost (keys(%servers)) { - next if ($env{'form.'.$lonhost.'_serverurl'} eq $lonhost); - if ($env{'form.'.$lonhost.'_serverurl'} eq $curr_loginvia{$lonhost}) { - $loginhash{login}{loginvia}{$lonhost} = $curr_loginvia{$lonhost}; next; - } - if ($curr_loginvia{$lonhost} ne '') { - $loginhash{login}{loginvia}{$lonhost} = $env{'form.'.$lonhost.'_serverurl'}; - $changes{'loginvia'}{$lonhost} = 1; + next if ($env{'form.'.$lonhost.'_server'} eq $lonhost); + if (ref($curr_loginvia{$lonhost}) eq 'HASH') { + if ($env{'form.'.$lonhost.'_server'} eq $curr_loginvia{$lonhost}{'server'}) { + $loginhash{login}{loginvia}{$lonhost}{'server'} = $curr_loginvia{$lonhost}{'server'}; + } elsif ($curr_loginvia{$lonhost}{'server'} ne '') { + if (defined($servers{$env{'form.'.$lonhost.'_server'}})) { + $loginhash{login}{loginvia}{$lonhost}{'server'} = $env{'form.'.$lonhost.'_server'}; + $changes{'loginvia'}{$lonhost} = 1; + } else { + $loginhash{login}{loginvia}{$lonhost}{'server'} = ''; + $changes{'loginvia'}{$lonhost} = 1; + } + } else { + if (defined($servers{$env{'form.'.$lonhost.'_server'}})) { + $loginhash{login}{loginvia}{$lonhost}{'server'} = $env{'form.'.$lonhost.'_server'}; + $changes{'loginvia'}{$lonhost} = 1; + } + } + if ($loginhash{login}{loginvia}{$lonhost}{'server'} eq '') { + foreach my $item (@loginvia_attribs) { + $loginhash{login}{loginvia}{$lonhost}{$item} = ''; + } + } else { + foreach my $item (@loginvia_attribs) { + my $new = $env{'form.'.$lonhost.'_'.$item}; + if (($item eq 'serverpath') && ($new eq 'custom')) { + $env{'form.'.$lonhost.'_custompath'} =~ s/\s+//g; + if ($env{'form.'.$lonhost.'_custompath'} eq '') { + $new = '/'; + } + } + if (($item eq 'custompath') && + ($env{'form.'.$lonhost.'_serverpath'} ne 'custom')) { + $new = ''; + } + if ($new ne $curr_loginvia{$lonhost}{$item}) { + $changes{'loginvia'}{$lonhost} = 1; + } + if ($item eq 'exempt') { + $new =~ s/^\s+//; + $new =~ s/\s+$//; + my @poss_ips = split(/\s*[,:]\s*/,$new); + my @okips; + foreach my $ip (@poss_ips) { + if ($ip =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) { + if (($1 <= 255) && ($2 <= 255) && ($3 <= 255) && ($4 <= 255)) { + push(@okips,$ip); + } + } + } + if (@okips > 0) { + $new = join(',',@okips); + } else { + $new = ''; + } + } + $loginhash{login}{loginvia}{$lonhost}{$item} = $new; + } + } } else { - if (defined($servers{$env{'form.'.$lonhost.'_serverurl'}})) { - $loginhash{login}{loginvia}{$lonhost} = $env{'form.'.$lonhost.'_serverurl'}; + if (defined($servers{$env{'form.'.$lonhost.'_server'}})) { + $loginhash{login}{loginvia}{$lonhost}{'server'} = $env{'form.'.$lonhost.'_server'}; $changes{'loginvia'}{$lonhost} = 1; + foreach my $item (@loginvia_attribs) { + my $new = $env{'form.'.$lonhost.'_'.$item}; + if (($item eq 'serverpath') && ($new eq 'custom')) { + if ($env{'form.'.$lonhost.'_custompath'} eq '') { + $new = '/'; + } + } + if (($item eq 'custompath') && + ($env{'form.'.$lonhost.'_serverpath'} ne 'custom')) { + $new = ''; + } + $loginhash{login}{loginvia}{$lonhost}{$item} = $new; + } + } + } + } + } + + my $servadm = $r->dir_config('lonAdmEMail'); + my %langchoices = &Apache::lonlocal::texthash(&get_languages_hash()); + if (ref($domconfig{'login'}) eq 'HASH') { + if (ref($domconfig{'login'}{'helpurl'}) eq 'HASH') { + foreach my $lang (sort(keys(%{$domconfig{'login'}{'helpurl'}}))) { + if ($lang eq 'nolang') { + push(@currlangs,$lang); + } elsif (defined($langchoices{$lang})) { + push(@currlangs,$lang); + } else { + next; + } + } + } + } + my @delurls = &Apache::loncommon::get_env_multiple('form.loginhelpurl_del'); + if (@currlangs > 0) { + foreach my $lang (@currlangs) { + if (grep(/^\Q$lang\E$/,@delurls)) { + $changes{'helpurl'}{$lang} = 1; + } elsif ($env{'form.loginhelpurl_'.$lang.'.filename'}) { + $changes{'helpurl'}{$lang} = 1; + $newfile{$lang} = $env{'form.loginhelpurl_'.$lang.'.filename'}; + push(@newlangs,$lang); + } else { + $loginhash{'login'}{'helpurl'}{$lang} = $domconfig{'login'}{'helpurl'}{$lang}; + } + } + } + unless (grep(/^nolang$/,@currlangs)) { + if ($env{'form.loginhelpurl_nolang.filename'}) { + $changes{'helpurl'}{'nolang'} = 1; + $newfile{'nolang'} = $env{'form.loginhelpurl_nolang.filename'}; + push(@newlangs,'nolang'); + } + } + if ($env{'form.loginhelpurl_add_lang'}) { + if ((defined($langchoices{$env{'form.loginhelpurl_add_lang'}})) && + ($env{'form.loginhelpurl_add_file.filename'})) { + $newfile{$env{'form.loginhelpurl_add_lang'}} = $env{'form.loginhelpurl_add_file.filename'}; + $addedfile = $env{'form.loginhelpurl_add_lang'}; + } + } + if ((@newlangs > 0) || ($addedfile)) { + my $error; + my ($configuserok,$author_ok,$switchserver) = &config_check($dom,$confname,$servadm); + if ($configuserok eq 'ok') { + if ($switchserver) { + $error = &mt("Upload of custom help file is not permitted to this server: [_1]",$switchserver); + } elsif ($author_ok eq 'ok') { + my @allnew = @newlangs; + if ($addedfile ne '') { + push(@allnew,$addedfile); + } + foreach my $lang (@allnew) { + my $formelem = 'loginhelpurl_'.$lang; + if ($lang eq $env{'form.loginhelpurl_add_lang'}) { + $formelem = 'loginhelpurl_add_file'; + } + (my $result,$newurl{$lang}) = &publishlogo($r,'upload',$formelem,$dom,$confname, + "help/$lang",'','',$newfile{$lang}); + if ($result eq 'ok') { + $loginhash{'login'}{'helpurl'}{$lang} = $newurl{$lang}; + $changes{'helpurl'}{$lang} = 1; + } else { + my $puberror = &mt("Upload of [_1] failed because an error occurred publishing the file in RES space. Error was: [_2].",$newfile{$lang},$result); + $errors .= '
  • '.$puberror.'
  • '; + if ((grep(/^\Q$lang\E$/,@currlangs)) && + (!grep(/^\Q$lang\E$/,@delurls))) { + + $loginhash{'login'}{'helpurl'}{$lang} = $domconfig{'login'}{'helpurl'}{$lang}; + } + } } + } 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); } + } else { + $error = &mt("Upload of custom log-in help file(s) failed because a Domain Configuration user ([_1]) could not be created in domain: [_2]. Error was: [_3].",$confname,$dom,$configuserok); + } + if ($error) { + &Apache::lonnet::logthis($error); + $errors .= '
  • '.$error.'
  • '; } } + &process_captcha('login',\%changes,$loginhash{'login'},$domconfig{'login'}); + + my $defaulthelpfile = '/adm/loginproblems.html'; + my $defaulttext = &mt('Default in use'); my $putresult = &Apache::lonnet::put_dom('configuration',\%loginhash, $dom); @@ -3522,32 +4831,101 @@ sub modify_login { } } } - if (($domconfig{'login'}{'loginheader'} eq 'text') && - ($env{'form.loginheader'} eq 'image')) { - $changes{'loginheader'} = 1; - } elsif (($domconfig{'login'}{'loginheader'} eq '' || - $domconfig{'login'}{'loginheader'} eq 'image') && - ($env{'form.loginheader'} eq 'text')) { - $changes{'loginheader'} = 1; - } } if (keys(%changes) > 0 || $colchgtext) { &Apache::loncommon::devalidate_domconfig_cache($dom); $resulttext = &mt('Changes made:').'
      '; foreach my $item (sort(keys(%changes))) { - if ($item eq 'loginheader') { - $resulttext .= '
    • '.&mt("$title{$item} set to $env{'form.loginheader'}").'
    • '; - } elsif ($item eq 'loginvia') { + if ($item eq 'loginvia') { if (ref($changes{$item}) eq 'HASH') { $resulttext .= '
    • '.&mt('Log-in page availability:').'
        '; foreach my $lonhost (sort(keys(%{$changes{$item}}))) { - if ($servers{$env{'form.'.$lonhost.'_serverurl'}} ne '') { - $resulttext .= '
      • '.&mt('Server: [_1] log-in page now redirects to [_2]',$lonhost,$servers{$env{'form.'.$lonhost.'_serverurl'}}).'
      • '; + if (defined($servers{$loginhash{login}{loginvia}{$lonhost}{'server'}})) { + if (ref($loginhash{login}{loginvia}{$lonhost}) eq 'HASH') { + my $protocol = $Apache::lonnet::protocol{$env{'form.'.$lonhost.'_server'}}; + $protocol = 'http' if ($protocol ne 'https'); + my $target = $protocol.'://'.$servers{$env{'form.'.$lonhost.'_server'}}; + + if ($loginhash{login}{loginvia}{$lonhost}{'serverpath'} eq 'custom') { + $target .= $loginhash{login}{loginvia}{$lonhost}{'custompath'}; + } else { + $target .= $loginhash{login}{loginvia}{$lonhost}{'serverpath'}; + } + $resulttext .= '
      • '.&mt('Server: [_1] log-in page redirects to [_2].',$servers{$lonhost},''.$target.''); + if ($loginhash{login}{loginvia}{$lonhost}{'exempt'} ne '') { + $resulttext .= ' '.&mt('No redirection for clients from following IPs:').' '.$loginhash{login}{loginvia}{$lonhost}{'exempt'}; + } + $resulttext .= '
      • '; + } else { + $resulttext .= '
      • '.&mt('Server: [_1] has standard log-in page.',$lonhost).'
      • '; + } } else { - $resulttext .= '
      • '.&mt('Server: [_1] now has standard log-in page.',$lonhost).'
      • '; + $resulttext .= '
      • '.&mt('Server: [_1] has standard log-in page.',$servers{$lonhost}).'
      • '; } } - $resulttext .= '
    • '; + $resulttext .= '
    '; + } + } elsif ($item eq 'helpurl') { + if (ref($changes{$item}) eq 'HASH') { + foreach my $lang (sort(keys(%{$changes{$item}}))) { + if (grep(/^\Q$lang\E$/,@delurls)) { + my ($chg,$link); + $link = &Apache::loncommon::modal_link($defaulthelpfile,$defaulttext,600,500); + if ($lang eq 'nolang') { + $chg = &mt('custom log-in help file removed for no preferred language; [_1]',$link); + } else { + $chg = &mt('custom log-in help file removed for specific language: [_1]; [_2]',$langchoices{$lang},$link); + } + $resulttext .= '
  • '.$chg.'
  • '; + } else { + my $chg; + if ($lang eq 'nolang') { + $chg = &mt('custom log-in help file for no preferred language'); + } else { + $chg = &mt('custom log-in help file for specific language: [_1]',$langchoices{$lang}); + } + $resulttext .= '
  • '.&Apache::loncommon::modal_link( + $loginhash{'login'}{'helpurl'}{$lang}. + '?inhibitmenu=yes',$chg,600,500). + '
  • '; + } + } + } + } elsif ($item eq 'captcha') { + if (ref($loginhash{'login'}) eq 'HASH') { + my $chgtxt; + if ($loginhash{'login'}{$item} eq 'notused') { + $chgtxt .= &mt('No CAPTCHA validation in use for helpdesk form.'); + } else { + my %captchas = &captcha_phrases(); + if ($captchas{$loginhash{'login'}{$item}}) { + $chgtxt .= &mt("Validation for helpdesk form set to $captchas{$loginhash{'login'}{$item}}."); + } else { + $chgtxt .= &mt('Validation for helpdesk form set to unknown type.'); + } + } + $resulttext .= '
  • '.$chgtxt.'
  • '; + } + } elsif ($item eq 'recaptchakeys') { + if (ref($loginhash{'login'}) eq 'HASH') { + my ($privkey,$pubkey); + if (ref($loginhash{'login'}{$item}) eq 'HASH') { + $pubkey = $loginhash{'login'}{$item}{'public'}; + $privkey = $loginhash{'login'}{$item}{'private'}; + } + my $chgtxt .= &mt('ReCAPTCHA keys changes').'
      '; + if (!$pubkey) { + $chgtxt .= '
    • '.&mt('Public key deleted').'
    • '; + } else { + $chgtxt .= '
    • '.&mt('Public key set to [_1]',$pubkey).'
    • '; + } + if (!$privkey) { + $chgtxt .= '
    • '.&mt('Private key deleted').'
    • '; + } else { + $chgtxt .= '
    • '.&mt('Private key set to [_1]',$pubkey).'
    • '; + } + $chgtxt .= '
    '; + $resulttext .= '
  • '.$chgtxt.'
  • '; } } else { $resulttext .= '
  • '.&mt("$title{$item} set to $offon[$env{'form.'.$item}]").'
  • '; @@ -3993,15 +5371,17 @@ sub publishlogo { # See if there is anything left unless ($fname) { return ('error: no uploaded file'); } $fname="$subdir/$fname"; - my $filepath='/home/'.$confname.'/public_html'; + 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.'/'.$fnamepath); + my @parts=split(/\//,"$filepath/$relpath/$fnamepath"); my $count; - for ($count=4;$count<=$#parts;$count++) { + for ($count=5;$count<=$#parts;$count++) { $filepath.="/$parts[$count]"; if ((-e $filepath)!=1) { mkdir($filepath,02770); @@ -4048,7 +5428,6 @@ $env{'user.name'}.':'.$env{'user.domain' close(FH); chmod(0660, $source); # Permissions to rw-rw---. - my $docroot=$r->dir_config('lonDocRoot'); my $targetdir=$docroot.'/res/'.$dom.'/'.$confname .'/'.$fnamepath; my $copyfile=$targetdir.'/'.$file; @@ -4071,8 +5450,15 @@ $env{'user.name'}.':'.$env{'user.domain' if (copy($source,$copyfile)) { print $logfile "\nCopied original source to ".$copyfile."\n"; $output = 'ok'; - &write_metadata($dom,$confname,$formname,$targetdir,$file,$logfile); $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').", $!"; @@ -4090,8 +5476,15 @@ $env{'user.name'}.':'.$env{'user.domain' my $copyfile=$targetdir.'/tn-'.$file; if (copy($outfile,$copyfile)) { print $logfile "\nCopied source to ".$copyfile."\n"; - &write_metadata($dom,$confname,$formname, - $targetdir,'tn-'.$file,$logfile); + 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"; @@ -4156,30 +5549,79 @@ sub write_metadata { { print $logfile "\nWrite metadata file for ".$targetdir.'/'.$file; my $mfh; - unless (open($mfh,'>'.$targetdir.'/'.$file.'.meta')) { + 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'); } - 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); } + return $output; +} + +sub notifysubscribed { + foreach my $targetsource (@{$modified_urls}){ + next unless (ref($targetsource) eq 'ARRAY'); + my ($target,$source)=@{$targetsource}; + if ($source ne '') { + if (open(my $logfh,'>>'.$source.'.log')) { + print $logfh "\nCleanup phase: Notifications\n"; + my @subscribed=&subscribed_hosts($target); + foreach my $subhost (@subscribed) { + print $logfh "\nNotifying host ".$subhost.':'; + my $reply=&Apache::lonnet::critical('update:'.$target,$subhost); + print $logfh $reply; + } + my @subscribedmeta=&subscribed_hosts("$target.meta"); + foreach my $subhost (@subscribedmeta) { + print $logfh "\nNotifying host for metadata only ".$subhost.':'; + my $reply=&Apache::lonnet::critical('update:'.$target.'.meta', + $subhost); + print $logfh $reply; + } + print $logfh "\n============ Done ============\n"; + close($logfh); + } + } + } + return OK; +} + +sub subscribed_hosts { + my ($target) = @_; + my @subscribed; + if (open(my $fh,"<$target.subscription")) { + while (my $subline=<$fh>) { + if ($subline =~ /^($match_lonid):/) { + my $host = $1; + if ($host ne $Apache::lonnet::perlvar{'lonHostID'}) { + unless (grep(/^\Q$host\E$/,@subscribed)) { + push(@subscribed,$host); + } + } + } + } + } + return @subscribed; } sub check_switchserver { @@ -4213,8 +5655,11 @@ sub modify_quotas { %titles = &courserequest_titles(); $toolregexp = join('|',@usertools); %conditions = &courserequest_conditions(); + } elsif ($context eq 'requestauthor') { + @usertools = ('author'); + %titles = &authorrequest_titles(); } else { - @usertools = ('aboutme','blog','portfolio'); + @usertools = ('aboutme','blog','webdav','portfolio'); %titles = &tool_titles(); } my %domdefaults = &Apache::lonnet::get_domain_defaults($dom); @@ -4230,6 +5675,10 @@ sub modify_quotas { $confhash{$item}{$type} = $env{$key}; } } + } elsif ($context eq 'requestauthor') { + if ($key =~ /^\Qform.authorreq_\E(.+)$/) { + $confhash{$1} = $env{$key}; + } } else { if ($key =~ /^form\.quota_(.+)$/) { $confhash{'defaultquota'}{$1} = $env{$key}; @@ -4239,7 +5688,7 @@ sub modify_quotas { } } } - if ($context eq 'requestcourses') { + if (($context eq 'requestcourses') || ($context eq 'requestauthor')) { my @approvalnotify = &Apache::loncommon::get_env_multiple('form.reqapprovalnotify'); @approvalnotify = sort(@approvalnotify); $confhash{'notify'}{'approval'} = join(',',@approvalnotify); @@ -4249,12 +5698,12 @@ sub modify_quotas { $changes{'notify'}{'approval'} = 1; } } else { - if ($domconfig{$action}{'notify'}{'approval'}) { + if ($confhash{'notify'}{'approval'}) { $changes{'notify'}{'approval'} = 1; } } } else { - if ($domconfig{$action}{'notify'}{'approval'}) { + if ($confhash{'notify'}{'approval'}) { $changes{'notify'}{'approval'} = 1; } } @@ -4275,6 +5724,11 @@ sub modify_quotas { $confhash{$item}{$type} .= $limithash{$item}{$type}; } } + } elsif ($context eq 'requestauthor') { + $unset = '0'; + if ($type eq '_LC_adv') { + $unset = ''; + } } else { if (grep(/^\Q$type\E$/,@{$toolshash{$item}})) { $confhash{$item}{$type} = 1; @@ -4283,7 +5737,11 @@ sub modify_quotas { } } if (ref($domconfig{$action}) eq 'HASH') { - if (ref($domconfig{$action}{$item}) eq 'HASH') { + if ($action eq 'requestauthor') { + if ($domconfig{$action}{$type} ne $confhash{$type}) { + $changes{$type} = 1; + } + } elsif (ref($domconfig{$action}{$item}) eq 'HASH') { if ($domconfig{$action}{$item}{$type} ne $confhash{$item}{$type}) { $changes{$item}{$type} = 1; } @@ -4303,6 +5761,10 @@ sub modify_quotas { if ($confhash{$item}{$type} ne $unset) { $changes{$item}{$type} = 1; } + } elsif ($context eq 'requestauthor') { + if ($confhash{$type} ne $unset) { + $changes{$type} = 1; + } } else { if (!$confhash{$item}{$type}) { $changes{$item}{$type} = 1; @@ -4311,7 +5773,7 @@ sub modify_quotas { } } } - unless ($context eq 'requestcourses') { + unless (($context eq 'requestcourses') || ($context eq 'requestauthor')) { if (ref($domconfig{'quotas'}) eq 'HASH') { if (ref($domconfig{'quotas'}{'defaultquota'}) eq 'HASH') { foreach my $key (keys(%{$domconfig{'quotas'}{'defaultquota'}})) { @@ -4354,10 +5816,14 @@ sub modify_quotas { } } - foreach my $key (keys(%confhash)) { - $domdefaults{$key} = $confhash{$key}; + if ($context eq 'requestauthor') { + $domdefaults{'requestauthor'} = \%confhash; + } else { + foreach my $key (keys(%confhash)) { + $domdefaults{$key} = $confhash{$key}; + } } - + my %quotahash = ( $action => { %confhash } ); @@ -4369,7 +5835,8 @@ sub modify_quotas { &Apache::lonnet::do_cache_new('domdefaults',$dom,\%domdefaults,$cachetime); $resulttext = &mt('Changes made:').'
      '; - unless ($context eq 'requestcourses') { + unless (($context eq 'requestcourses') || + ($context eq 'requestauthor')) { if (ref($changes{'defaultquota'}) eq 'HASH') { $resulttext .= '
    • '.&mt('Portfolio default quotas').'
        '; foreach my $type (@{$types},'default') { @@ -4386,12 +5853,25 @@ sub modify_quotas { } my %newenv; foreach my $item (@usertools) { - if (ref($changes{$item}) eq 'HASH') { + my (%haschgs,%inconf); + if ($context eq 'requestauthor') { + %haschgs = %changes; + %inconf = %confhash; + } else { + if (ref($changes{$item}) eq 'HASH') { + %haschgs = %{$changes{$item}}; + } + if (ref($confhash{$item}) eq 'HASH') { + %inconf = %{$confhash{$item}}; + } + } + if (keys(%haschgs) > 0) { my $newacc = &Apache::lonnet::usertools_access($env{'user.name'}, $env{'user.domain'}, $item,'reload',$context); - if ($context eq 'requestcourses') { + if (($context eq 'requestcourses') || + ($context eq 'requestauthor')) { if ($env{'environment.canrequest.'.$item} ne $newacc) { $newenv{'environment.canrequest.'.$item} = $newacc; } @@ -4400,34 +5880,40 @@ sub modify_quotas { $newenv{'environment.availabletools.'.$item} = $newacc; } } - $resulttext .= '
      • '.$titles{$item}.'
          '; + unless ($context eq 'requestauthor') { + $resulttext .= '
        • '.$titles{$item}.'
            '; + } foreach my $type (@{$types},'default','_LC_adv') { - if ($changes{$item}{$type}) { + if ($haschgs{$type}) { my $typetitle = $usertypes->{$type}; if ($type eq 'default') { $typetitle = $othertitle; } elsif ($type eq '_LC_adv') { $typetitle = 'LON-CAPA Advanced Users'; } - if ($confhash{$item}{$type}) { + if ($inconf{$type}) { if ($context eq 'requestcourses') { my $cond; - if ($confhash{$item}{$type} =~ /^autolimit=(\d*)$/) { + if ($inconf{$type} =~ /^autolimit=(\d*)$/) { if ($1 eq '') { $cond = &mt('(Automatic processing of any request).'); } else { $cond = &mt('(Automatic processing of requests up to limit of [quant,_1,request] per user).',$1); } } else { - $cond = $conditions{$confhash{$item}{$type}}; + $cond = $conditions{$inconf{$type}}; } $resulttext .= '
          • '.&mt('Set to be available to [_1].',$typetitle).' '.$cond.'
          • '; + } elsif ($context eq 'requestauthor') { + $resulttext .= '
          • '.&mt('Set to "[_1]" for "[_2]".', + $titles{$inconf{$type}},$typetitle); + } else { $resulttext .= '
          • '.&mt('Set to be available to [_1]',$typetitle).'
          • '; } } else { if ($type eq '_LC_adv') { - if ($confhash{$item}{$type} eq '0') { + if ($inconf{$type} eq '0') { $resulttext .= '
          • '.&mt('Set to be unavailable to [_1]',$typetitle).'
          • '; } else { $resulttext .= '
          • '.&mt('No override set for [_1]',$typetitle).'
          • '; @@ -4438,17 +5924,19 @@ sub modify_quotas { } } } - $resulttext .= '
        • '; + unless ($context eq 'requestauthor') { + $resulttext .= '
      • '; + } } } - if ($action eq 'requestcourses') { + if (($action eq 'requestcourses') || ($action eq 'requestauthor')) { if (ref($changes{'notify'}) eq 'HASH') { if ($changes{'notify'}{'approval'}) { if (ref($confhash{'notify'}) eq 'HASH') { if ($confhash{'notify'}{'approval'}) { $resulttext .= '
      • '.&mt('Notification of requests requiring approval will be sent to: ').$confhash{'notify'}{'approval'}.'
      • '; } else { - $resulttext .= '
      • '.&mt('No Domain Coordinators will receive notification of course requests requiring approval.').'
      • '; + $resulttext .= '
      • '.&mt('No Domain Coordinators will receive notification of requests requiring approval.').'
      • '; } } } @@ -4461,6 +5949,8 @@ sub modify_quotas { } else { if ($context eq 'requestcourses') { $resulttext = &mt('No changes made to rights to request creation of courses.'); + } elsif ($context eq 'requestauthor') { + $resulttext = &mt('No changes made to rights to request author space.'); } else { $resulttext = &mt('No changes made to availability of personal information pages, blogs, portfolios or default quotas'); } @@ -4483,7 +5973,8 @@ sub modify_autoenroll { } my $autorun = &Apache::lonnet::auto_run(undef,$dom), my %title = ( run => 'Auto-enrollment active', - sender => 'Sender for notification messages'); + sender => 'Sender for notification messages', + coowners => 'Automatic assignment of co-ownership to instructors of record (institutional data)'); my @offon = ('off','on'); my $sender_uname = $env{'form.sender_uname'}; my $sender_domain = $env{'form.sender_domain'}; @@ -4492,11 +5983,12 @@ sub modify_autoenroll { } elsif ($sender_uname eq '') { $sender_domain = ''; } + my $coowners = $env{'form.autoassign_coowners'}; my %autoenrollhash = ( - autoenroll => { run => $env{'form.autoenroll_run'}, - sender_uname => $sender_uname, - sender_domain => $sender_domain, - + autoenroll => { 'run' => $env{'form.autoenroll_run'}, + 'sender_uname' => $sender_uname, + 'sender_domain' => $sender_domain, + 'co-owners' => $coowners, } ); my $putresult = &Apache::lonnet::put_dom('configuration',\%autoenrollhash, @@ -4517,6 +6009,13 @@ sub modify_autoenroll { if ($currautoenroll{'sender_domain'} ne $sender_domain) { $changes{'sender'} = 1; } + if ($currautoenroll{'co-owners'} ne '') { + if ($currautoenroll{'co-owners'} ne $coowners) { + $changes{'coowners'} = 1; + } + } elsif ($coowners) { + $changes{'coowners'} = 1; + } if (keys(%changes) > 0) { $resulttext = &mt('Changes made:').'
          '; if ($changes{'run'}) { @@ -4529,6 +6028,10 @@ sub modify_autoenroll { $resulttext .= '
        • '.&mt("$title{'sender'} set to [_1]",$sender_uname.':'.$sender_domain).'
        • '; } } + if ($changes{'coowners'}) { + $resulttext .= '
        • '.&mt("$title{'coowners'} set to $offon[$env{'form.autoassign_coowners'}]").'
        • '; + &Apache::loncommon::devalidate_domconfig_cache($dom); + } $resulttext .= '
        '; } else { $resulttext = &mt('No changes made to auto-enrollment settings'); @@ -4560,21 +6063,43 @@ sub modify_autoupdate { lastname => 'Last Name', firstname => 'First Name', middlename => 'Middle Name', - gen => 'Generation', + generation => 'Generation', ); - my $othertitle = &mt('All users'); + $othertitle = &mt('All users'); if (keys(%{$usertypes}) > 0) { $othertitle = &mt('Other users'); } foreach my $key (keys(%env)) { if ($key =~ /^form\.updateable_(.+)_([^_]+)$/) { - push(@{$fields{$1}},$2); + my ($usertype,$item) = ($1,$2); + if (grep(/^\Q$item\E$/,keys(%fieldtitles))) { + if ($usertype eq 'default') { + push(@{$fields{$1}},$2); + } elsif (ref($types) eq 'ARRAY') { + if (grep(/^\Q$usertype\E$/,@{$types})) { + push(@{$fields{$1}},$2); + } + } + } + } + } + my @lockablenames = &Apache::loncommon::get_env_multiple('form.lockablenames'); + @lockablenames = sort(@lockablenames); + if (ref($currautoupdate{'lockablenames'}) eq 'ARRAY') { + my @changed = &Apache::loncommon::compare_arrays($currautoupdate{'lockablenames'},\@lockablenames); + if (@changed) { + $changes{'lockablenames'} = 1; + } + } else { + if (@lockablenames) { + $changes{'lockablenames'} = 1; } } my %updatehash = ( autoupdate => { run => $env{'form.autoupdate_run'}, classlists => $env{'form.classlists'}, fields => {%fields}, + lockablenames => \@lockablenames, } ); foreach my $key (keys(%currautoupdate)) { @@ -4592,9 +6117,11 @@ sub modify_autoupdate { foreach my $type (@{$currautoupdate{$key}{$item}}) { if (!exists($fields{$item})) { $change = 1; + last; } elsif (ref($fields{$item}) eq 'ARRAY') { if (!grep(/^\Q$type\E$/,@{$fields{$item}})) { $change = 1; + last; } } } @@ -4604,12 +6131,41 @@ sub modify_autoupdate { } } } + } elsif ($key eq 'lockablenames') { + if (ref($currautoupdate{$key}) eq 'ARRAY') { + my @changed = &Apache::loncommon::compare_arrays($currautoupdate{'lockablenames'},\@lockablenames); + if (@changed) { + $changes{'lockablenames'} = 1; + } + } else { + if (@lockablenames) { + $changes{'lockablenames'} = 1; + } + } + } + } + unless (grep(/^\Qlockablenames\E$/,keys(%currautoupdate))) { + if (@lockablenames) { + $changes{'lockablenames'} = 1; } } foreach my $item (@{$types},'default') { if (defined($fields{$item})) { if (ref($currautoupdate{'fields'}) eq 'HASH') { - if (!exists($currautoupdate{'fields'}{$item})) { + if (ref($currautoupdate{'fields'}{$item}) eq 'ARRAY') { + my $change = 0; + if (ref($fields{$item}) eq 'ARRAY') { + foreach my $type (@{$fields{$item}}) { + if (!grep(/^\Q$type\E$/,@{$currautoupdate{'fields'}{$item}})) { + $change = 1; + last; + } + } + } + if ($change) { + push(@{$changes{'fields'}},$item); + } + } else { push(@{$changes{'fields'}},$item); } } else { @@ -4623,7 +6179,17 @@ sub modify_autoupdate { if (keys(%changes) > 0) { $resulttext = &mt('Changes made:').'
          '; foreach my $key (sort(keys(%changes))) { - if (ref($changes{$key}) eq 'ARRAY') { + if ($key eq 'lockablenames') { + $resulttext .= '
        • '; + if (@lockablenames) { + $usertypes->{'default'} = $othertitle; + $resulttext .= &mt("User preference to disable replacement of user's name with institutional data (by auto-update), available for the following affiliations:").' '. + join(', ', map { $usertypes->{$_}; } @lockablenames).'
        • '; + } else { + $resulttext .= &mt("User preference to disable replacement of user's name with institutional data (by auto-update) is unavailable."); + } + $resulttext .= ''; + } elsif (ref($changes{$key}) eq 'ARRAY') { foreach my $item (@{$changes{$key}}) { my @newvalues; foreach my $type (@{$fields{$item}}) { @@ -4662,6 +6228,78 @@ sub modify_autoupdate { return $resulttext; } +sub modify_autocreate { + my ($dom,%domconfig) = @_; + my ($resulttext,%changes,%currautocreate,%newvals,%autocreatehash); + if (ref($domconfig{'autocreate'}) eq 'HASH') { + foreach my $key (keys(%{$domconfig{'autocreate'}})) { + $currautocreate{$key} = $domconfig{'autocreate'}{$key}; + } + } + my %title= ( xml => 'Auto-creation of courses in XML course description files', + req => 'Auto-creation of validated requests for official courses', + xmldc => 'Identity of course creator of courses from XML files', + ); + my @types = ('xml','req'); + foreach my $item (@types) { + $newvals{$item} = $env{'form.autocreate_'.$item}; + $newvals{$item} =~ s/\D//g; + $newvals{$item} = 0 if ($newvals{$item} eq ''); + } + $newvals{'xmldc'} = $env{'form.autocreate_xmldc'}; + my %domcoords = &get_active_dcs($dom); + unless (exists($domcoords{$newvals{'xmldc'}})) { + $newvals{'xmldc'} = ''; + } + %autocreatehash = ( + autocreate => { xml => $newvals{'xml'}, + req => $newvals{'req'}, + } + ); + if ($newvals{'xmldc'} ne '') { + $autocreatehash{'autocreate'}{'xmldc'} = $newvals{'xmldc'}; + } + my $putresult = &Apache::lonnet::put_dom('configuration',\%autocreatehash, + $dom); + if ($putresult eq 'ok') { + my @items = @types; + if ($newvals{'xml'}) { + push(@items,'xmldc'); + } + foreach my $item (@items) { + if (exists($currautocreate{$item})) { + if ($currautocreate{$item} ne $newvals{$item}) { + $changes{$item} = 1; + } + } elsif ($newvals{$item}) { + $changes{$item} = 1; + } + } + if (keys(%changes) > 0) { + my @offon = ('off','on'); + $resulttext = &mt('Changes made:').'
            '; + foreach my $item (@types) { + if ($changes{$item}) { + my $newtxt = $offon[$newvals{$item}]; + $resulttext .= '
          • '.&mt("$title{$item} set to [_1]$newtxt [_2]",'','').'
          • '; + } + } + if ($changes{'xmldc'}) { + my ($dcname,$dcdom) = split(':',$newvals{'xmldc'}); + my $newtxt = &Apache::loncommon::plainname($dcname,$dcdom); + $resulttext .= '
          • '.&mt("$title{'xmldc'} set to [_1]$newtxt [_2]",'','').'
          • '; + } + $resulttext .= '
          '; + } else { + $resulttext = &mt('No changes made to auto-creation settings'); + } + } else { + $resulttext = ''. + &mt('An error occurred: [_1]',$putresult).''; + } + return $resulttext; +} + sub modify_directorysrch { my ($dom,%domconfig) = @_; my ($resulttext,%changes); @@ -4844,7 +6482,7 @@ sub modify_contacts { $currsetting{$key} = $domconfig{'contacts'}{$key}; } } - my (%others,%to); + my (%others,%to,%bcc); my @contacts = ('supportemail','adminemail'); my @mailings = ('errormail','packagesmail','helpdeskmail','lonstatusmail', 'requestsmail'); @@ -4860,6 +6498,10 @@ sub modify_contacts { } $others{$type} = $env{'form.'.$type.'_others'}; $contacts_hash{contacts}{$type}{'others'} = $others{$type}; + if ($type eq 'helpdeskmail') { + $bcc{$type} = $env{'form.'.$type.'_bcc'}; + $contacts_hash{contacts}{$type}{'bcc'} = $bcc{$type}; + } } foreach my $item (@contacts) { $to{$item} = $env{'form.'.$item}; @@ -4884,6 +6526,11 @@ sub modify_contacts { if ($others{$type} ne $currsetting{$type}{'others'}) { push(@{$changes{$type}},'others'); } + if ($type eq 'helpdeskmail') { + if ($bcc{$type} ne $currsetting{$type}{'bcc'}) { + push(@{$changes{$type}},'bcc'); + } + } } } else { my %default; @@ -4906,7 +6553,12 @@ sub modify_contacts { } if ($others{$type} ne '') { push(@{$changes{$type}},'others'); - } + } + if ($type eq 'helpdeskmail') { + if ($bcc{$type} ne '') { + push(@{$changes{$type}},'bcc'); + } + } } } my $putresult = &Apache::lonnet::put_dom('configuration',\%contacts_hash, @@ -4934,7 +6586,13 @@ sub modify_contacts { push(@text,$others{$type}); } $resulttext .= ''. - join(', ',@text).''; + join(', ',@text).''; + if ($type eq 'helpdeskmail') { + if ($bcc{$type} ne '') { + $resulttext .= ' '.&mt('with Bcc to').': '.$bcc{$type}.''; + } + } + $resulttext .= ''; } } $resulttext .= '
        '; @@ -4987,6 +6645,7 @@ sub modify_usercreation { } push(@contexts,'statustocreate'); } + &process_captcha('cancreate',\%changes,\%cancreate,\%curr_usercreation); if (ref($curr_usercreation{'cancreate'}) eq 'HASH') { foreach my $item (@contexts) { if (($item eq 'selfcreate') || ($item eq 'statustocreate')) { @@ -5169,7 +6828,7 @@ sub modify_usercreation { my %lt = &usercreation_types(); foreach my $type (@{$changes{'cancreate'}}) { my $chgtext; - unless ($type eq 'statustocreate') { + unless (($type eq 'statustocreate') || ($type eq 'captcha') || ($type eq 'recaptchakeys')) { $chgtext = $lt{$type}.', '; } if ($type eq 'selfcreate') { @@ -5228,6 +6887,35 @@ sub modify_usercreation { } } } + } elsif ($type eq 'captcha') { + if ($cancreate{$type} eq 'notused') { + $chgtext .= &mt('No CAPTCHA validation in use for self-creation screen.'); + } else { + my %captchas = &captcha_phrases(); + if ($captchas{$cancreate{$type}}) { + $chgtext .= &mt("Validation for self-creation screen set to $captchas{$cancreate{$type}}."); + } else { + $chgtext .= &mt('Validation for self-creation screen set to unknown type.'); + } + } + } elsif ($type eq 'recaptchakeys') { + my ($privkey,$pubkey); + if (ref($cancreate{$type}) eq 'HASH') { + $pubkey = $cancreate{$type}{'public'}; + $privkey = $cancreate{$type}{'private'}; + } + $chgtext .= &mt('ReCAPTCHA keys changes').'
          '; + if (!$pubkey) { + $chgtext .= '
        • '.&mt('Public key deleted').'
        • '; + } else { + $chgtext .= '
        • '.&mt('Public key set to [_1]',$pubkey).'
        • '; + } + if (!$privkey) { + $chgtext .= '
        • '.&mt('Private key deleted').'
        • '; + } else { + $chgtext .= '
        • '.&mt('Private key set to [_1]',$pubkey).'
        • '; + } + $chgtext .= '
        '; } else { if ($cancreate{$type} eq 'none') { $chgtext .= &mt('creation of new users is not permitted, except by a Domain Coordinator.'); @@ -5327,6 +7015,57 @@ sub modify_usercreation { return $resulttext; } +sub process_captcha { + my ($container,$changes,$newsettings,$current) = @_; + return unless ((ref($changes) eq 'HASH') && (ref($newsettings) eq 'HASH') || (ref($current) eq 'HASH')); + $newsettings->{'captcha'} = $env{'form.'.$container.'_captcha'}; + unless ($newsettings->{'captcha'} eq 'recaptcha' || $newsettings->{'captcha'} eq 'notused') { + $newsettings->{'captcha'} = 'original'; + } + if ($current->{'captcha'} ne $newsettings->{'captcha'}) { + if ($container eq 'cancreate') { + if (ref($changes->{'cancreate'}) eq 'ARRAY') { + push(@{$changes->{'cancreate'}},'captcha'); + } elsif (!defined($changes->{'cancreate'})) { + $changes->{'cancreate'} = ['captcha']; + } + } else { + $changes->{'captcha'} = 1; + } + } + my ($newpub,$newpriv,$currpub,$currpriv); + if ($newsettings->{'captcha'} eq 'recaptcha') { + $newpub = $env{'form.'.$container.'_recaptchapub'}; + $newpriv = $env{'form.'.$container.'_recaptchapriv'}; + $newpub =~ s/\W//g; + $newpriv =~ s/\W//g; + $newsettings->{'recaptchakeys'} = { + public => $newpub, + private => $newpriv, + }; + } + if (ref($current->{'recaptchakeys'}) eq 'HASH') { + $currpub = $current->{'recaptchakeys'}{'public'}; + $currpriv = $current->{'recaptchakeys'}{'private'}; + $newsettings->{'recaptchakeys'} = { + public => '', + private => '', + } + } + if (($newpub ne $currpub) || ($newpriv ne $currpriv)) { + if ($container eq 'cancreate') { + if (ref($changes->{'cancreate'}) eq 'ARRAY') { + push(@{$changes->{'cancreate'}},'recaptchakeys'); + } elsif (!defined($changes->{'cancreate'})) { + $changes->{'cancreate'} = ['recaptchakeys']; + } + } else { + $changes->{'recaptchakeys'} = 1; + } + } + return; +} + sub modify_usermodification { my ($dom,%domconfig) = @_; my ($resulttext,%curr_usermodification,%changes); @@ -5416,7 +7155,7 @@ sub modify_usermodification { } my @modifiable; if ($context eq 'selfcreate') { - $resulttext .= '
      • '.&mt('Self-creation of account by users with status: [_1] ',$rolename).' - '.&mt('modifiable fields (if institutional data blank): '); + $resulttext .= '
      • '.&mt('Self-creation of account by users with status: [_1]',$rolename).' - '.&mt('modifiable fields (if institutional data blank): '); } else { $resulttext .= '
      • '.&mt('Target user with [_1] role',$rolename).' - '.&mt('modifiable fields: '); } @@ -5451,18 +7190,8 @@ sub modify_defaults { my ($dom,$r) = @_; my ($resulttext,$mailmsgtxt,%newvalues,%changes,@errors); my %domdefaults = &Apache::lonnet::get_domain_defaults($dom); - my @items = ('auth_def','auth_arg_def','lang_def','timezone_def','datelocale_def', - 'portal_def'); + my @items = ('auth_def','auth_arg_def','lang_def','timezone_def','datelocale_def','portal_def'); my @authtypes = ('internal','krb4','krb5','localauth'); - my @doms = &Apache::lonnet::current_machine_domains(); - my @langs; - foreach my $dom (@doms) { - if ($dom =~ /^(\w{2})\w?itest$/) { - push (@langs,$1.'t'); - } elsif ($dom =~ /^(\w{2})\w?i$/) { - push(@langs,$1.'i'); - } - } foreach my $item (@items) { $newvalues{$item} = $env{'form.'.$item}; if ($item eq 'auth_def') { @@ -5475,8 +7204,7 @@ sub modify_defaults { if ($newvalues{$item} ne '') { if ($newvalues{$item} =~ /^(\w+)/) { my $langcode = $1; - if ((!grep(/^\Q$langcode\E/,@langs)) && - ($langcode ne 'x_chef')) { + if ($langcode ne 'x_chef') { if (code2language($langcode) eq '') { push(@errors,$item); } @@ -5577,7 +7305,7 @@ sub modify_scantron { my $error; if ($configuserok eq 'ok') { if ($switchserver) { - $error = &mt("Upload of scantron format file is not permitted to this server: [_1]",$switchserver); + $error = &mt("Upload of bubblesheet format file is not permitted to this server: [_1]",$switchserver); } else { if ($author_ok eq 'ok') { my ($result,$scantronurl) = @@ -5617,25 +7345,25 @@ sub modify_scantron { if (ref($confhash{'scantron'}) eq 'HASH') { $resulttext = &mt('Changes made:').'
          '; if ($confhash{'scantron'}{'scantronformat'} eq '') { - $resulttext .= '
        • '.&mt('[_1] scantron format file removed; [_2] file will be used for courses in this domain.',$custom,$default).'
        • '; + $resulttext .= '
        • '.&mt('[_1] bubblesheet format file removed; [_2] file will be used for courses in this domain.',$custom,$default).'
        • '; } else { - $resulttext .= '
        • '.&mt('Custom scantron format file ([_1]) uploaded for use with courses in this domain.',$custom).'
        • '; + $resulttext .= '
        • '.&mt('Custom bubblesheet format file ([_1]) uploaded for use with courses in this domain.',$custom).'
        • '; } $resulttext .= '
        '; } else { - $resulttext = &mt('Changes made to scantron format file.'); + $resulttext = &mt('Changes made to bubblesheet format file.'); } $resulttext .= '
      '; &Apache::loncommon::devalidate_domconfig_cache($dom); } else { - $resulttext = &mt('No changes made to scantron format file'); + $resulttext = &mt('No changes made to bubblesheet format file'); } } else { $resulttext = ''. &mt('An error occurred: [_1]',$putresult).''; } } else { - $resulttext = &mt('No changes made to scantron format file'); + $resulttext = &mt('No changes made to bubblesheet format file'); } if ($errors) { $resulttext .= &mt('The following errors occurred: ').'
        '. @@ -5670,15 +7398,13 @@ sub modify_coursecategories { } else { $changes{'togglecats'} = 1; $changes{'categorize'} = 1; - $domconfig{'coursecategories'} = { - togglecats => $env{'form.togglecats'}, - categorize => $env{'form.categorize'}, - }; $changes{'togglecatscomm'} = 1; $changes{'categorizecomm'} = 1; $domconfig{'coursecategories'} = { - togglecats => $env{'form.togglecatscomm'}, - categorize => $env{'form.categorizecomm'}, + togglecats => $env{'form.togglecats'}, + categorize => $env{'form.categorize'}, + togglecatscomm => $env{'form.togglecatscomm'}, + categorizecomm => $env{'form.categorizecomm'}, }; } if (ref($cathash) eq 'HASH') { @@ -5922,7 +7648,6 @@ sub modify_serverstatuses { my %serverstatushash = ( serverstatuses => \%newserverstatus, ); - my %changes; foreach my $type (@pages) { foreach my $setting ('namedusers','machines') { my (@current,@new); @@ -5997,122 +7722,56 @@ sub modify_serverstatuses { sub modify_helpsettings { my ($r,$dom,$confname,%domconfig) = @_; - my ($resulttext,$errors,%changes,%helphash); - - my $customhelpfile = $env{'form.loginhelpurl.filename'}; - my $defaulthelpfile = 'defaulthelp.html'; - my $servadm = $r->dir_config('lonAdmEMail'); - my ($configuserok,$author_ok,$switchserver) = - &config_check($dom,$confname,$servadm); - - my %defaultchecked = ('submitbugs' => 'on'); - my @offon = ('off','on'); - my %title = ( submitbugs => 'Display link for users to submit a bug', - loginhelpurl => 'Unauthenticated login help page set to custom file'); - + my ($resulttext,$errors,%changes,%helphash); + my %defaultchecked = ('submitbugs' => 'on'); + my @offon = ('off','on'); my @toggles = ('submitbugs'); - - $helphash{'helpsettings'} = {}; - - if (ref($domconfig{'helpsettings'}) ne 'HASH') { - if ($domconfig{'helpsettings'} eq '') { - $domconfig{'helpsettings'} = {}; - } - } - if (ref($domconfig{'helpsettings'}) eq 'HASH') { - foreach my $item (@toggles) { - - if ($defaultchecked{$item} eq 'on') { - if (($domconfig{'helpsettings'}{$item} eq '') && - ($env{'form.'.$item} eq '0')) { - $changes{$item} = 1; - } elsif ($domconfig{'helpsettings'}{$item} ne $env{'form.'.$item}) { - $changes{$item} = 1; - } - } elsif ($defaultchecked{$item} eq 'off') { - if (($domconfig{'helpsettings'}{$item} eq '') && - ($env{'form.'.$item} eq '1')) { - $changes{$item} = 1; - } elsif ($domconfig{'helpsettings'}{$item} ne $env{'form.'.$item}) { - $changes{$item} = 1; - } - } - $helphash{'helpsettings'}{$item} = $env{'form.'.$item}; - } - - if ($customhelpfile ne '') { - my $error; - if ($configuserok eq 'ok') { - if ($switchserver) { - $error = &mt("Upload of custom help file is not permitted to this server: [_1]",$switchserver); - } else { - if ($author_ok eq 'ok') { - my ($result,$loginhelpurl) = - &publishlogo($r,'upload','loginhelpurl',$dom, - $confname,'help','','',$customhelpfile); - if ($result eq 'ok') { - $helphash{'helpsettings'}{'loginhelpurl'} = $loginhelpurl; - $changes{'loginhelpurl'} = 1; - } else { - $error = &mt("Upload of [_1] failed because an error occurred publishing the file in RES space. Error was: [_2].",$customhelpfile,$result); - } - } else { - $error = &mt("Upload of [_1] failed because an author role could not be assigned to a Domain Configuration user ([_2]) in domain: [_3]. Error was: [_4].",$customhelpfile,$confname,$dom,$author_ok); - } - } - } else { - $error = &mt("Upload of [_1] failed because a Domain Configuration user ([_2]) could not be created in domain: [_3]. Error was: [_4].",$customhelpfile,$confname,$dom,$configuserok); - } - if ($error) { - &Apache::lonnet::logthis($error); - $errors .= '
      • '.$error.'
      • '; - } - } - - if ($domconfig{'helpsettings'}{'loginhelpurl'} ne '') { - if ($env{'form.loginhelpurl_del'}) { - $helphash{'helpsettings'}{'loginhelpurl'} = ''; - $changes{'loginhelpurl'} = 1; + if ($defaultchecked{$item} eq 'on') { + if ($domconfig{'helpsettings'}{$item} eq '') { + if ($env{'form.'.$item} eq '0') { + $changes{$item} = 1; + } + } elsif ($domconfig{'helpsettings'}{$item} ne $env{'form.'.$item}) { + $changes{$item} = 1; + } + } elsif ($defaultchecked{$item} eq 'off') { + if ($domconfig{'helpsettings'}{$item} eq '') { + if ($env{'form.'.$item} eq '1') { + $changes{$item} = 1; + } + } elsif ($domconfig{'helpsettings'}{$item} ne $env{'form.'.$item}) { + $changes{$item} = 1; + } + } + if (($env{'form.'.$item} eq '0') || ($env{'form.'.$item} eq '1')) { + $helphash{'helpsettings'}{$item} = $env{'form.'.$item}; } } } - - my $putresult; - if (keys(%changes) > 0) { - $putresult = &Apache::lonnet::put_dom('configuration',\%helphash,$dom); - } else { - $putresult = 'ok'; - } - - if ($putresult eq 'ok') { - if (keys(%changes) > 0) { - $resulttext = &mt('Changes made:').'
          '; - foreach my $item (sort(keys(%changes))) { - if ($item eq 'submitbugs') { - $resulttext .= '
        • '.&mt("$title{$item} set to $offon[$env{'form.'.$item}]").'
        • '; - } - if ($item eq 'loginhelpurl') { - if ($helphash{'helpsettings'}{'loginhelpurl'} eq '') { - $resulttext .= '
        • '.&mt('[_1] help file removed; [_2] file will be used for the unathorized help page in this domain.',$customhelpfile,$defaulthelpfile).'
        • '; - } else { - $resulttext .= '
        • '.&mt("$title{$item} [_1]",$customhelpfile).'
        • '; - } - } - } - $resulttext .= '
        '; - } else { - $resulttext = &mt('No changes made to help settings'); - } - } else { - $resulttext = ''. - &mt('An error occurred: [_1]',$putresult).''; + $putresult = &Apache::lonnet::put_dom('configuration',\%helphash,$dom); + if ($putresult eq 'ok') { + $resulttext = &mt('Changes made:').'
          '; + foreach my $item (sort(keys(%changes))) { + if ($item eq 'submitbugs') { + $resulttext .= '
        • '.&mt('Display link to: [_1] set to "'.$offon[$env{'form.'.$item}].'".', + &Apache::loncommon::modal_link('http://bugs.loncapa.org', + &mt('LON-CAPA bug tracker'),600,500)).'
        • '; + } + } + $resulttext .= '
        '; + } else { + $resulttext = &mt('No changes made to help settings'); + $errors .= '
      • '. + &mt('An error occurred storing the settings: [_1]', + $putresult).'
      • '; + } } if ($errors) { - $resulttext .= &mt('The following errors occurred: ').'
          '. + $resulttext .= '
          '.&mt('The following errors occurred: ').'
            '. $errors.'
          '; } return $resulttext; @@ -6186,7 +7845,6 @@ sub modify_coursedefaults { } elsif ($item eq 'anonsurvey_threshold') { $resulttext .= '
        • '.&mt('Responder count required for display of anonymous survey submissions set to [_1].',$defaultshash{'coursedefaults'}{'anonsurvey_threshold'}).'
        • '; } - } $resulttext .= '
        '; } else { @@ -6199,6 +7857,475 @@ sub modify_coursedefaults { return $resulttext; } +sub modify_usersessions { + my ($dom,%domconfig) = @_; + my @hostingtypes = ('version','excludedomain','includedomain'); + my @offloadtypes = ('primary','default'); + my %types = ( + remote => \@hostingtypes, + hosted => \@hostingtypes, + spares => \@offloadtypes, + ); + my @prefixes = ('remote','hosted','spares'); + my @lcversions = &Apache::lonnet::all_loncaparevs(); + my (%by_ip,%by_location,@intdoms); + &build_location_hashes(\@intdoms,\%by_ip,\%by_location); + my @locations = sort(keys(%by_location)); + my (%defaultshash,%changes); + foreach my $prefix (@prefixes) { + $defaultshash{'usersessions'}{$prefix} = {}; + } + my %domdefaults = &Apache::lonnet::get_domain_defaults($dom); + my $resulttext; + my %iphost = &Apache::lonnet::get_iphost(); + foreach my $prefix (@prefixes) { + next if ($prefix eq 'spares'); + foreach my $type (@{$types{$prefix}}) { + my $inuse = $env{'form.'.$prefix.'_'.$type.'_inuse'}; + if ($type eq 'version') { + my $value = $env{'form.'.$prefix.'_'.$type}; + my $okvalue; + if ($value ne '') { + if (grep(/^\Q$value\E$/,@lcversions)) { + $okvalue = $value; + } + } + if (ref($domconfig{'usersessions'}) eq 'HASH') { + if (ref($domconfig{'usersessions'}{$prefix}) eq 'HASH') { + if ($domconfig{'usersessions'}{$prefix}{$type} ne '') { + if ($inuse == 0) { + $changes{$prefix}{$type} = 1; + } else { + if ($okvalue ne $domconfig{'usersessions'}{$prefix}{$type}) { + $changes{$prefix}{$type} = 1; + } + if ($okvalue ne '') { + $defaultshash{'usersessions'}{$prefix}{$type} = $okvalue; + } + } + } else { + if (($inuse == 1) && ($okvalue ne '')) { + $defaultshash{'usersessions'}{$prefix}{$type} = $okvalue; + $changes{$prefix}{$type} = 1; + } + } + } else { + if (($inuse == 1) && ($okvalue ne '')) { + $defaultshash{'usersessions'}{$prefix}{$type} = $okvalue; + $changes{$prefix}{$type} = 1; + } + } + } else { + if (($inuse == 1) && ($okvalue ne '')) { + $defaultshash{'usersessions'}{$prefix}{$type} = $okvalue; + $changes{$prefix}{$type} = 1; + } + } + } else { + my @vals = &Apache::loncommon::get_env_multiple('form.'.$prefix.'_'.$type); + my @okvals; + foreach my $val (@vals) { + if ($val =~ /:/) { + my @items = split(/:/,$val); + foreach my $item (@items) { + if (ref($by_location{$item}) eq 'ARRAY') { + push(@okvals,$item); + } + } + } else { + if (ref($by_location{$val}) eq 'ARRAY') { + push(@okvals,$val); + } + } + } + @okvals = sort(@okvals); + if (ref($domconfig{'usersessions'}) eq 'HASH') { + if (ref($domconfig{'usersessions'}{$prefix}) eq 'HASH') { + if (ref($domconfig{'usersessions'}{$prefix}{$type}) eq 'ARRAY') { + if ($inuse == 0) { + $changes{$prefix}{$type} = 1; + } else { + $defaultshash{'usersessions'}{$prefix}{$type} = \@okvals; + my @changed = &Apache::loncommon::compare_arrays($domconfig{'usersessions'}{$prefix}{$type},$defaultshash{'usersessions'}{$prefix}{$type}); + if (@changed > 0) { + $changes{$prefix}{$type} = 1; + } + } + } else { + if ($inuse == 1) { + $defaultshash{'usersessions'}{$prefix}{$type} = \@okvals; + $changes{$prefix}{$type} = 1; + } + } + } else { + if ($inuse == 1) { + $defaultshash{'usersessions'}{$prefix}{$type} = \@okvals; + $changes{$prefix}{$type} = 1; + } + } + } else { + if ($inuse == 1) { + $defaultshash{'usersessions'}{$prefix}{$type} = \@okvals; + $changes{$prefix}{$type} = 1; + } + } + } + } + } + + my @alldoms = &Apache::lonnet::all_domains(); + my %servers = &Apache::lonnet::internet_dom_servers($dom); + my %spareid = ¤t_offloads_to($dom,$domconfig{'usersessions'},\%servers); + my $savespares; + + foreach my $lonhost (sort(keys(%servers))) { + my $serverhomeID = + &Apache::lonnet::get_server_homeID($servers{$lonhost}); + my $serverhostname = &Apache::lonnet::hostname($lonhost); + $defaultshash{'usersessions'}{'spares'}{$lonhost} = {}; + my %spareschg; + foreach my $type (@{$types{'spares'}}) { + my @okspares; + my @checked = &Apache::loncommon::get_env_multiple('form.spare_'.$type.'_'.$lonhost); + foreach my $server (@checked) { + if (&Apache::lonnet::hostname($server) ne '') { + unless (&Apache::lonnet::hostname($server) eq $serverhostname) { + unless (grep(/^\Q$server\E$/,@okspares)) { + push(@okspares,$server); + } + } + } + } + my $new = $env{'form.newspare_'.$type.'_'.$lonhost}; + my $newspare; + if (($new ne '') && (&Apache::lonnet::hostname($new))) { + unless (&Apache::lonnet::hostname($new) eq $serverhostname) { + $newspare = $new; + } + } + my @spares; + if (($newspare ne '') && (!grep(/^\Q$newspare\E$/,@okspares))) { + @spares = sort(@okspares,$newspare); + } else { + @spares = sort(@okspares); + } + $defaultshash{'usersessions'}{'spares'}{$lonhost}{$type} = \@spares; + if (ref($spareid{$lonhost}) eq 'HASH') { + if (ref($spareid{$lonhost}{$type}) eq 'ARRAY') { + my @diffs = &Apache::loncommon::compare_arrays($spareid{$lonhost}{$type},\@spares); + if (@diffs > 0) { + $spareschg{$type} = 1; + } + } + } + } + if (keys(%spareschg) > 0) { + $changes{'spares'}{$lonhost} = \%spareschg; + } + } + + if (ref($domconfig{'usersessions'}) eq 'HASH') { + if (ref($domconfig{'usersessions'}{'spares'}) eq 'HASH') { + if (ref($changes{'spares'}) eq 'HASH') { + if (keys(%{$changes{'spares'}}) > 0) { + $savespares = 1; + } + } + } else { + $savespares = 1; + } + } + + my $nochgmsg = &mt('No changes made to settings for user session hosting/offloading.'); + if ((keys(%changes) > 0) || ($savespares)) { + my $putresult = &Apache::lonnet::put_dom('configuration',\%defaultshash, + $dom); + if ($putresult eq 'ok') { + if (ref($defaultshash{'usersessions'}) eq 'HASH') { + if (ref($defaultshash{'usersessions'}{'remote'}) eq 'HASH') { + $domdefaults{'remotesessions'} = $defaultshash{'usersessions'}{'remote'}; + } + if (ref($defaultshash{'usersessions'}{'hosted'}) eq 'HASH') { + $domdefaults{'hostedsessions'} = $defaultshash{'usersessions'}{'hosted'}; + } + } + my $cachetime = 24*60*60; + &Apache::lonnet::do_cache_new('domdefaults',$dom,\%domdefaults,$cachetime); + if (keys(%changes) > 0) { + my %lt = &usersession_titles(); + $resulttext = &mt('Changes made:').'
          '; + foreach my $prefix (@prefixes) { + if (ref($changes{$prefix}) eq 'HASH') { + $resulttext .= '
        • '.$lt{$prefix}.'
            '; + if ($prefix eq 'spares') { + if (ref($changes{$prefix}) eq 'HASH') { + foreach my $lonhost (sort(keys(%{$changes{$prefix}}))) { + $resulttext .= '
          • '.$lonhost.' '; + my $lonhostdom = &Apache::lonnet::host_domain($lonhost); + &Apache::lonnet::remote_devalidate_cache($lonhost,'spares',$lonhostdom); + if (ref($changes{$prefix}{$lonhost}) eq 'HASH') { + foreach my $type (@{$types{$prefix}}) { + if ($changes{$prefix}{$lonhost}{$type}) { + my $offloadto = &mt('None'); + if (ref($defaultshash{'usersessions'}{'spares'}{$lonhost}{$type}) eq 'ARRAY') { + if (@{$defaultshash{'usersessions'}{'spares'}{$lonhost}{$type}} > 0) { + $offloadto = join(', ',@{$defaultshash{'usersessions'}{'spares'}{$lonhost}{$type}}); + } + } + $resulttext .= &mt('[_1] set to: [_2].',''.$lt{$type}.'',$offloadto).(' 'x3); + } + } + } + $resulttext .= '
          • '; + } + } + } else { + foreach my $type (@{$types{$prefix}}) { + if (defined($changes{$prefix}{$type})) { + my $newvalue; + if (ref($defaultshash{'usersessions'}) eq 'HASH') { + if (ref($defaultshash{'usersessions'}{$prefix})) { + if ($type eq 'version') { + $newvalue = $defaultshash{'usersessions'}{$prefix}{$type}; + } elsif (ref($defaultshash{'usersessions'}{$prefix}{$type}) eq 'ARRAY') { + if (@{$defaultshash{'usersessions'}{$prefix}{$type}} > 0) { + $newvalue = join(', ',@{$defaultshash{'usersessions'}{$prefix}{$type}}); + } + } + } + } + if ($newvalue eq '') { + if ($type eq 'version') { + $resulttext .= '
          • '.&mt('[_1] set to: off',$lt{$type}).'
          • '; + } else { + $resulttext .= '
          • '.&mt('[_1] set to: none',$lt{$type}).'
          • '; + } + } else { + if ($type eq 'version') { + $newvalue .= ' '.&mt('(or later)'); + } + $resulttext .= '
          • '.&mt('[_1] set to: [_2].',$lt{$type},$newvalue).'
          • '; + } + } + } + } + $resulttext .= '
          '; + } + } + $resulttext .= '
        '; + } else { + $resulttext = $nochgmsg; + } + } else { + $resulttext = ''. + &mt('An error occurred: [_1]',$putresult).''; + } + } else { + $resulttext = $nochgmsg; + } + return $resulttext; +} + +sub modify_loadbalancing { + my ($dom,%domconfig) = @_; + my $primary_id = &Apache::lonnet::domain($dom,'primary'); + my $intdom = &Apache::lonnet::internet_dom($primary_id); + my ($othertitle,$usertypes,$types) = + &Apache::loncommon::sorted_inst_types($dom); + my %servers = &Apache::lonnet::internet_dom_servers($dom); + my @sparestypes = ('primary','default'); + my %typetitles = &sparestype_titles(); + my $resulttext; + my (%currbalancer,%currtargets,%currrules,%existing); + if (ref($domconfig{'loadbalancing'}) eq 'HASH') { + %existing = %{$domconfig{'loadbalancing'}}; + } + &get_loadbalancers_config(\%servers,\%existing,\%currbalancer, + \%currtargets,\%currrules); + my ($saveloadbalancing,%defaultshash,%changes); + my ($alltypes,$othertypes,$titles) = + &loadbalancing_titles($dom,$intdom,$usertypes,$types); + my %ruletitles = &offloadtype_text(); + my @deletions = &Apache::loncommon::get_env_multiple('form.loadbalancing_delete'); + for (my $i=0; $i<$env{'form.loadbalancing_total'}; $i++) { + my $balancer = $env{'form.loadbalancing_lonhost_'.$i}; + if ($balancer eq '') { + next; + } + if (!exists($servers{$balancer})) { + if (exists($currbalancer{$balancer})) { + push(@{$changes{'delete'}},$balancer); + } + next; + } + if ((@deletions > 0) && (grep(/^\Q$i\E$/,@deletions))) { + push(@{$changes{'delete'}},$balancer); + next; + } + if (!exists($currbalancer{$balancer})) { + push(@{$changes{'add'}},$balancer); + } + $defaultshash{'loadbalancing'}{$balancer}{'targets'}{'primary'} = []; + $defaultshash{'loadbalancing'}{$balancer}{'targets'}{'default'} = []; + $defaultshash{'loadbalancing'}{$balancer}{'rules'} = {}; + unless (ref($domconfig{'loadbalancing'}) eq 'HASH') { + $saveloadbalancing = 1; + } + foreach my $sparetype (@sparestypes) { + my @targets = &Apache::loncommon::get_env_multiple('form.loadbalancing_target_'.$i.'_'.$sparetype); + my @offloadto; + foreach my $target (@targets) { + if (($servers{$target}) && ($target ne $balancer)) { + if ($sparetype eq 'default') { + if (ref($defaultshash{'loadbalancing'}{$balancer}{'targets'}{'primary'}) eq 'ARRAY') { + next if (grep(/^\Q$target\E$/,@{$defaultshash{'loadbalancing'}{$balancer}{'targets'}{'primary'}})); + } + } + unless(grep(/^\Q$target\E$/,@offloadto)) { + push(@offloadto,$target); + } + } + $defaultshash{'loadbalancing'}{$balancer}{'targets'}{$sparetype} = \@offloadto; + } + } + if (ref($currtargets{$balancer}) eq 'HASH') { + foreach my $sparetype (@sparestypes) { + if (ref($currtargets{$balancer}{$sparetype}) eq 'ARRAY') { + my @targetdiffs = &Apache::loncommon::compare_arrays($currtargets{$balancer}{$sparetype},$defaultshash{'loadbalancing'}{$balancer}{'targets'}{$sparetype}); + if (@targetdiffs > 0) { + $changes{'curr'}{$balancer}{'targets'} = 1; + } + } elsif (ref($defaultshash{'loadbalancing'}{$balancer}{'targets'}{$sparetype}) eq 'ARRAY') { + if (@{$defaultshash{'loadbalancing'}{$balancer}{'targets'}{$sparetype}} > 0) { + $changes{'curr'}{$balancer}{'targets'} = 1; + } + } + } + } else { + if (ref($defaultshash{'loadbalancing'}{$balancer}) eq 'HASH') { + foreach my $sparetype (@sparestypes) { + if (ref($defaultshash{'loadbalancing'}{$balancer}{'targets'}{$sparetype}) eq 'ARRAY') { + if (@{$defaultshash{'loadbalancing'}{$balancer}{'targets'}{$sparetype}} > 0) { + $changes{'curr'}{$balancer}{'targets'} = 1; + } + } + } + } + } + my $ishomedom; + if (&Apache::lonnet::host_domain($balancer) eq $dom) { + $ishomedom = 1; + } + if (ref($alltypes) eq 'ARRAY') { + foreach my $type (@{$alltypes}) { + my $rule; + unless ((($type eq '_LC_external') || ($type eq '_LC_internetdom')) && + (!$ishomedom)) { + $rule = $env{'form.loadbalancing_rules_'.$i.'_'.$type}; + } + if ($rule eq 'specific') { + $rule = $env{'form.loadbalancing_singleserver_'.$i.'_'.$type}; + } + $defaultshash{'loadbalancing'}{$balancer}{'rules'}{$type} = $rule; + if (ref($currrules{$balancer}) eq 'HASH') { + if ($rule ne $currrules{$balancer}{$type}) { + $changes{'curr'}{$balancer}{'rules'}{$type} = 1; + } + } elsif ($rule ne '') { + $changes{'curr'}{$balancer}{'rules'}{$type} = 1; + } + } + } + } + my $nochgmsg = &mt('No changes made to Load Balancer settings.'); + if ((keys(%changes) > 0) || ($saveloadbalancing)) { + unless (ref($defaultshash{'loadbalancing'}) eq 'HASH') { + $defaultshash{'loadbalancing'} = {}; + } + my $putresult = &Apache::lonnet::put_dom('configuration', + \%defaultshash,$dom); + + if ($putresult eq 'ok') { + if (keys(%changes) > 0) { + if (ref($changes{'delete'}) eq 'ARRAY') { + foreach my $balancer (sort(@{$changes{'delete'}})) { + $resulttext .= '
      • '.&mt('Load Balancing discontinued for: [_1]',$balancer).'
      • '; + &Apache::lonnet::remote_devalidate_cache($balancer,'loadbalancing',$dom); + } + } + if (ref($changes{'add'}) eq 'ARRAY') { + foreach my $balancer (sort(@{$changes{'add'}})) { + $resulttext .= '
      • '.&mt('Load Balancing enabled for: [_1]',$balancer); + } + } + if (ref($changes{'curr'}) eq 'HASH') { + foreach my $balancer (sort(keys(%{$changes{'curr'}}))) { + if (ref($changes{'curr'}{$balancer}) eq 'HASH') { + if ($changes{'curr'}{$balancer}{'targets'}) { + my %offloadstr; + foreach my $sparetype (@sparestypes) { + if (ref($defaultshash{'loadbalancing'}{$balancer}{'targets'}{$sparetype}) eq 'ARRAY') { + if (@{$defaultshash{'loadbalancing'}{$balancer}{'targets'}{$sparetype}} > 0) { + $offloadstr{$sparetype} = join(', ',@{$defaultshash{'loadbalancing'}{$balancer}{'targets'}{$sparetype}}); + } + } + } + if (keys(%offloadstr) == 0) { + $resulttext .= '
      • '.&mt("Servers to which Load Balance server offloads set to 'None', by default").'
      • '; + } else { + my $showoffload; + foreach my $sparetype (@sparestypes) { + $showoffload .= ''.$typetitles{$sparetype}.': '; + if (defined($offloadstr{$sparetype})) { + $showoffload .= $offloadstr{$sparetype}; + } else { + $showoffload .= &mt('None'); + } + $showoffload .= (' 'x3); + } + $resulttext .= '
      • '.&mt('By default, Load Balancer: [_1] set to offload to - [_2]',$balancer,$showoffload).'
      • '; + } + } + } + if (ref($changes{'curr'}{$balancer}{'rules'}) eq 'HASH') { + if ((ref($alltypes) eq 'ARRAY') && (ref($titles) eq 'HASH')) { + foreach my $type (@{$alltypes}) { + if ($changes{'curr'}{$balancer}{'rules'}{$type}) { + my $rule = $defaultshash{'loadbalancing'}{$balancer}{'rules'}{$type}; + my $balancetext; + if ($rule eq '') { + $balancetext = $ruletitles{'default'}; + } elsif (($rule eq 'homeserver') || ($rule eq 'externalbalancer')) { + $balancetext = $ruletitles{$rule}; + } else { + $balancetext = &mt('offload to [_1]',$defaultshash{'loadbalancing'}{$balancer}{'rules'}{$type}); + } + $resulttext .= '
      • '.&mt('Load Balancer: [_1] -- balancing for [_2] set to - "[_3]"',$balancer,$titles->{$type},$balancetext).'
      • '; + } + } + } + } + &Apache::lonnet::remote_devalidate_cache($balancer,'loadbalancing',$dom); + } + } + if ($resulttext ne '') { + $resulttext = &mt('Changes made:').'
          '.$resulttext.'
        '; + } else { + $resulttext = $nochgmsg; + } + } else { + $resulttext = $nochgmsg; + } + } else { + $resulttext = ''. + &mt('An error occurred: [_1]',$putresult).''; + } + } else { + $resulttext = $nochgmsg; + } + return $resulttext; +} + sub recurse_check { my ($chkcats,$categories,$depth,$name) = @_; if (ref($chkcats->[$depth]{$name}) eq 'ARRAY') { @@ -6239,37 +8366,610 @@ sub recurse_cat_deletes { return; } -sub dom_servers { +sub get_active_dcs { my ($dom) = @_; - my (%uniqservers,%servers); - my $primaryserver = &Apache::lonnet::hostname(&Apache::lonnet::domain($dom,'primary')); - my @machinedoms = &Apache::lonnet::machine_domains($primaryserver); - foreach my $mdom (@machinedoms) { - my %currservers = %servers; - my %server = &Apache::lonnet::get_servers($mdom); - %servers = (%currservers,%server); + my %dompersonnel = &Apache::lonnet::get_domain_roles($dom,['dc']); + my %domcoords; + my $numdcs = 0; + my $now = time; + foreach my $server (keys(%dompersonnel)) { + foreach my $user (sort(keys(%{$dompersonnel{$server}}))) { + my ($trole,$uname,$udom,$runame,$rudom,$rsec) = split(/:/,$user); + my ($end,$start) = split(':',$dompersonnel{$server}{$user}); + if (($end eq '') || ($end == 0) || ($end > $now)) { + if ($start <= $now) { + $domcoords{$uname.':'.$udom} = $dompersonnel{$server}{$user}; + } + } + } } - my %by_hostname; - foreach my $id (keys(%servers)) { - push(@{$by_hostname{$servers{$id}}},$id); + return %domcoords; +} + +sub active_dc_picker { + my ($dom,$curr_dc) = @_; + my %domcoords = &get_active_dcs($dom); + my @dcs = sort(keys(%domcoords)); + my $numdcs = scalar(@dcs); + my $datatable; + my $numinrow = 2; + if ($numdcs > 1) { + $datatable = ''; + for (my $i=0; $i<@dcs; $i++) { + my $rem = $i%($numinrow); + if ($rem == 0) { + if ($i > 0) { + $datatable .= ''; + } + $datatable .= ''; + } + my $check = ' '; + if ($curr_dc eq '') { + if (!$i) { + $check = ' checked="checked" '; + } + } elsif ($dcs[$i] eq $curr_dc) { + $check = ' checked="checked" '; + } + if ($i == @dcs - 1) { + my $colsleft = $numinrow - $rem; + if ($colsleft > 1) { + $datatable .= ''; + } + $datatable .= '
        '; + } else { + $datatable .= ''; + } + } else { + $datatable .= ''; + } + my ($dcname,$dcdom) = split(':',$dcs[$i]); + $datatable .= '
        '; + } elsif (@dcs) { + $datatable .= ''; + } + return ($numdcs,$datatable); +} + +sub usersession_titles { + return &Apache::lonlocal::texthash( + hosted => 'Hosting of sessions for users from other domains on servers in this domain', + remote => 'Hosting of sessions for users in this domain on servers in other domains', + spares => 'Servers offloaded to, when busy', + version => 'LON-CAPA version requirement', + excludedomain => 'Allow all, but exclude specific domains', + includedomain => 'Deny all, but include specific domains', + primary => 'Primary (checked first)', + default => 'Default', + ); +} + +sub id_for_thisdom { + my (%servers) = @_; + my %altids; + foreach my $server (keys(%servers)) { + my $serverhome = &Apache::lonnet::get_server_homeID($servers{$server}); + if ($serverhome ne $server) { + $altids{$serverhome} = $server; + } + } + return %altids; +} + +sub count_servers { + my ($currbalancer,%servers) = @_; + my (@spares,$numspares); + foreach my $lonhost (sort(keys(%servers))) { + next if ($currbalancer eq $lonhost); + push(@spares,$lonhost); + } + if ($currbalancer) { + $numspares = scalar(@spares); + } else { + $numspares = scalar(@spares) - 1; + } + return ($numspares,@spares); +} + +sub lonbalance_targets_js { + my ($dom,$types,$servers,$settings) = @_; + my $select = &mt('Select'); + my ($alltargets,$allishome,$allinsttypes,@alltypes); + if (ref($servers) eq 'HASH') { + $alltargets = join("','",sort(keys(%{$servers}))); + my @homedoms; + foreach my $server (sort(keys(%{$servers}))) { + if (&Apache::lonnet::host_domain($server) eq $dom) { + push(@homedoms,'1'); + } else { + push(@homedoms,'0'); + } + } + $allishome = join("','",@homedoms); + } + if (ref($types) eq 'ARRAY') { + if (@{$types} > 0) { + @alltypes = @{$types}; + } } - foreach my $hostname (sort(keys(%by_hostname))) { - if (@{$by_hostname{$hostname}} > 1) { - my $match = 0; - foreach my $id (@{$by_hostname{$hostname}}) { - if (&Apache::lonnet::host_domain($id) eq $dom) { - $uniqservers{$id} = $hostname; - $match = 1; + push(@alltypes,'default','_LC_adv','_LC_author','_LC_internetdom','_LC_external'); + $allinsttypes = join("','",@alltypes); + my (%currbalancer,%currtargets,%currrules,%existing); + if (ref($settings) eq 'HASH') { + %existing = %{$settings}; + } + &get_loadbalancers_config($servers,\%existing,\%currbalancer, + \%currtargets,\%currrules); + my $balancers = join("','",sort(keys(%currbalancer))); + return <<"END"; + + + +END +} + +sub new_spares_js { + my @sparestypes = ('primary','default'); + my $types = join("','",@sparestypes); + my $select = &mt('Select'); + return <<"END"; + + + +END + +} + +sub common_domprefs_js { + return <<"END"; + + + +END + +} + +sub recaptcha_js { + my %lt = &captcha_phrases(); + return <<"END"; + + + +END + +} + +sub captcha_phrases { + return &Apache::lonlocal::texthash ( + priv => 'Private key', + pub => 'Public key', + original => 'original (CAPTCHA)', + recaptcha => 'successor (ReCAPTCHA)', + notused => 'unused', + ); } 1;