--- loncom/lonnet/perl/lonnet.pm 2011/08/05 04:35:50 1.1125 +++ loncom/lonnet/perl/lonnet.pm 2011/08/09 01:06:33 1.1128 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1125 2011/08/05 04:35:50 raeburn Exp $ +# $Id: lonnet.pm,v 1.1128 2011/08/09 01:06:33 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1142,43 +1142,80 @@ sub spare_can_host { sub this_host_spares { my ($dom) = @_; - my $cachetime = 60*60*24; + my ($dom_in_use,$lonhost_in_use,$result); 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); - } - } - } - } + $dom_in_use = $dom; + $lonhost_in_use = $lonhost; last; } } - my $serverhomedom = &host_domain($perlvar{'lonHostID'}); - my ($result,$cached)=&is_cached_new('spares',$serverhomedom); + if ($dom_in_use ne '') { + $result = &spares_for_offload($dom_in_use,$lonhost_in_use); + } + if (ref($result) ne 'HASH') { + $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 %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); + 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 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 @@ -5341,12 +5378,16 @@ sub is_advanced_user { my ($udom,$uname) = @_; if ($udom ne '' && $uname ne '') { 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 %allroles; - my $is_adv; + my ($is_adv,$is_author); foreach my $role (keys(%roleshash)) { my ($trest,$tdomain,$trole,$sec) = split(/:/,$role); my $area = '/'.$tdomain.'/'.$trest; @@ -5360,6 +5401,9 @@ sub is_advanced_user { } elsif ($trole ne 'gr') { &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area); } + if ($trole eq 'au') { + $is_author = 1; + } } } foreach my $role (keys(%allroles)) { @@ -5374,6 +5418,9 @@ sub is_advanced_user { } } } + if (wantarray) { + return ($is_adv,$is_author); + } return $is_adv; }