version 1.1170, 2012/05/18 20:03:22
|
version 1.1179, 2012/07/05 19:27:27
|
Line 75 use LWP::UserAgent();
|
Line 75 use LWP::UserAgent();
|
use HTTP::Date; |
use HTTP::Date; |
use Image::Magick; |
use Image::Magick; |
|
|
|
use Encode; |
|
|
use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir |
use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir |
$_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease |
$_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease |
%managerstab); |
%managerstab); |
Line 1237 sub check_loadbalancing {
|
Line 1239 sub check_loadbalancing {
|
my ($is_balancer,$dom_in_use,$homeintdom,$rule_in_effect, |
my ($is_balancer,$dom_in_use,$homeintdom,$rule_in_effect, |
$offloadto,$otherserver); |
$offloadto,$otherserver); |
my $lonhost = $perlvar{'lonHostID'}; |
my $lonhost = $perlvar{'lonHostID'}; |
|
my @hosts = ¤t_machine_ids(); |
my $uprimary_id = &Apache::lonnet::domain($udom,'primary'); |
my $uprimary_id = &Apache::lonnet::domain($udom,'primary'); |
my $uintdom = &Apache::lonnet::internet_dom($uprimary_id); |
my $uintdom = &Apache::lonnet::internet_dom($uprimary_id); |
my $intdom = &Apache::lonnet::internet_dom($lonhost); |
my $intdom = &Apache::lonnet::internet_dom($lonhost); |
Line 1263 sub check_loadbalancing {
|
Line 1266 sub check_loadbalancing {
|
my $currtargets = $result->{'targets'}; |
my $currtargets = $result->{'targets'}; |
my $currrules = $result->{'rules'}; |
my $currrules = $result->{'rules'}; |
if ($currbalancer ne '') { |
if ($currbalancer ne '') { |
my @hosts = ¤t_machine_ids(); |
|
if (grep(/^\Q$currbalancer\E$/,@hosts)) { |
if (grep(/^\Q$currbalancer\E$/,@hosts)) { |
$is_balancer = 1; |
$is_balancer = 1; |
} |
} |
Line 1351 sub check_loadbalancing {
|
Line 1353 sub check_loadbalancing {
|
$offloadto = &this_host_spares($dom_in_use); |
$offloadto = &this_host_spares($dom_in_use); |
} |
} |
} |
} |
my $lowest_load = 30000; |
if ($is_balancer) { |
if (ref($offloadto) eq 'HASH') { |
my $lowest_load = 30000; |
if (ref($offloadto->{'primary'}) eq 'ARRAY') { |
if (ref($offloadto) eq 'HASH') { |
foreach my $try_server (@{$offloadto->{'primary'}}) { |
if (ref($offloadto->{'primary'}) eq 'ARRAY') { |
($otherserver,$lowest_load) = |
foreach my $try_server (@{$offloadto->{'primary'}}) { |
&compare_server_load($try_server,$otherserver,$lowest_load); |
($otherserver,$lowest_load) = |
|
&compare_server_load($try_server,$otherserver,$lowest_load); |
|
} |
} |
} |
} |
my $found_server = ($otherserver ne '' && $lowest_load < 100); |
my $found_server = ($otherserver ne '' && $lowest_load < 100); |
|
|
|
if (!$found_server) { |
if (!$found_server) { |
if (ref($offloadto->{'default'}) eq 'ARRAY') { |
if (ref($offloadto->{'default'}) eq 'ARRAY') { |
foreach my $try_server (@{$offloadto->{'default'}}) { |
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) = |
($otherserver,$lowest_load) = |
&compare_server_load($try_server,$otherserver,$lowest_load); |
&compare_server_load($try_server,$otherserver,$lowest_load); |
} |
} |
} |
} |
} |
} |
} elsif (ref($offloadto) eq 'ARRAY') { |
if (($otherserver ne '') && (grep(/^\Q$otherserver\E$/,@hosts))) { |
if (@{$offloadto} == 1) { |
$is_balancer = 0; |
$otherserver = $offloadto->[0]; |
if ($uname ne '' && $udom ne '') { |
} elsif (@{$offloadto} > 1) { |
if (($env{'user.name'} eq $uname) && ($env{'user.domain'} eq $udom)) { |
foreach my $try_server (@{$offloadto}) { |
|
($otherserver,$lowest_load) = |
&appenv({'user.loadbalexempt' => $lonhost, |
&compare_server_load($try_server,$otherserver,$lowest_load); |
'user.loadbalcheck.time' => time}); |
|
} |
} |
} |
} |
} |
} |
} |
Line 1385 sub check_loadbalancing {
|
Line 1399 sub check_loadbalancing {
|
sub get_loadbalancer_targets { |
sub get_loadbalancer_targets { |
my ($rule_in_effect,$currtargets,$uname,$udom) = @_; |
my ($rule_in_effect,$currtargets,$uname,$udom) = @_; |
my $offloadto; |
my $offloadto; |
if ($rule_in_effect eq '') { |
if ($rule_in_effect eq 'none') { |
|
return [$perlvar{'lonHostID'}]; |
|
} elsif ($rule_in_effect eq '') { |
$offloadto = $currtargets; |
$offloadto = $currtargets; |
} else { |
} else { |
if ($rule_in_effect eq 'homeserver') { |
if ($rule_in_effect eq 'homeserver') { |
Line 1403 sub get_loadbalancer_targets {
|
Line 1419 sub get_loadbalancer_targets {
|
} |
} |
} |
} |
} else { |
} else { |
my %servers = &dom_servers($udom); |
my %servers = &internet_dom_servers($udom); |
my ($remotebalancer,$remotetargets) = &get_lonbalancer_config(\%servers); |
my ($remotebalancer,$remotetargets) = &get_lonbalancer_config(\%servers); |
if (&hostname($remotebalancer) ne '') { |
if (&hostname($remotebalancer) ne '') { |
$offloadto = [$remotebalancer]; |
$offloadto = [$remotebalancer]; |
Line 1941 sub get_domain_defaults {
|
Line 1957 sub get_domain_defaults {
|
} else { |
} else { |
$domdefaults{'defaultquota'} = $domconfig{'quotas'}; |
$domdefaults{'defaultquota'} = $domconfig{'quotas'}; |
} |
} |
my @usertools = ('aboutme','blog','portfolio'); |
my @usertools = ('aboutme','blog','webdav','portfolio'); |
foreach my $item (@usertools) { |
foreach my $item (@usertools) { |
if (ref($domconfig{'quotas'}{$item}) eq 'HASH') { |
if (ref($domconfig{'quotas'}{$item}) eq 'HASH') { |
$domdefaults{$item} = $domconfig{'quotas'}{$item}; |
$domdefaults{$item} = $domconfig{'quotas'}{$item}; |
Line 2568 sub ssi {
|
Line 2584 sub ssi {
|
} |
} |
|
|
$request->header(Cookie => $ENV{'HTTP_COOKIE'}); |
$request->header(Cookie => $ENV{'HTTP_COOKIE'}); |
my $response=$ua->request($request); |
my $response= $ua->request($request); |
|
my $content = Encode::decode_utf8($response->content); |
if (wantarray) { |
if (wantarray) { |
return ($response->content, $response); |
return ($content, $response); |
} else { |
} else { |
return $response->content; |
return $content; |
} |
} |
} |
} |
|
|
Line 3959 my $cachedtime=();
|
Line 3975 my $cachedtime=();
|
sub load_all_first_access { |
sub load_all_first_access { |
my ($uname,$udom)=@_; |
my ($uname,$udom)=@_; |
if (($cachedkey eq $uname.':'.$udom) && |
if (($cachedkey eq $uname.':'.$udom) && |
(abs($cachedtime-time)<5)) { |
(abs($cachedtime-time)<5) && (!$env{'form.markaccess'})) { |
return; |
return; |
} |
} |
$cachedtime=time; |
$cachedtime=time; |
Line 5631 sub usertools_access {
|
Line 5647 sub usertools_access {
|
%tools = ( |
%tools = ( |
aboutme => 1, |
aboutme => 1, |
blog => 1, |
blog => 1, |
|
webdav => 1, |
portfolio => 1, |
portfolio => 1, |
); |
); |
} |
} |
Line 5729 sub usertools_access {
|
Line 5746 sub usertools_access {
|
} |
} |
} |
} |
} else { |
} else { |
if ($context eq 'tools') { |
if (($context eq 'tools') && ($tool ne 'webdav')) { |
$access = 1; |
$access = 1; |
} else { |
} else { |
$access = 0; |
$access = 0; |
Line 9943 sub deversion {
|
Line 9960 sub deversion {
|
sub symbread { |
sub symbread { |
my ($thisfn,$donotrecurse)=@_; |
my ($thisfn,$donotrecurse)=@_; |
my $cache_str='request.symbread.cached.'.$thisfn; |
my $cache_str='request.symbread.cached.'.$thisfn; |
if (defined($env{$cache_str})) { return $env{$cache_str}; } |
if (defined($env{$cache_str})) { |
|
if (($thisfn) || ($env{$cache_str} ne '')) { |
|
return $env{$cache_str}; |
|
} |
|
} |
# no filename provided? try from environment |
# no filename provided? try from environment |
unless ($thisfn) { |
unless ($thisfn) { |
if ($env{'request.symb'}) { |
if ($env{'request.symb'}) { |
Line 10760 sub declutter {
|
Line 10781 sub declutter {
|
$thisfn=~s|^adm/wrapper/||; |
$thisfn=~s|^adm/wrapper/||; |
$thisfn=~s|^adm/coursedocs/showdoc/||; |
$thisfn=~s|^adm/coursedocs/showdoc/||; |
$thisfn=~s/^res\///; |
$thisfn=~s/^res\///; |
|
$thisfn=~s/^priv\///; |
unless (($thisfn =~ /^ext/) || ($thisfn =~ /\.(page|sequence)___\d+___ext/)) { |
unless (($thisfn =~ /^ext/) || ($thisfn =~ /\.(page|sequence)___\d+___ext/)) { |
$thisfn=~s/\?.+$//; |
$thisfn=~s/\?.+$//; |
} |
} |
Line 11682 B<rolesinit($udom,$username)>: get user
|
Line 11704 B<rolesinit($udom,$username)>: get user
|
returns user role, first access and timer interval hashes |
returns user role, first access and timer interval hashes |
|
|
=item * |
=item * |
|
X<privileged()> |
|
B<privileged($username,$domain)>: returns a true if user has a |
|
privileged and active role (i.e. su or dc), false otherwise. |
|
|
|
=item * |
X<getsection()> |
X<getsection()> |
B<getsection($udom,$uname,$cname)>: finds the section of student in the |
B<getsection($udom,$uname,$cname)>: finds the section of student in the |
course $cname, return section name/number or '' for "not in course" |
course $cname, return section name/number or '' for "not in course" |