[LON-CAPA-cvs] cvs: loncom(version_2_10_X) /lonnet/perl lonnet.pm

[raeburn]

raeburn		Thu Aug 26 04:15:04 2010 EDT

  Modified files:              (Branch: version_2_10_X)
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - Backport 1.1082.
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1056.4.7 loncom/lonnet/perl/lonnet.pm:1.1056.4.8
--- loncom/lonnet/perl/lonnet.pm:1.1056.4.7	Wed Aug 18 12:22:39 2010
+++ loncom/lonnet/perl/lonnet.pm	Thu Aug 26 04:15:03 2010
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1056.4.7 2010/08/18 12:22:39 raeburn Exp $
+# $Id: lonnet.pm,v 1.1056.4.8 2010/08/26 04:15:03 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -230,7 +230,7 @@
             if (($answer eq 'unknown_cmd') || ($answer eq 'con_lost')) {
                 if ($caller eq 'loncron') {
                     my $ua=new LWP::UserAgent;
-                    $ua->timeout(20);
+                    $ua->timeout(4);
                     my $protocol = $protocol{$lonhost};
                     $protocol = 'http' if ($protocol ne 'https');
                     my $url = $protocol.'://'.&hostname($lonhost).'/adm/about.html';
@@ -756,8 +756,18 @@
     if ($userloadpercent !~ /\d/) { $userloadpercent=0; }
     my $lowest_load=($loadpercent > $userloadpercent) ? $loadpercent 
                                                      :  $userloadpercent;
-    
+    my ($uint_dom,$remotesessions);
+    if ($env{'user.domain'}) {
+        my $uprimary_id = &Apache::lonnet::domain($env{'user.domain'},'primary');
+        $uint_dom = &Apache::lonnet::internet_dom($uprimary_id);
+        my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
+        $remotesessions = $udomdefaults{'remotesessions'};
+    }
     foreach my $try_server (@{ $spareid{'primary'} }) {
+        if ($uint_dom) {
+            next unless (&spare_can_host($env{'user.domain'},$uint_dom,
+                                         $remotesessions,$try_server));
+        }
 	($spare_server, $lowest_load) =
 	    &compare_server_load($try_server, $spare_server, $lowest_load);
     }
@@ -766,6 +776,10 @@
 
     if (!$found_server) {
 	foreach my $try_server (@{ $spareid{'default'} }) {
+            if ($uint_dom) {
+                next unless (&spare_can_host($env{'user.domain'},$uint_dom,
+                                             $remotesessions,$try_server));
+            }
 	    ($spare_server, $lowest_load) =
 		&compare_server_load($try_server, $spare_server, $lowest_load);
 	}
@@ -778,7 +792,7 @@
         }
         if (defined($spare_server)) {
             my $hostname = &hostname($spare_server);
-            if (defined($hostname)) {  
+            if (defined($hostname)) {
 	        $spare_server = $protocol.'://'.$hostname;
             }
         }
@@ -1014,6 +1028,26 @@
     return $canhost;
 }
 
+sub spare_can_host {
+    my ($udom,$uint_dom,$remotesessions,$try_server)=@_;
+    my $canhost=1;
+    my @intdoms;
+    my $internet_names = &Apache::lonnet::get_internet_names($try_server);
+    if (ref($internet_names) eq 'ARRAY') {
+        @intdoms = @{$internet_names};
+    }
+    unless (grep(/^\Q$uint_dom\E$/,@intdoms)) {
+        my $serverhomeID = &Apache::lonnet::get_server_homeID($try_server);
+        my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
+        my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
+        my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$try_server);
+        $canhost = &can_host_session($udom,$try_server,$remoterev,
+                                     $remotesessions,
+                                     $defdomdefaults{'hostedsessions'});
+    }
+    return $canhost;
+}
+
 # ---------------------- Find the homebase for a user from domain's lib servers
 
 my %homecache;