version 1.1123, 2011/08/01 22:13:49
|
version 1.1129, 2011/08/09 01:35:24
|
Line 308 sub get_server_homeID {
|
Line 308 sub get_server_homeID {
|
|
|
sub get_remote_globals { |
sub get_remote_globals { |
my ($lonhost,$whathash,$ignore_cache) = @_; |
my ($lonhost,$whathash,$ignore_cache) = @_; |
my (%returnhash,%whatneeded); |
my ($result,%returnhash,%whatneeded); |
if (ref($whathash) eq 'ARRAY') { |
if (ref($whathash) eq 'HASH') { |
foreach my $what (sort(keys(%{$whathash}))) { |
foreach my $what (sort(keys(%{$whathash}))) { |
my $type = $whathash->{$what}; |
|
my $hashid = $lonhost.'-'.$what; |
my $hashid = $lonhost.'-'.$what; |
my ($result,$cached); |
my ($response,$cached); |
unless ($ignore_cache) { |
unless ($ignore_cache) { |
($result,$cached)=&is_cached_new('lonnetglobal',$hashid); |
($response,$cached)=&is_cached_new('lonnetglobal',$hashid); |
$returnhash{$what} = $result; |
|
} |
} |
if (defined($cached)) { |
if (defined($cached)) { |
$returnhash{$what} = $result; |
$returnhash{$what} = $response; |
} else { |
} else { |
$whatneeded{$what} = $type; |
$whatneeded{$what} = 1; |
} |
} |
} |
} |
if (keys(%whatneeded) > 0) { |
if (keys(%whatneeded) == 0) { |
|
$result = 'ok'; |
|
} else { |
my $requested = &freeze_escape(\%whatneeded); |
my $requested = &freeze_escape(\%whatneeded); |
my $rep=&reply('readlonnetglobal:'.$requested,$lonhost); |
my $rep=&reply('readlonnetglobal:'.$requested,$lonhost); |
unless (($rep=~/^refused/) || ($rep=~/^rejected/) || ($rep eq 'con_lost')) { |
if (($rep=~/^(refused|rejected|error)/) || ($rep eq 'con_lost') || |
|
($rep eq 'unknown_cmd')) { |
|
$result = $rep; |
|
} else { |
|
$result = 'ok'; |
my @pairs=split(/\&/,$rep); |
my @pairs=split(/\&/,$rep); |
if ($rep !~ /^error/) { |
foreach my $item (@pairs) { |
foreach my $item (@pairs) { |
my ($key,$value)=split(/=/,$item,2); |
my ($key,$value)=split(/=/,$item,2); |
my $what = &unescape($key); |
my $what = &unescape($key); |
my $hashid = $lonhost.'-'.$what; |
my $hashid = $lonhost.'-'.$what; |
$returnhash{$what}=&thaw_unescape($value); |
$returnhash{$what}=&thaw_unescape($value); |
&do_cache_new('lonnetglobal',$hashid,$returnhash{$what},600); |
&do_cache_new('lonnetglobal',$hashid,$returnhash{$what},600); |
|
} |
|
} |
} |
} |
} |
} |
} |
} |
} |
return %returnhash; |
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 |
# -------------------------------------------------- Non-critical communication |
Line 1134 sub spare_can_host {
|
Line 1142 sub spare_can_host {
|
|
|
sub this_host_spares { |
sub this_host_spares { |
my ($dom) = @_; |
my ($dom) = @_; |
my $cachetime = 60*60*24; |
my ($dom_in_use,$lonhost_in_use,$result); |
my @hosts = ¤t_machine_ids(); |
my @hosts = ¤t_machine_ids(); |
foreach my $lonhost (@hosts) { |
foreach my $lonhost (@hosts) { |
if (&host_domain($lonhost) eq $dom) { |
if (&host_domain($lonhost) eq $dom) { |
my ($result,$cached)=&is_cached_new('spares',$dom); |
$dom_in_use = $dom; |
if (defined($cached)) { |
$lonhost_in_use = $lonhost; |
return $result; |
last; |
} else { |
} |
my %domconfig = |
} |
&Apache::lonnet::get_dom('configuration',['usersessions'],$dom); |
if ($dom_in_use ne '') { |
if (ref($domconfig{'usersessions'}) eq 'HASH') { |
$result = &spares_for_offload($dom_in_use,$lonhost_in_use); |
if (ref($domconfig{'usersessions'}{'spares'}) eq 'HASH') { |
} |
if (ref($domconfig{'usersessions'}{'spares'}{$lonhost}) eq 'HASH') { |
if (ref($result) ne 'HASH') { |
return &do_cache_new('spares',$dom,$domconfig{'usersessions'}{'spares'}{$lonhost},$cachetime); |
$lonhost_in_use = $perlvar{'lonHostID'}; |
|
$dom_in_use = &host_domain($lonhost_in_use); |
|
$result = &spares_for_offload($dom_in_use,$lonhost_in_use); |
|
if (ref($result) ne 'HASH') { |
|
$result = \%spareid; |
|
} |
|
} |
|
return $result; |
|
} |
|
|
|
sub spares_for_offload { |
|
my ($dom_in_use,$lonhost_in_use) = @_; |
|
my ($result,$cached)=&is_cached_new('spares',$dom_in_use); |
|
if (defined($cached)) { |
|
return $result; |
|
} else { |
|
my $cachetime = 60*60*24; |
|
my %domconfig = |
|
&Apache::lonnet::get_dom('configuration',['usersessions'],$dom_in_use); |
|
if (ref($domconfig{'usersessions'}) eq 'HASH') { |
|
if (ref($domconfig{'usersessions'}{'spares'}) eq 'HASH') { |
|
if (ref($domconfig{'usersessions'}{'spares'}{$lonhost_in_use}) eq 'HASH') { |
|
return &do_cache_new('spares',$dom_in_use,$domconfig{'usersessions'}{'spares'}{$lonhost_in_use},$cachetime); |
|
} |
|
} |
|
} |
|
} |
|
return; |
|
} |
|
|
|
sub get_lonbalancer_config { |
|
my ($servers) = @_; |
|
my ($currbalancer,$currtargets); |
|
if (ref($servers) eq 'HASH') { |
|
foreach my $server (keys(%{$servers})) { |
|
my %what = ( |
|
spareid => 1, |
|
perlvar => 1, |
|
); |
|
my ($result,$returnhash) = &get_remote_globals($server,\%what); |
|
if ($result eq 'ok') { |
|
if (ref($returnhash) eq 'HASH') { |
|
if (ref($returnhash->{'perlvar'}) eq 'HASH') { |
|
if ($returnhash->{'perlvar'}->{'lonBalancer'} eq 'yes') { |
|
$currbalancer = $server; |
|
$currtargets = {}; |
|
if (ref($returnhash->{'spareid'}) eq 'HASH') { |
|
if (ref($returnhash->{'spareid'}->{'primary'}) eq 'ARRAY') { |
|
$currtargets->{'primary'} = $returnhash->{'spareid'}->{'primary'}; |
|
} |
|
if (ref($returnhash->{'spareid'}->{'default'}) eq 'ARRAY') { |
|
$currtargets->{'default'} = $returnhash->{'spareid'}->{'default'}; |
|
} |
|
} |
|
last; |
} |
} |
} |
} |
} |
} |
} |
} |
last; |
|
} |
} |
} |
} |
my $serverhomedom = &host_domain($perlvar{'lonHostID'}); |
return ($currbalancer,$currtargets); |
my ($result,$cached)=&is_cached_new('spares',$serverhomedom); |
} |
if (defined($cached)) { |
|
return $result; |
sub check_loadbalancing { |
|
my ($uname,$udom) = @_; |
|
my ($is_balancer,$dom_in_use,$homeintdom,$rule_in_effect, |
|
$offloadto,$otherserver); |
|
my $lonhost = $perlvar{'lonHostID'}; |
|
my $uprimary_id = &Apache::lonnet::domain($udom,'primary'); |
|
my $uintdom = &Apache::lonnet::internet_dom($uprimary_id); |
|
my $intdom = &Apache::lonnet::internet_dom($lonhost); |
|
my $serverhomedom = &host_domain($lonhost); |
|
|
|
my $cachetime = 60*60*24; |
|
|
|
if (($uintdom ne '') && ($uintdom eq $intdom)) { |
|
$dom_in_use = $udom; |
|
$homeintdom = 1; |
|
} else { |
|
$dom_in_use = $serverhomedom; |
|
} |
|
my ($result,$cached)=&is_cached_new('loadbalancing',$dom_in_use); |
|
unless (defined($cached)) { |
|
my %domconfig = |
|
&Apache::lonnet::get_dom('configuration',['loadbalancing'],$dom_in_use); |
|
if (ref($domconfig{'loadbalancing'}) eq 'HASH') { |
|
$result = &do_cache_new('loadbalancing',$dom_in_use,$domconfig{'usersessions'}{'loadbalancing'},$cachetime); |
|
} |
|
} |
|
if (ref($result) eq 'HASH') { |
|
my $currbalancer = $result->{'lonhost'}; |
|
my $currtargets = $result->{'targets'}; |
|
my $currrules = $result->{'rules'}; |
|
if ($currbalancer ne '') { |
|
my @hosts = ¤t_machine_ids(); |
|
if (grep(/^\Q$currbalancer\E$/,@hosts)) { |
|
$is_balancer = 1; |
|
} |
|
} |
|
if ($is_balancer) { |
|
if (ref($currrules) eq 'HASH') { |
|
if ($homeintdom) { |
|
if ($uname ne '') { |
|
if (($currrules->{'_LC_adv'} ne '') || ($currrules->{'_LC_author'} ne '')) { |
|
my ($is_adv,$is_author) = &is_advanced_user($udom,$uname); |
|
if (($currrules->{'_LC_author'} ne '') && ($is_author)) { |
|
$rule_in_effect = $currrules->{'_LC_author'}; |
|
} elsif (($currrules->{'_LC_adv'} ne '') && ($is_adv)) { |
|
$rule_in_effect = $currrules->{'_LC_adv'} |
|
} |
|
} |
|
if ($rule_in_effect eq '') { |
|
my %userenv = &userenvironment($udom,$uname,'inststatus'); |
|
if ($userenv{'inststatus'} ne '') { |
|
my @statuses = map { &unescape($_); } split(/:/,$userenv{'inststatus'}); |
|
my ($othertitle,$usertypes,$types) = |
|
&Apache::loncommon::sorted_inst_types($udom); |
|
if (ref($types) eq 'ARRAY') { |
|
foreach my $type (@{$types}) { |
|
if (grep(/^\Q$type\E$/,@statuses)) { |
|
if (exists($currrules->{$type})) { |
|
$rule_in_effect = $currrules->{$type}; |
|
} |
|
} |
|
} |
|
} |
|
} else { |
|
if (exists($currrules->{'default'})) { |
|
$rule_in_effect = $currrules->{'default'}; |
|
} |
|
} |
|
} |
|
} else { |
|
if (exists($currrules->{'default'})) { |
|
$rule_in_effect = $currrules->{'default'}; |
|
} |
|
} |
|
} else { |
|
if ($currrules->{'_LC_external'} ne '') { |
|
$rule_in_effect = $currrules->{'_LC_external'}; |
|
} |
|
} |
|
$offloadto = &get_loadbalancer_targets($rule_in_effect,$currtargets, |
|
$uname,$udom); |
|
} |
|
} |
|
} elsif (($homeintdom) && ($udom ne $serverhomedom)) { |
|
my ($result,$cached)=&is_cached_new('loadbalancing',$serverhomedom); |
|
unless (defined($cached)) { |
|
my %domconfig = |
|
&Apache::lonnet::get_dom('configuration',['loadbalancing'],$serverhomedom); |
|
if (ref($domconfig{'loadbalancing'}) eq 'HASH') { |
|
$result = &do_cache_new('loadbalancing',$dom_in_use,$domconfig{'usersessions'}{'loadbalancing'},$cachetime); |
|
} |
|
} |
|
if (ref($result) eq 'HASH') { |
|
my $currbalancer = $result->{'lonhost'}; |
|
my $currtargets = $result->{'targets'}; |
|
my $currrules = $result->{'rules'}; |
|
|
|
if ($currbalancer eq $lonhost) { |
|
$is_balancer = 1; |
|
if (ref($currrules) eq 'HASH') { |
|
if ($currrules->{'_LC_internetdom'} ne '') { |
|
$rule_in_effect = $currrules->{'_LC_internetdom'}; |
|
} |
|
} |
|
$offloadto = &get_loadbalancer_targets($rule_in_effect,$currtargets, |
|
$uname,$udom); |
|
} |
|
} else { |
|
if ($perlvar{'lonBalancer'} eq 'yes') { |
|
$is_balancer = 1; |
|
$offloadto = &this_host_spares($dom_in_use); |
|
} |
|
} |
} else { |
} else { |
my %homedomconfig = |
if ($perlvar{'lonBalancer'} eq 'yes') { |
&Apache::lonnet::get_dom('configuration',['usersessions'],$serverhomedom); |
$is_balancer = 1; |
if (ref($homedomconfig{'usersessions'}) eq 'HASH') { |
$offloadto = &this_host_spares($dom_in_use); |
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); |
my $lowest_load = 30000; |
|
if (ref($offloadto) eq 'HASH') { |
|
if (ref($offloadto->{'primary'}) eq 'ARRAY') { |
|
foreach my $try_server (@{$offloadto->{'primary'}}) { |
|
($otherserver,$lowest_load) = |
|
&compare_server_load($try_server,$otherserver,$lowest_load); |
|
} |
|
} |
|
my $found_server = ($otherserver ne '' && $lowest_load < 100); |
|
|
|
if (!$found_server) { |
|
if (ref($offloadto->{'default'}) eq 'ARRAY') { |
|
foreach my $try_server (@{$offloadto->{'default'}}) { |
|
($otherserver,$lowest_load) = |
|
&compare_server_load($try_server,$otherserver,$lowest_load); |
} |
} |
} |
} |
} |
} |
|
} elsif (ref($offloadto) eq 'ARRAY') { |
|
if (@{$offloadto} == 1) { |
|
$otherserver = $offloadto->[0]; |
|
} elsif (@{$offloadto} > 1) { |
|
foreach my $try_server (@{$offloadto}) { |
|
($otherserver,$lowest_load) = |
|
&compare_server_load($try_server,$otherserver,$lowest_load); |
|
} |
|
} |
|
} |
|
return ($is_balancer,$otherserver); |
|
} |
|
|
|
sub get_loadbalancer_targets { |
|
my ($rule_in_effect,$currtargets,$uname,$udom) = @_; |
|
my $offloadto; |
|
if ($rule_in_effect eq '') { |
|
$offloadto = $currtargets; |
|
} else { |
|
if ($rule_in_effect eq 'homeserver') { |
|
my $homeserver = &homeserver($uname,$udom); |
|
if ($homeserver ne 'no_host') { |
|
$offloadto = [$homeserver]; |
|
} |
|
} elsif ($rule_in_effect eq 'externalbalancer') { |
|
my %domconfig = |
|
&Apache::lonnet::get_dom('configuration',['loadbalancing'],$udom); |
|
if (ref($domconfig{'loadbalancing'}) eq 'HASH') { |
|
if ($domconfig{'loadbalancing'}{'lonhost'} ne '') { |
|
if (&hostname($domconfig{'loadbalancing'}{'lonhost'}) ne '') { |
|
$offloadto = [$domconfig{'loadbalancing'}{'lonhost'}]; |
|
} |
|
} |
|
} else { |
|
my %servers = &dom_servers($udom); |
|
my ($remotebalancer,$remotetargets) = &get_lonbalancer_config(\%servers); |
|
if (&hostname($remotebalancer) ne '') { |
|
$offloadto = [$remotebalancer]; |
|
} |
|
} |
|
} elsif (&hostname($rule_in_effect) ne '') { |
|
$offloadto = [$rule_in_effect]; |
|
} |
|
} |
|
return $offloadto; |
|
} |
|
|
|
sub internet_dom_servers { |
|
my ($dom) = @_; |
|
my (%uniqservers,%servers); |
|
my $primaryserver = &hostname(&domain($dom,'primary')); |
|
my @machinedoms = &machine_domains($primaryserver); |
|
foreach my $mdom (@machinedoms) { |
|
my %currservers = %servers; |
|
my %server = &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 (&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 \%spareid; |
return %uniqservers; |
} |
} |
|
|
# ---------------------- Find the homebase for a user from domain's lib servers |
# ---------------------- Find the homebase for a user from domain's lib servers |
Line 5333 sub is_advanced_user {
|
Line 5596 sub is_advanced_user {
|
my ($udom,$uname) = @_; |
my ($udom,$uname) = @_; |
if ($udom ne '' && $uname ne '') { |
if ($udom ne '' && $uname ne '') { |
if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) { |
if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) { |
return $env{'user.adv'}; |
if (wantarray) { |
|
return ($env{'user.adv'},$env{'user.author'}); |
|
} else { |
|
return $env{'user.adv'}; |
|
} |
} |
} |
} |
} |
my %roleshash = &get_my_roles($uname,$udom,'userroles',undef,undef,undef,1); |
my %roleshash = &get_my_roles($uname,$udom,'userroles',undef,undef,undef,1); |
my %allroles; |
my %allroles; |
my $is_adv; |
my ($is_adv,$is_author); |
foreach my $role (keys(%roleshash)) { |
foreach my $role (keys(%roleshash)) { |
my ($trest,$tdomain,$trole,$sec) = split(/:/,$role); |
my ($trest,$tdomain,$trole,$sec) = split(/:/,$role); |
my $area = '/'.$tdomain.'/'.$trest; |
my $area = '/'.$tdomain.'/'.$trest; |
Line 5352 sub is_advanced_user {
|
Line 5619 sub is_advanced_user {
|
} elsif ($trole ne 'gr') { |
} elsif ($trole ne 'gr') { |
&standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area); |
&standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area); |
} |
} |
|
if ($trole eq 'au') { |
|
$is_author = 1; |
|
} |
} |
} |
} |
} |
foreach my $role (keys(%allroles)) { |
foreach my $role (keys(%allroles)) { |
Line 5366 sub is_advanced_user {
|
Line 5636 sub is_advanced_user {
|
} |
} |
} |
} |
} |
} |
|
if (wantarray) { |
|
return ($is_adv,$is_author); |
|
} |
return $is_adv; |
return $is_adv; |
} |
} |
|
|