--- loncom/lonnet/perl/lonnet.pm 2011/07/28 18:22:44 1.1120 +++ loncom/lonnet/perl/lonnet.pm 2011/08/05 04:35:50 1.1125 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1120 2011/07/28 18:22:44 raeburn Exp $ +# $Id: lonnet.pm,v 1.1125 2011/08/05 04:35:50 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -306,6 +306,52 @@ sub get_server_homeID { return &do_cache_new('serverhomeID',$hostname,$serverhomeID,$cachetime); } +sub get_remote_globals { + my ($lonhost,$whathash,$ignore_cache) = @_; + my ($result,%returnhash,%whatneeded); + if (ref($whathash) eq 'HASH') { + foreach my $what (sort(keys(%{$whathash}))) { + my $hashid = $lonhost.'-'.$what; + my ($response,$cached); + unless ($ignore_cache) { + ($response,$cached)=&is_cached_new('lonnetglobal',$hashid); + } + if (defined($cached)) { + $returnhash{$what} = $response; + } else { + $whatneeded{$what} = 1; + } + } + if (keys(%whatneeded) == 0) { + $result = 'ok'; + } else { + my $requested = &freeze_escape(\%whatneeded); + my $rep=&reply('readlonnetglobal:'.$requested,$lonhost); + if (($rep=~/^(refused|rejected|error)/) || ($rep eq 'con_lost') || + ($rep eq 'unknown_cmd')) { + $result = $rep; + } else { + $result = 'ok'; + my @pairs=split(/\&/,$rep); + foreach my $item (@pairs) { + my ($key,$value)=split(/=/,$item,2); + my $what = &unescape($key); + my $hashid = $lonhost.'-'.$what; + $returnhash{$what}=&thaw_unescape($value); + &do_cache_new('lonnetglobal',$hashid,$returnhash{$what},600); + } + } + } + } + return ($result,\%returnhash); +} + +sub remote_devalidate_cache { + my ($lonhost,$name,$id) = @_; + my $response = &reply('devalidatecache',&escape($name).':'.&escape($id),$lonhost); + return $response; +} + # -------------------------------------------------- Non-critical communication sub subreply { my ($cmd,$server)=@_; @@ -773,26 +819,33 @@ sub spareserver { my %udomdefaults = &Apache::lonnet::get_domain_defaults($udom); $remotesessions = $udomdefaults{'remotesessions'}; } - foreach my $try_server (@{ $spareid{'primary'} }) { - if ($uint_dom) { - next unless (&spare_can_host($udom,$uint_dom,$remotesessions, - $try_server)); + my $spareshash = &this_host_spares($udom); + if (ref($spareshash) eq 'HASH') { + if (ref($spareshash->{'primary'}) eq 'ARRAY') { + foreach my $try_server (@{ $spareshash->{'primary'} }) { + if ($uint_dom) { + next unless (&spare_can_host($udom,$uint_dom,$remotesessions, + $try_server)); + } + ($spare_server, $lowest_load) = + &compare_server_load($try_server, $spare_server, $lowest_load); + } } - ($spare_server, $lowest_load) = - &compare_server_load($try_server, $spare_server, $lowest_load); - } - my $found_server = ($spare_server ne '' && $lowest_load < 100); + my $found_server = ($spare_server ne '' && $lowest_load < 100); - if (!$found_server) { - foreach my $try_server (@{ $spareid{'default'} }) { - if ($uint_dom) { - next unless (&spare_can_host($udom,$uint_dom,$remotesessions, - $try_server)); - } - ($spare_server, $lowest_load) = - &compare_server_load($try_server, $spare_server, $lowest_load); - } + if (!$found_server) { + if (ref($spareshash->{'default'}) eq 'ARRAY') { + foreach my $try_server (@{ $spareshash->{'default'} }) { + if ($uint_dom) { + next unless (&spare_can_host($udom,$uint_dom, + $remotesessions,$try_server)); + } + ($spare_server, $lowest_load) = + &compare_server_load($try_server, $spare_server, $lowest_load); + } + } + } } if (!$want_server_name) { @@ -843,9 +896,18 @@ sub compare_server_load { # --------------------------- ask offload servers if user already has a session sub find_existing_session { my ($udom,$uname) = @_; - foreach my $try_server (@{ $spareid{'primary'} }, - @{ $spareid{'default'} }) { - return $try_server if (&has_user_session($try_server, $udom, $uname)); + my $spareshash = &this_host_spares($udom); + if (ref($spareshash) eq 'HASH') { + if (ref($spareshash->{'primary'}) eq 'ARRAY') { + foreach my $try_server (@{ $spareshash->{'primary'} }) { + return $try_server if (&has_user_session($try_server, $udom, $uname)); + } + } + if (ref($spareshash->{'default'}) eq 'ARRAY') { + foreach my $try_server (@{ $spareshash->{'default'} }) { + return $try_server if (&has_user_session($try_server, $udom, $uname)); + } + } } return; } @@ -1078,6 +1140,47 @@ sub spare_can_host { return $canhost; } +sub this_host_spares { + my ($dom) = @_; + my $cachetime = 60*60*24; + my @hosts = ¤t_machine_ids(); + foreach my $lonhost (@hosts) { + if (&host_domain($lonhost) eq $dom) { + my ($result,$cached)=&is_cached_new('spares',$dom); + if (defined($cached)) { + return $result; + } else { + my %domconfig = + &Apache::lonnet::get_dom('configuration',['usersessions'],$dom); + if (ref($domconfig{'usersessions'}) eq 'HASH') { + if (ref($domconfig{'usersessions'}{'spares'}) eq 'HASH') { + if (ref($domconfig{'usersessions'}{'spares'}{$lonhost}) eq 'HASH') { + return &do_cache_new('spares',$dom,$domconfig{'usersessions'}{'spares'}{$lonhost},$cachetime); + } + } + } + } + last; + } + } + my $serverhomedom = &host_domain($perlvar{'lonHostID'}); + my ($result,$cached)=&is_cached_new('spares',$serverhomedom); + if (defined($cached)) { + return $result; + } else { + my %homedomconfig = + &Apache::lonnet::get_dom('configuration',['usersessions'],$serverhomedom); + if (ref($homedomconfig{'usersessions'}) eq 'HASH') { + if (ref($homedomconfig{'usersessions'}{'spares'}) eq 'HASH') { + if (ref($homedomconfig{'usersessions'}{'spares'}{$perlvar{'lonHostID'}}) eq 'HASH') { + return &do_cache_new('spares',$serverhomedom,$homedomconfig{'usersessions'}{'spares'}{$perlvar{'lonHostID'}},$cachetime); + } + } + } + } + return \%spareid; +} + # ---------------------- Find the homebase for a user from domain's lib servers my %homecache;