--- loncom/lonnet/perl/lonnet.pm 2012/05/18 20:03:22 1.1170 +++ loncom/lonnet/perl/lonnet.pm 2012/06/01 11:39:33 1.1177 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1170 2012/05/18 20:03:22 droeschl Exp $ +# $Id: lonnet.pm,v 1.1177 2012/06/01 11:39:33 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -75,6 +75,8 @@ use LWP::UserAgent(); use HTTP::Date; use Image::Magick; +use Encode; + use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir $_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease %managerstab); @@ -1237,6 +1239,7 @@ sub check_loadbalancing { my ($is_balancer,$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'); my $uintdom = &Apache::lonnet::internet_dom($uprimary_id); my $intdom = &Apache::lonnet::internet_dom($lonhost); @@ -1263,7 +1266,6 @@ sub check_loadbalancing { 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; } @@ -1351,31 +1353,43 @@ sub check_loadbalancing { $offloadto = &this_host_spares($dom_in_use); } } - 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); + if ($is_balancer) { + 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); + my $found_server = ($otherserver ne '' && $lowest_load < 100); - if (!$found_server) { - if (ref($offloadto->{'default'}) eq 'ARRAY') { - foreach my $try_server (@{$offloadto->{'default'}}) { + 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); } } } - } 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); + if (($otherserver ne '') && (grep(/^\Q$otherserver\E$/,@hosts))) { + $is_balancer = 0; + if ($uname ne '' && $udom ne '') { + if (($env{'user.name'} eq $uname) && ($env{'user.domain'} eq $udom)) { + + &appenv({'user.loadbalexempt' => $lonhost, + 'user.loadbalcheck.time' => time}); + } } } } @@ -1385,7 +1399,9 @@ sub check_loadbalancing { sub get_loadbalancer_targets { my ($rule_in_effect,$currtargets,$uname,$udom) = @_; my $offloadto; - if ($rule_in_effect eq '') { + if ($rule_in_effect eq 'none') { + return [$perlvar{'lonHostID'}]; + } elsif ($rule_in_effect eq '') { $offloadto = $currtargets; } else { if ($rule_in_effect eq 'homeserver') { @@ -1941,7 +1957,7 @@ sub get_domain_defaults { } else { $domdefaults{'defaultquota'} = $domconfig{'quotas'}; } - my @usertools = ('aboutme','blog','portfolio'); + my @usertools = ('aboutme','blog','webdav','portfolio'); foreach my $item (@usertools) { if (ref($domconfig{'quotas'}{$item}) eq 'HASH') { $domdefaults{$item} = $domconfig{'quotas'}{$item}; @@ -2568,12 +2584,12 @@ sub ssi { } $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) { - return ($response->content, $response); + return ($content, $response); } else { - return $response->content; + return $content; } } @@ -3959,7 +3975,7 @@ my $cachedtime=(); sub load_all_first_access { my ($uname,$udom)=@_; if (($cachedkey eq $uname.':'.$udom) && - (abs($cachedtime-time)<5)) { + (abs($cachedtime-time)<5) && (!$env{'form.markaccess'})) { return; } $cachedtime=time; @@ -5631,6 +5647,7 @@ sub usertools_access { %tools = ( aboutme => 1, blog => 1, + webdav => 1, portfolio => 1, ); } @@ -5729,7 +5746,7 @@ sub usertools_access { } } } else { - if ($context eq 'tools') { + if (($context eq 'tools') && ($tool ne 'webdav')) { $access = 1; } else { $access = 0; @@ -10760,6 +10777,7 @@ sub declutter { $thisfn=~s|^adm/wrapper/||; $thisfn=~s|^adm/coursedocs/showdoc/||; $thisfn=~s/^res\///; + $thisfn=~s/^priv\///; unless (($thisfn =~ /^ext/) || ($thisfn =~ /\.(page|sequence)___\d+___ext/)) { $thisfn=~s/\?.+$//; } @@ -11682,6 +11700,11 @@ B: get user returns user role, first access and timer interval hashes =item * +X +B: returns a true if user has a +privileged and active role (i.e. su or dc), false otherwise. + +=item * X B: finds the section of student in the course $cname, return section name/number or '' for "not in course"