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

[raeburn]

raeburn		Mon Aug  1 22:13:50 2011 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - Bug 6371. 
  - Added &this_host_spares() routine to get servers to offload to when busy.
    - More granularity in "spares" now possible for different domains on a 
      multidomain server.
    - Spares checked in following order:
      (a) Check for offload setting for user's domain (if server "belongs" to domain).
      (b) Check for offload setting for domain for lonHostID for server.
      (c) If domain configuration never set use items in legacy spare.tab.
  Work in progress.
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1122 loncom/lonnet/perl/lonnet.pm:1.1123
--- loncom/lonnet/perl/lonnet.pm:1.1122	Mon Aug  1 15:25:04 2011
+++ loncom/lonnet/perl/lonnet.pm	Mon Aug  1 22:13:49 2011
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1122 2011/08/01 15:25:04 raeburn Exp $
+# $Id: lonnet.pm,v 1.1123 2011/08/01 22:13:49 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -811,26 +811,33 @@
         my %udomdefaults = &Apache::lonnet::get_domain_defaults($udom);
         $remotesessions = $udomdefaults{'remotesessions'};
     }
-    foreach my $try_server (@{ $spareid{'primary'} }) {
-        if ($uint_dom) {
-             next unless (&spare_can_host($udom,$uint_dom,$remotesessions,
-                                          $try_server));
+    my $spareshash = &this_host_spares($udom);
+    if (ref($spareshash) eq 'HASH') {
+        if (ref($spareshash->{'primary'}) eq 'ARRAY') {
+            foreach my $try_server (@{ $spareshash->{'primary'} }) {
+                if ($uint_dom) {
+                    next unless (&spare_can_host($udom,$uint_dom,$remotesessions,
+                                                 $try_server));
+                }
+	        ($spare_server, $lowest_load) =
+	            &compare_server_load($try_server, $spare_server, $lowest_load);
+            }
         }
-	($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'} }) {
-            if ($uint_dom) {
-                next unless (&spare_can_host($udom,$uint_dom,$remotesessions,
-                                             $try_server));
-            }
-	    ($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) {
+            if (ref($spareshash->{'default'}) eq 'ARRAY') { 
+	        foreach my $try_server (@{ $spareshash->{'default'} }) {
+                    if ($uint_dom) {
+                        next unless (&spare_can_host($udom,$uint_dom,
+                                                     $remotesessions,$try_server));
+                    }
+	            ($spare_server, $lowest_load) =
+		        &compare_server_load($try_server, $spare_server, $lowest_load);
+                }
+	    }
+        }
     }
 
     if (!$want_server_name) {
@@ -881,9 +888,18 @@
 # --------------------------- ask offload servers if user already has a session
 sub find_existing_session {
     my ($udom,$uname) = @_;
-    foreach my $try_server (@{ $spareid{'primary'} },
-			    @{ $spareid{'default'} }) {
-	return $try_server if (&has_user_session($try_server, $udom, $uname));
+    my $spareshash = &this_host_spares($udom);
+    if (ref($spareshash) eq 'HASH') {
+        if (ref($spareshash->{'primary'}) eq 'ARRAY') {
+            foreach my $try_server (@{ $spareshash->{'primary'} }) {
+                return $try_server if (&has_user_session($try_server, $udom, $uname));
+            }
+        }
+        if (ref($spareshash->{'default'}) eq 'ARRAY') {
+            foreach my $try_server (@{ $spareshash->{'default'} }) {
+                return $try_server if (&has_user_session($try_server, $udom, $uname));
+            }
+        }
     }
     return;
 }
@@ -1116,6 +1132,47 @@
     return $canhost;
 }
 
+sub this_host_spares {
+    my ($dom) = @_;
+    my $cachetime = 60*60*24;
+    my @hosts = &current_machine_ids();
+    foreach my $lonhost (@hosts) {
+        if (&host_domain($lonhost) eq $dom) {
+            my ($result,$cached)=&is_cached_new('spares',$dom);
+            if (defined($cached)) {
+                return $result;
+            } else {
+                my %domconfig =
+                    &Apache::lonnet::get_dom('configuration',['usersessions'],$dom);
+                if (ref($domconfig{'usersessions'}) eq 'HASH') {
+                    if (ref($domconfig{'usersessions'}{'spares'}) eq 'HASH') {
+                        if (ref($domconfig{'usersessions'}{'spares'}{$lonhost}) eq 'HASH') {
+                            return &do_cache_new('spares',$dom,$domconfig{'usersessions'}{'spares'}{$lonhost},$cachetime);
+                        }
+                    }
+                }
+            }
+            last;
+        }
+    }
+    my $serverhomedom = &host_domain($perlvar{'lonHostID'});
+    my ($result,$cached)=&is_cached_new('spares',$serverhomedom);
+    if (defined($cached)) {
+        return $result;
+    } else {
+        my %homedomconfig =
+            &Apache::lonnet::get_dom('configuration',['usersessions'],$serverhomedom);
+        if (ref($homedomconfig{'usersessions'}) eq 'HASH') {
+            if (ref($homedomconfig{'usersessions'}{'spares'}) eq 'HASH') {
+                if (ref($homedomconfig{'usersessions'}{'spares'}{$perlvar{'lonHostID'}}) eq 'HASH') {
+                    return &do_cache_new('spares',$serverhomedom,$homedomconfig{'usersessions'}{'spares'}{$perlvar{'lonHostID'}},$cachetime);
+                }
+            }
+        }
+    }
+    return \%spareid;
+}
+
 # ---------------------- Find the homebase for a user from domain's lib servers
 
 my %homecache;