--- loncom/interface/domainprefs.pm 2011/07/31 23:05:00 1.145 +++ loncom/interface/domainprefs.pm 2011/08/10 14:54:42 1.152 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Handler to set domain-wide configuration settings # -# $Id: domainprefs.pm,v 1.145 2011/07/31 23:05:00 raeburn Exp $ +# $Id: domainprefs.pm,v 1.152 2011/08/10 14:54:42 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -197,18 +197,22 @@ 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','autocreate', 'directorysrch','usercreation','usermodification', 'contacts','defaults','scantron','coursecategories', 'serverstatuses','requestcourses','helpsettings', - 'coursedefaults','usersessions'],$dom); + 'coursedefaults','usersessions','loadbalancing'],$dom); my @prefs_order = ('rolecolors','login','defaults','quotas','autoenroll', 'autoupdate','autocreate','directorysrch','contacts', 'usercreation','usermodification','scantron', 'requestcourses','coursecategories','serverstatuses','helpsettings', 'coursedefaults','usersessions'); + if (keys(%servers) > 1) { + push(@prefs_order,'loadbalancing'); + } my %prefs = ( 'rolecolors' => { text => 'Default color schemes', @@ -361,8 +365,16 @@ sub handler { {col1 => "Hosting domain's own users elsewhere", col2 => 'Rules'}], }, + 'loadbalancing' => + {text => 'Dedicated Load Balancer', + help => 'Domain_Configuration_Load_Balancing', + header => [{col1 => 'Server', + 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', @@ -381,7 +393,15 @@ sub handler { 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; + if (keys(%servers) > 1) { + my ($othertitle,$usertypes,$types) = + &Apache::loncommon::sorted_inst_types($dom); + $js = &lonbalance_targets_js($dom,$types,\%servers). + &new_spares_js(). + &common_domprefs_js(); + } + &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'); @@ -465,6 +485,8 @@ sub process_changes { $output = &modify_coursedefaults($dom,%domconfig); } elsif ($action eq 'usersessions') { $output = &modify_usersessions($dom,%domconfig); + } elsif ($action eq 'loadbalancing') { + $output = &modify_loadbalancing($dom,%domconfig); } return $output; } @@ -661,13 +683,22 @@ 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') { @@ -691,6 +722,8 @@ sub print_config_box { $output .= &print_serverstatuses($dom,$settings,\$rowtotal); } elsif ($action eq 'helpsettings') { $output .= &print_helpsettings('top',$dom,$confname,$settings,\$rowtotal); + } elsif ($action eq 'loadbalancing') { + $output .= &print_loadbalancing($dom,$settings,\$rowtotal); } } $output .= ' @@ -707,7 +740,7 @@ sub print_login { my %choices = &login_choices(); if ($position eq 'top') { - my %servers = &dom_servers($dom); + my %servers = &Apache::lonnet::internet_dom_servers($dom); my $choice = $choices{'disallowlogin'}; $css_class = ' class="LC_odd_row"'; $datatable .= ''.$choice.''. @@ -2306,21 +2339,22 @@ sub print_usersessions { &build_location_hashes(\@intdoms,\%by_ip,\%by_location); my @alldoms = &Apache::lonnet::all_domains(); - my %uniques = &Apache::lonnet::get_unique_servers(\@alldoms); - my %servers = &dom_servers($dom); + 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(%uniques) > 1) { + if (keys(%serverhomes) > 1) { my %spareid = ¤t_offloads_to($dom,$settings,\%servers); - $datatable .= &spares_row(\%servers,\%spareid,\%uniques,$rowtotal); + $datatable .= &spares_row($dom,\%servers,\%spareid,\%serverhomes,\%altids,$rowtotal); } else { $datatable .= ''. - &mt('Nothing to set here, as the cluster to which this domain belongs only contains this server.'); + &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 this institution.'); + &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; @@ -2485,14 +2519,16 @@ sub build_location_hashes { sub current_offloads_to { my ($dom,$settings,$servers) = @_; my (%spareid,%otherdomconfigs); - if ((ref($settings) eq 'HASH') && (ref($servers) eq 'HASH')) { + if (ref($servers) eq 'HASH') { foreach my $lonhost (sort(keys(%{$servers}))) { my $gotspares; - 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; + 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) { @@ -2538,13 +2574,18 @@ sub current_offloads_to { $spareid{$lonhost}{'primary'} = $Apache::lonnet::spareid{'primary'}; $spareid{$lonhost}{'default'} = $Apache::lonnet::spareid{'default'}; } else { - my %requested; - $requested{'spareid'} = 'HASH'; - my %returnhash = &Apache::lonnet::get_remote_globals($lonhost,\%requested); - my $spareshash = $returnhash{'spareid'}; - if (ref($spareshash) eq 'HASH') { - $spareid{$lonhost}{'primary'} = $spareshash->{'primary'}; - $spareid{$lonhost}{'default'} = $spareshash->{'default'}; + 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'}; + } + } } } } @@ -2555,54 +2596,101 @@ sub current_offloads_to { } sub spares_row { - my ($servers,$spareid,$uniques,$rowtotal) = @_; + my ($dom,$servers,$spareid,$serverhomes,$altids,$rowtotal) = @_; my $css_class; my $numinrow = 4; my $itemcount = 1; my $datatable; - if ((ref($servers) eq 'HASH') && (ref($spareid) eq 'HASH')) { + 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 .= ' - '.$server.' when busy, offloads to:'; + '.$server.' when busy, offloads to:'."\n"; my (%current,%canselect); - if (ref($spareid->{$server}) eq 'HASH') { - foreach my $type ('primary','default') { + 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) { - $current{$type} .= ''; - for (my $i=0; $i<@spares; $i++) { - my $rem = $i%($numinrow); - if ($rem == 0) { - if ($i > 0) { - $current{$type} .= ''; + if ($othercontrol) { + $current{$type} = join(', ',@spares); + } else { + $current{$type} .= '
'; + 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} .= ''; + $current{$type} .= ''."\n"; } - $current{$type} .= ''; + my $rem = @spares%($numinrow); + my $colsleft = $numinrow - $rem; + if ($colsleft > 1 ) { + $current{$type} .= ''; + } elsif ($colsleft == 1) { + $current{$type} .= ''."\n"; + } + $current{$type} .= '
'. + '  
'; } - $current{$type} .= ''; } } if ($current{$type} eq '') { $current{$type} = &mt('None specified'); } - $canselect{$type} = - &newspare_select($server,$type,$spareid->{$server}{$type},$uniques); + 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"; } - $datatable .= ''.&mt('primary').''.$current{'primary'}.''. - ''.&mt('Add new [_1]primary[_2]:','','').' '. - $canselect{'primary'}.''. - ''. - ''.&mt('default').''. - ''.$current{'default'}.''. - ''.&mt('Add new [_1]default[_2]:','','').' '. - $canselect{'default'}.''; $itemcount ++; } } @@ -2610,28 +2698,281 @@ sub spares_row { return $datatable; } -sub newspare_select { - my ($server,$type,$currspares,$uniques) = @_; - my $output; - if (ref($uniques) eq 'HASH') { - if (keys(%{$uniques}) > 1) { - $output = ''; + } + } + 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); + if (keys(%servers) > 1) { + if (ref($settings) eq 'HASH') { + $currbalancer = $settings->{'lonhost'}; + $currtargets = $settings->{'targets'}; + $currrules = $settings->{'rules'}; + } else { + ($currbalancer,$currtargets) = + &Apache::lonnet::get_lonbalancer_config(\%servers); + } + } 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 = 'class="LC_odd_row"'; + my $targets_div_style = 'display: none'; + my $disabled_div_style = 'display: block'; + my $homedom_div_style = 'display: none'; + $datatable = ''. + ''. + '

