--- loncom/lonnet/perl/lonnet.pm 2012/09/04 20:48:05 1.1190 +++ loncom/lonnet/perl/lonnet.pm 2012/09/25 19:54:38 1.1191 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1190 2012/09/04 20:48:05 raeburn Exp $ +# $Id: lonnet.pm,v 1.1191 2012/09/25 19:54:38 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1240,8 +1240,8 @@ sub get_lonbalancer_config { sub check_loadbalancing { my ($uname,$udom) = @_; - my ($is_balancer,$dom_in_use,$homeintdom,$rule_in_effect, - $offloadto,$otherserver); + my ($is_balancer,$currtargets,$currrules,$dom_in_use,$homeintdom, + $rule_in_effect,$offloadto,$otherserver); my $lonhost = $perlvar{'lonHostID'}; my @hosts = ¤t_machine_ids(); my $uprimary_id = &Apache::lonnet::domain($udom,'primary'); @@ -1266,14 +1266,8 @@ sub check_loadbalancing { } } if (ref($result) eq 'HASH') { - my $currbalancer = $result->{'lonhost'}; - my $currtargets = $result->{'targets'}; - my $currrules = $result->{'rules'}; - if ($currbalancer ne '') { - if (grep(/^\Q$currbalancer\E$/,@hosts)) { - $is_balancer = 1; - } - } + ($is_balancer,$currtargets,$currrules) = + &check_balancer_result($result,@hosts); if ($is_balancer) { if (ref($currrules) eq 'HASH') { if ($homeintdom) { @@ -1331,12 +1325,9 @@ sub check_loadbalancing { } } if (ref($result) eq 'HASH') { - my $currbalancer = $result->{'lonhost'}; - my $currtargets = $result->{'targets'}; - my $currrules = $result->{'rules'}; - - if ($currbalancer eq $lonhost) { - $is_balancer = 1; + ($is_balancer,$currtargets,$currrules) = + &check_balancer_result($result,@hosts); + if ($is_balancer) { if (ref($currrules) eq 'HASH') { if ($currrules->{'_LC_internetdom'} ne '') { $rule_in_effect = $currrules->{'_LC_internetdom'}; @@ -1400,6 +1391,32 @@ sub check_loadbalancing { return ($is_balancer,$otherserver); } +sub check_balancer_result { + my ($result,@hosts) = @_; + my ($is_balancer,$currtargets,$currrules); + if (ref($result) eq 'HASH') { + if ($result->{'lonhost'} ne '') { + my $currbalancer = $result->{'lonhost'}; + if (grep(/^\Q$currbalancer\E$/,@hosts)) { + $is_balancer = 1; + $currtargets = $result->{'targets'}; + $currrules = $result->{'rules'}; + } + } else { + foreach my $key (keys(%{$result})) { + if (($key ne '') && (grep(/^\Q$key\E$/,@hosts)) && + (ref($result->{$key}) eq 'HASH')) { + $is_balancer = 1; + $currrules = $result->{$key}{'rules'}; + $currtargets = $result->{$key}{'targets'}; + last; + } + } + } + } + return ($is_balancer,$currtargets,$currrules); +} + sub get_loadbalancer_targets { my ($rule_in_effect,$currtargets,$uname,$udom) = @_; my $offloadto;