version 1.1056.4.28, 2011/07/28 18:30:16
|
version 1.1056.4.33, 2011/10/19 16:36:02
|
Line 76 use HTTP::Date;
|
Line 76 use HTTP::Date;
|
use Image::Magick; |
use Image::Magick; |
|
|
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); |
|
|
my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash, |
my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash, |
%userrolehash, $processmarker, $dumpcount, %coursedombuf, |
%userrolehash, $processmarker, $dumpcount, %coursedombuf, |
Line 831 sub compare_server_load {
|
Line 832 sub compare_server_load {
|
my $userloadans = &reply('userload',$try_server); |
my $userloadans = &reply('userload',$try_server); |
|
|
if ($loadans !~ /\d/ && $userloadans !~ /\d/) { |
if ($loadans !~ /\d/ && $userloadans !~ /\d/) { |
return; #didn't get a number from the server |
return ($spare_server, $lowest_load); #didn't get a number from the server |
} |
} |
|
|
my $load; |
my $load; |
Line 877 sub has_user_session {
|
Line 878 sub has_user_session {
|
# --------- determine least loaded server in a user's domain which allows login |
# --------- determine least loaded server in a user's domain which allows login |
|
|
sub choose_server { |
sub choose_server { |
my ($udom) = @_; |
my ($udom,$checkloginvia) = @_; |
my %domconfhash = &Apache::loncommon::get_domainconf($udom); |
my %domconfhash = &Apache::loncommon::get_domainconf($udom); |
my %servers = &get_servers($udom); |
my %servers = &get_servers($udom); |
my $lowest_load = 30000; |
my $lowest_load = 30000; |
my ($login_host,$hostname); |
my ($login_host,$hostname,$portal_path); |
foreach my $lonhost (keys(%servers)) { |
foreach my $lonhost (keys(%servers)) { |
my $loginvia = $domconfhash{$udom.'.login.loginvia_'.$lonhost}; |
my $loginvia; |
if ($loginvia eq '') { |
if ($checkloginvia) { |
|
$loginvia = $domconfhash{$udom.'.login.loginvia_'.$lonhost}; |
|
if ($loginvia) { |
|
my ($server,$path) = split(/:/,$loginvia); |
|
($login_host, $lowest_load) = |
|
&compare_server_load($lonhost, $login_host, $lowest_load); |
|
if ($login_host eq $server) { |
|
$portal_path = $path; |
|
} |
|
} else { |
|
($login_host, $lowest_load) = |
|
&compare_server_load($lonhost, $login_host, $lowest_load); |
|
if ($login_host eq $lonhost) { |
|
$portal_path = ''; |
|
} |
|
} |
|
} else { |
($login_host, $lowest_load) = |
($login_host, $lowest_load) = |
&compare_server_load($lonhost, $login_host, $lowest_load); |
&compare_server_load($lonhost, $login_host, $lowest_load); |
} |
} |
} |
} |
if ($login_host ne '') { |
if ($login_host ne '') { |
$hostname = $servers{$login_host}; |
$hostname = &hostname($login_host); |
} |
} |
return ($login_host,$hostname); |
return ($login_host,$hostname); |
} |
} |
Line 3698 sub hashref2str {
|
Line 3715 sub hashref2str {
|
$result.='='; |
$result.='='; |
#print("Got a ref of ".(ref($key))." skipping."); |
#print("Got a ref of ".(ref($key))." skipping."); |
} else { |
} else { |
if ($key) {$result.=&escape($key).'=';} else { last; } |
if (defined($key)) {$result.=&escape($key).'=';} else { last; } |
} |
} |
|
|
if(ref($hashref->{$key}) eq 'ARRAY') { |
if(ref($hashref->{$key}) eq 'ARRAY') { |
Line 6732 sub assignrole {
|
Line 6749 sub assignrole {
|
return 'refused'; |
return 'refused'; |
} |
} |
} |
} |
|
} elsif ($role eq 'au') { |
|
if ($url ne '/'.$udom.'/') { |
|
&logthis('Attempt by '.$env{'user.name'}.':'.$env{'user.domain'}. |
|
' to assign author role for '.$uname.':'.$udom. |
|
' in domain: '.$url.' refused (wrong domain).'); |
|
return 'refused'; |
|
} |
} |
} |
$mrole=$role; |
$mrole=$role; |
} |
} |
Line 10006 sub get_dns {
|
Line 10030 sub get_dns {
|
while (%alldns) { |
while (%alldns) { |
my ($dns) = keys(%alldns); |
my ($dns) = keys(%alldns); |
my $ua=new LWP::UserAgent; |
my $ua=new LWP::UserAgent; |
|
$ua->timeout(30); |
my $request=new HTTP::Request('GET',"$alldns{$dns}://$dns$url"); |
my $request=new HTTP::Request('GET',"$alldns{$dns}://$dns$url"); |
my $response=$ua->request($request); |
my $response=$ua->request($request); |
delete($alldns{$dns}); |
delete($alldns{$dns}); |
Line 10521 BEGIN {
|
Line 10546 BEGIN {
|
} |
} |
} |
} |
|
|
|
# ---------------------------------------------------------- Read managers table |
|
{ |
|
if (-e "$perlvar{'lonTabDir'}/managers.tab") { |
|
if (open(my $config,"<$perlvar{'lonTabDir'}/managers.tab")) { |
|
while (my $configline=<$config>) { |
|
chomp($configline); |
|
next if ($configline =~ /^\#/); |
|
if (($configline =~ /^[\w\-]+$/) || ($configline =~ /^[\w\-]+\:[\w\-]+$/)) { |
|
$managerstab{$configline} = 1; |
|
} |
|
} |
|
close($config); |
|
} |
|
} |
|
} |
|
|
# ------------- set up temporary directory |
# ------------- set up temporary directory |
{ |
{ |
$tmpdir = $perlvar{'lonDaemons'}.'/tmp/'; |
$tmpdir = $perlvar{'lonDaemons'}.'/tmp/'; |
Line 11414 splitting on '&', supports elements that
|
Line 11455 splitting on '&', supports elements that
|
|
|
=head2 Logging Routines |
=head2 Logging Routines |
|
|
=over 4 |
|
|
|
These routines allow one to make log messages in the lonnet.log and |
These routines allow one to make log messages in the lonnet.log and |
lonnet.perm logfiles. |
lonnet.perm logfiles. |
|
|
|
=over 4 |
|
|
=item * |
=item * |
|
|
logtouch() : make sure the logfile, lonnet.log, exists |
logtouch() : make sure the logfile, lonnet.log, exists |