'. + '
'.&mt('No dedicated Load Balancer').'
'."\n". + '
'.&mt('Offloads to:').'
'; + my ($numspares,@spares) = &count_servers($currbalancer,%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) eq 'HASH') { + if (ref($currtargets->{$sparetype}) eq 'ARRAY') { + if (grep(/^\Q$spares[$i]\E$/,@{$currtargets->{$sparetype}})) { + $checked = ' checked="checked"'; + } + } + } + my $chkboxval; + if (($currbalancer ne '') && (grep((/^\Q$currbalancer\E$/,keys(%servers))))) { + $chkboxval = $spares[$i]; + } + $targettable .= ''; + my $rem = $i%($numinrow); + if ($rem == 0) { + if ($i > 0) { + $targettable .= ''; + } + $targettable .= ''; + } + } + if ($targettable ne '') { + my $rem = $numspares%($numinrow); + my $colsleft = $numinrow - $rem; + if ($colsleft > 1 ) { + $targettable .= ''. + ' '; + } elsif ($colsleft == 1) { + $targettable .= ' '; + } + $datatable .= ''.$typetitles{$sparetype}.'
'. + ''.$targettable.'

'; + } + } + $datatable .= '
'. + &loadbalancing_rules($dom,$intdom,$currrules,$othertitle, + $usertypes,$types,\%servers,$currbalancer, + $targets_div_style,$homedom_div_style); + $$rowtotal += $rownum; + return $datatable; +} + +sub loadbalancing_rules { + my ($dom,$intdom,$currrules,$othertitle,$usertypes,$types,$servers, + $currbalancer,$targets_div_style,$homedom_div_style) = @_; + my $output; + my ($alltypes,$othertypes,$titles) = + &loadbalancing_titles($dom,$intdom,$usertypes,$types); + if ((ref($alltypes) eq 'ARRAY') && (ref($titles) eq 'HASH')) { + foreach my $type (@{$alltypes}) { + 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($currbalancer)) { + $current = ''; + } + } + $output .= &loadbalance_rule_row($type,$titles->{$type},$current, + $servers,$currbalancer,$dom, + $targets_div_style,$homedom_div_style); } } 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,$dom,$targets_div_style, + $homedom_div_style) = @_; + my @rulenames = ('default','homeserver'); + my %ruletitles = &offloadtype_text(); + if ($type eq '_LC_external') { + push(@rulenames,'externalbalancer'); + } else { + push(@rulenames,'specific'); + } + my $style = $targets_div_style; + if (($type eq '_LC_external') || ($type eq '_LC_internetdom')) { + $style = $homedom_div_style; + } + my $output = + '
'.$title.'
'."\n". + '
'."\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', + ); + 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', @@ -3990,7 +4331,7 @@ 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)) { @@ -7061,46 +7402,50 @@ sub modify_usersessions { } my @alldoms = &Apache::lonnet::all_domains(); - my %uniques = &Apache::lonnet::get_unique_servers(\@alldoms); - my %servers = &dom_servers($dom); + 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) { - unless (($server eq $lonhost) || ($server eq $serverhomeID)) { - if ($uniques{$server}) { - push(@okspares,$server); + 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 '') && ($uniques{$new})) { - unless (($new eq $lonhost) || ($new eq $serverhomeID)) { + if (($new ne '') && (&Apache::lonnet::hostname($new))) { + unless (&Apache::lonnet::hostname($new) eq $serverhostname) { $newspare = $new; - $spareschg{$type} = 1; } } + 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($domconfig{'usersessions'}{'spares'}{$lonhost}{$type},\@okspares); + my @diffs = &Apache::loncommon::compare_arrays($spareid{$lonhost}{$type},\@spares); if (@diffs > 0) { $spareschg{$type} = 1; - } elsif ($new ne '') { - $spareschg{$type} = 1; } } } - my @spares = sort(@okspares,$newspare); - $defaultshash{'usersessions'}{'spares'}{$lonhost}{$type} = \@spares; } if (keys(%spareschg) > 0) { $changes{'spares'}{$lonhost} = \%spareschg; @@ -7119,7 +7464,8 @@ sub modify_usersessions { } } - if (keys(%changes) > 0) { + 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') { @@ -7133,71 +7479,271 @@ sub modify_usersessions { } my $cachetime = 24*60*60; &Apache::lonnet::do_cache_new('domdefaults',$dom,\%domdefaults,$cachetime); - 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.' '; - 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}}); + 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 .= &mt('[_1] set to: [_2]',''.$lt{'type'}.'',$offloadto).(' 'x3); } } + $resulttext .= '
          • '; } - $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}}); + } 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}).'
          • '; + 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 { - $resulttext .= '
        • '.&mt('[_1] set to: none',$lt{$type}).'
          • '; - } - } else { - if ($type eq 'version') { - $newvalue .= ' '.&mt('(or later)'); + if ($type eq 'version') { + $newvalue .= ' '.&mt('(or later)'); + } + $resulttext .= '
        • '.&mt('[_1] set to: [_2].',$lt{$type},$newvalue).'
          • '; } - $resulttext .= '
        • '.&mt('[_1] set to: [_2].',$lt{$type},$newvalue).'
          • '; } } } + $resulttext .= '
        '; } - $resulttext .= '
      '; } + $resulttext .= '
    '; + } else { + $resulttext = $nochgmsg; } - $resulttext .= '
