--- loncom/lonnet/perl/lonnet.pm 2006/09/15 20:49:29 1.781
+++ loncom/lonnet/perl/lonnet.pm 2006/11/10 19:01:59 1.782.2.5
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.781 2006/09/15 20:49:29 raeburn Exp $
+# $Id: lonnet.pm,v 1.782.2.5 2006/11/10 19:01:59 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -295,9 +295,9 @@ sub error {
# ------------------------------------------- Transfer profile into environment
my $env_loaded;
sub transfer_profile_to_env {
- if ($env_loaded) { return; }
+ my ($lonidsdir,$handle,$force_transfer) = @_;
+ if (!$force_transfer && $env_loaded) { return; }
- my ($lonidsdir,$handle)=@_;
if (!defined($lonidsdir)) {
$lonidsdir = $perlvar{'lonIDsDir'};
}
@@ -499,41 +499,60 @@ sub overloaderror {
sub spareserver {
my ($loadpercent,$userloadpercent,$want_server_name) = @_;
- my $tryserver;
- my $spareserver='';
+ my $spare_server;
if ($userloadpercent !~ /\d/) { $userloadpercent=0; }
- my $lowestserver=$loadpercent > $userloadpercent?
- $loadpercent : $userloadpercent;
- foreach $tryserver (keys(%spareid)) {
- my $loadans=&reply('load',$tryserver);
- my $userloadans=&reply('userload',$tryserver);
- if ($loadans !~ /\d/ && $userloadans !~ /\d/) {
- next; #didn't get a number from the server
- }
- my $answer;
- if ($loadans =~ /\d/) {
- if ($userloadans =~ /\d/) {
- #both are numbers, pick the bigger one
- $answer=$loadans > $userloadans?
- $loadans : $userloadans;
- } else {
- $answer = $loadans;
- }
- } else {
- $answer = $userloadans;
- }
- if (($answer =~ /\d/) && ($answer<$lowestserver)) {
- if ($want_server_name) {
- $spareserver=$tryserver;
- } else {
- $spareserver="http://$hostname{$tryserver}";
- }
- $lowestserver=$answer;
+ my $lowest_load=($loadpercent > $userloadpercent) ? $loadpercent
+ : $userloadpercent;
+
+ foreach my $try_server (@{ $spareid{'primary'} }) {
+ ($spare_server, $lowest_load) =
+ &compare_server_load($try_server, $spare_server, $lowest_load);
+ }
+
+ my $found_server = ($spare_server ne '' && $lowest_load < 100);
+
+ if (!$found_server) {
+ foreach my $try_server (@{ $spareid{'default'} }) {
+ ($spare_server, $lowest_load) =
+ &compare_server_load($try_server, $spare_server, $lowest_load);
}
}
- return $spareserver;
+
+ if (!$want_server_name) {
+ $spare_server="http://$hostname{$spare_server}";
+ }
+ return $spare_server;
}
+sub compare_server_load {
+ my ($try_server, $spare_server, $lowest_load) = @_;
+
+ my $loadans = &reply('load', $try_server);
+ my $userloadans = &reply('userload',$try_server);
+
+ if ($loadans !~ /\d/ && $userloadans !~ /\d/) {
+ next; #didn't get a number from the server
+ }
+
+ my $load;
+ if ($loadans =~ /\d/) {
+ if ($userloadans =~ /\d/) {
+ #both are numbers, pick the bigger one
+ $load = ($loadans > $userloadans) ? $loadans
+ : $userloadans;
+ } else {
+ $load = $loadans;
+ }
+ } else {
+ $load = $userloadans;
+ }
+
+ if (($load =~ /\d/) && ($load < $lowest_load)) {
+ $spare_server = $try_server;
+ $lowest_load = $load;
+ }
+ return ($spare_server,$lowest_load);
+}
# --------------------------------------------- Try to change a user's password
sub changepass {
@@ -1191,6 +1210,15 @@ sub ssi_body {
# --------------------------------------------------------- Server Side Include
+sub absolute_url {
+ my ($host_name) = @_;
+ my $protocol = ($ENV{'SERVER_PORT'} == 443?'https://':'http://');
+ if ($host_name eq '') {
+ $host_name = $ENV{'SERVER_NAME'};
+ }
+ return $protocol.$host_name;
+}
+
sub ssi {
my ($fn,%form)=@_;
@@ -1202,10 +1230,10 @@ sub ssi {
$form{'no_update_last_known'}=1;
if (%form) {
- $request=new HTTP::Request('POST',"http://".$ENV{'HTTP_HOST'}.$fn);
+ $request=new HTTP::Request('POST',&absolute_url().$fn);
$request->content(join('&',map { &escape($_).'='.&escape($form{$_}) } keys %form));
} else {
- $request=new HTTP::Request('GET',"http://".$ENV{'HTTP_HOST'}.$fn);
+ $request=new HTTP::Request('GET',&absolute_url().$fn);
}
$request->header(Cookie => $ENV{'HTTP_COOKIE'});
@@ -6545,6 +6573,7 @@ sub rndseed {
if (!$domain) { $domain=$wdomain; }
if (!$username) { $username=$wusername }
my $which=&get_rand_alg();
+
if (defined(&getCODE())) {
if ($which eq '64bit5') {
return &rndseed_CODE_64bit5($symb,$courseid,$domain,$username);
@@ -6602,7 +6631,6 @@ sub rndseed_64bit {
#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
#&Apache::lonxml::debug("rndseed :$num:$symb");
if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); }
- if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); }
return "$num1,$num2";
}
}
@@ -6625,6 +6653,7 @@ sub rndseed_64bit2 {
my $num2=$nameseed+$domainseed+$courseseed;
#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
#&Apache::lonxml::debug("rndseed :$num:$symb");
+ if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); }
return "$num1,$num2";
}
}
@@ -7200,7 +7229,9 @@ sub get_iphost {
while (my $configline=<$config>) {
chomp($configline);
if ($configline) {
- $spareid{$configline}=1;
+ my ($host,$type) = split(':',$configline,2);
+ if (!defined($type) || $type eq '') { $type = 'default' };
+ push(@{ $spareid{$type} }, $host);
}
}
close($config);
@@ -7262,7 +7293,9 @@ sub get_iphost {
}
-$memcache=new Cache::Memcached({'servers'=>['127.0.0.1:11211']});
+$memcache=new Cache::Memcached({'servers' => ['127.0.0.1:11211'],
+ 'compress_threshold'=> 20_000,
+ });
$processmarker='_'.time.'_'.$perlvar{'lonHostID'};
$dumpcount=0;