'; } else { $resulttext = ''. &mt('An error occurred: [_1]',$putresult).''; } } else { - $resulttext = &mt('No changes made to settings for user session hosting/offloading.'); + $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; + if (keys(%servers) > 1) { + my ($currbalancer,$currtargets,$currrules); + if (ref($domconfig{'loadbalancing'}) eq 'HASH') { + $currbalancer = $domconfig{'loadbalancing'}{'lonhost'}; + $currtargets = $domconfig{'loadbalancing'}{'targets'}; + $currrules = $domconfig{'loadbalancing'}{'rules'}; + } else { + ($currbalancer,$currtargets) = + &Apache::lonnet::get_lonbalancer_config(\%servers); + } + my ($saveloadbalancing,%defaultshash,%changes); + my ($alltypes,$othertypes,$titles) = + &loadbalancing_titles($dom,$intdom,$usertypes,$types); + my %ruletitles = &offloadtype_text(); + my $balancer = $env{'form.loadbalancing_lonhost'}; + if (!$servers{$balancer}) { + undef($balancer); + } + if ($currbalancer ne $balancer) { + $changes{'lonhost'} = 1; + } + $defaultshash{'loadbalancing'}{'lonhost'} = $balancer; + if ($balancer ne '') { + unless (ref($domconfig{'loadbalancing'}) eq 'HASH') { + $saveloadbalancing = 1; + } + foreach my $sparetype (@sparestypes) { + my @targets = &Apache::loncommon::get_env_multiple('form.loadbalancing_target_'.$sparetype); + my @offloadto; + foreach my $target (@targets) { + if (($servers{$target}) && ($target ne $balancer)) { + if ($sparetype eq 'default') { + if (ref($defaultshash{'loadbalancing'}{'targets'}{'primary'}) eq 'ARRAY') { + next if (grep(/^\Q$target\E$/,@{$defaultshash{'loadbalancing'}{'targets'}{'primary'}})); + } + } + unless(grep(/^\Q$target\E$/,@offloadto)) { + push(@offloadto,$target); + } + } + $defaultshash{'loadbalancing'}{'targets'}{$sparetype} = \@offloadto; + } + } + } else { + foreach my $sparetype (@sparestypes) { + $defaultshash{'loadbalancing'}{'targets'}{$sparetype} = []; + } + } + if (ref($currtargets) eq 'HASH') { + foreach my $sparetype (@sparestypes) { + if (ref($currtargets->{$sparetype}) eq 'ARRAY') { + my @targetdiffs = &Apache::loncommon::compare_arrays($currtargets->{$sparetype},$defaultshash{'loadbalancing'}{'targets'}{$sparetype}); + if (@targetdiffs > 0) { + $changes{'targets'} = 1; + } + } elsif (ref($defaultshash{'loadbalancing'}{'targets'}{$sparetype}) eq 'ARRAY') { + if (@{$defaultshash{'loadbalancing'}{'targets'}{$sparetype}} > 0) { + $changes{'targets'} = 1; + } + } + } + } else { + foreach my $sparetype (@sparestypes) { + if (ref($defaultshash{'loadbalancing'}{'targets'}{$sparetype}) eq 'ARRAY') { + if (@{$defaultshash{'loadbalancing'}{'targets'}{$sparetype}} > 0) { + $changes{'targets'} = 1; + } + } + } + } + my $ishomedom; + if ($balancer ne '') { + if (&Apache::lonnet::host_domain($balancer) eq $dom) { + $ishomedom = 1; + } + } + if (ref($alltypes) eq 'ARRAY') { + foreach my $type (@{$alltypes}) { + my $rule; + if ($balancer ne '') { + unless ((($type eq '_LC_external') || ($type eq '_LC_internetdom')) && + (!$ishomedom)) { + $rule = $env{'form.loadbalancing_rules_'.$type}; + } + if ($rule eq 'specific') { + $rule = $env{'form.loadbalancing_singleserver_'.$type}; + } + } + $defaultshash{'loadbalancing'}{'rules'}{$type} = $rule; + if (ref($currrules) eq 'HASH') { + if ($rule ne $currrules->{$type}) { + $changes{'rules'}{$type} = 1; + } + } elsif ($rule ne '') { + $changes{'rules'}{$type} = 1; + } + } + } + my $nochgmsg = &mt('No changes made to Load Balancer settings.'); + if ((keys(%changes) > 0) || ($saveloadbalancing)) { + my $putresult = &Apache::lonnet::put_dom('configuration', + \%defaultshash,$dom); + if ($putresult eq 'ok') { + if (keys(%changes) > 0) { + if ($changes{'lonhost'}) { + if ($currbalancer ne '') { + &Apache::lonnet::remote_devalidate_cache($currbalancer,'loadbalancing',$dom); + } + if ($balancer eq '') { + $resulttext .= '
  • '.&mt('Load Balancing with dedicated server discontinued').'
    • '; + } else { + &Apache::lonnet::remote_devalidate_cache($balancer,'loadbalancing',$dom); + $resulttext .= '
  • '.&mt('Dedicated Load Balancer server set to [_1]',$balancer); + } + } else { + &Apache::lonnet::remote_devalidate_cache($balancer,'loadbalancing',$dom); + } + if (($changes{'targets'}) && ($balancer ne '')) { + my %offloadstr; + foreach my $sparetype (@sparestypes) { + if (ref($defaultshash{'loadbalancing'}{'targets'}{$sparetype}) eq 'ARRAY') { + if (@{$defaultshash{'loadbalancing'}{'targets'}{$sparetype}} > 0) { + $offloadstr{$sparetype} = join(', ',@{$defaultshash{'loadbalancing'}{'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 server set to offload to: [_1]',$showoffload).'
    • '; + } + } + if ((ref($changes{'rules'}) eq 'HASH') && ($balancer ne '')) { + if ((ref($alltypes) eq 'ARRAY') && (ref($titles) eq 'HASH')) { + foreach my $type (@{$alltypes}) { + if ($changes{'rules'}{$type}) { + my $rule = $defaultshash{'loadbalancing'}{'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'}{'rules'}{$type}); + } + $resulttext .= '
  • '.&mt('Load Balancing for [_1] set to: [_2]',$titles->{$type},$balancetext).'
    • '; + } + } + } + } + if ($resulttext ne '') { + $resulttext = &mt('Changes made:').'
      '.$resulttext.'
    '; + } else { + $resulttext = $nochgmsg; + } + } else { + $resulttext = $nochgmsg; + if ($balancer ne '') { + &Apache::lonnet::remote_devalidate_cache($balancer,'loadbalancing',$dom); + } + } + } else { + $resulttext = ''. + &mt('An error occurred: [_1]',$putresult).''; + } + } else { + $resulttext = $nochgmsg; + } + } else { + $resulttext = &mt('Load Balancing unavailable as this domain only has one server.'); } return $resulttext; } @@ -7242,39 +7788,6 @@ sub recurse_cat_deletes { return; } -sub dom_servers { - 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 %by_hostname; - foreach my $id (keys(%servers)) { - push(@{$by_hostname{$servers{$id}}},$id); - } - 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; - } - } - unless ($match) { - $uniqservers{$by_hostname{$hostname}[0]} = $hostname; - } - } else { - $uniqservers{$by_hostname{$hostname}[0]} = $hostname; - } - } - return %uniqservers; -} - sub get_active_dcs { my ($dom) = @_; my %dompersonnel = &Apache::lonnet::get_domain_roles($dom,['dc']); @@ -7359,4 +7872,326 @@ sub usersession_titles { ); } +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) = @_; + 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}; + } + } + push(@alltypes,'default','_LC_adv','_LC_author','_LC_internetdom','_LC_external'); + $allinsttypes = join("','",@alltypes); + 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 + +} + 1; 500 Internal Server Error

    Internal Server Error

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

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

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