--- loncom/lonnet/perl/lonnet.pm	2011/07/18 10:32:48	1.1119
+++ loncom/lonnet/perl/lonnet.pm	2011/08/09 01:06:33	1.1128
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1119 2011/07/18 10:32:48 foxr Exp $
+# $Id: lonnet.pm,v 1.1128 2011/08/09 01:06:33 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -306,6 +306,52 @@ sub get_server_homeID {
     return &do_cache_new('serverhomeID',$hostname,$serverhomeID,$cachetime);
 }
 
+sub get_remote_globals {
+    my ($lonhost,$whathash,$ignore_cache) = @_;
+    my ($result,%returnhash,%whatneeded);
+    if (ref($whathash) eq 'HASH') {
+        foreach my $what (sort(keys(%{$whathash}))) {
+            my $hashid = $lonhost.'-'.$what;
+            my ($response,$cached);
+            unless ($ignore_cache) {
+                ($response,$cached)=&is_cached_new('lonnetglobal',$hashid);
+            }
+            if (defined($cached)) {
+                $returnhash{$what} = $response;
+            } else {
+                $whatneeded{$what} = 1;
+            }
+        }
+        if (keys(%whatneeded) == 0) {
+            $result = 'ok';
+        } else {
+            my $requested = &freeze_escape(\%whatneeded);
+            my $rep=&reply('readlonnetglobal:'.$requested,$lonhost);
+            if (($rep=~/^(refused|rejected|error)/) || ($rep eq 'con_lost') ||
+                ($rep eq 'unknown_cmd')) {
+                $result = $rep;
+            } else {
+                $result = 'ok';
+                my @pairs=split(/\&/,$rep);
+                foreach my $item (@pairs) {
+                    my ($key,$value)=split(/=/,$item,2);
+                    my $what = &unescape($key);
+                    my $hashid = $lonhost.'-'.$what;
+                    $returnhash{$what}=&thaw_unescape($value);
+                    &do_cache_new('lonnetglobal',$hashid,$returnhash{$what},600);
+                }
+            }
+        }
+    }
+    return ($result,\%returnhash);
+}
+
+sub remote_devalidate_cache {
+    my ($lonhost,$name,$id) = @_;
+    my $response = &reply('devalidatecache',&escape($name).':'.&escape($id),$lonhost);
+    return $response;
+}
+
 # -------------------------------------------------- Non-critical communication
 sub subreply {
     my ($cmd,$server)=@_;
@@ -773,26 +819,33 @@ sub spareserver {
         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) {
@@ -843,9 +896,18 @@ sub compare_server_load {
 # --------------------------- 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;
 }
@@ -1035,15 +1097,19 @@ sub can_host_session {
     }
     if ($canhost) {
         if (ref($hostedsessions) eq 'HASH') {
+            my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
+            my $uint_dom = &Apache::lonnet::internet_dom($uprimary_id);
             if (ref($hostedsessions->{'excludedomain'}) eq 'ARRAY') {
-                if (grep(/^\Q$udom\E$/,@{$hostedsessions->{'excludedomain'}})) {
+                if (($uint_dom ne '') && 
+                    (grep(/^\Q$uint_dom\E$/,@{$hostedsessions->{'excludedomain'}}))) {
                     $canhost = 0;
                 } else {
                     $canhost = 1;
                 }
             }
             if (ref($hostedsessions->{'includedomain'}) eq 'ARRAY') {
-                if (grep(/^\Q$udom\E$/,@{$hostedsessions->{'includedomain'}})) {
+                if (($uint_dom ne '') && 
+                    (grep(/^\Q$uint_dom\E$/,@{$hostedsessions->{'includedomain'}}))) {
                     $canhost = 1;
                 } else {
                     $canhost = 0;
@@ -1074,6 +1140,84 @@ sub spare_can_host {
     return $canhost;
 }
 
+sub this_host_spares {
+    my ($dom) = @_;
+    my ($dom_in_use,$lonhost_in_use,$result);
+    my @hosts = &current_machine_ids();
+    foreach my $lonhost (@hosts) {
+        if (&host_domain($lonhost) eq $dom) {
+            $dom_in_use = $dom;
+            $lonhost_in_use = $lonhost;
+            last;
+        }
+    }
+    if ($dom_in_use ne '') {
+        $result = &spares_for_offload($dom_in_use,$lonhost_in_use);
+    }
+    if (ref($result) ne 'HASH') {
+        $lonhost_in_use = $perlvar{'lonHostID'};
+        $dom_in_use = &host_domain($lonhost_in_use);
+        $result = &spares_for_offload($dom_in_use,$lonhost_in_use);
+        if (ref($result) ne 'HASH') {
+            $result = \%spareid;
+        }
+    }
+    return $result;
+}
+
+sub spares_for_offload  {
+    my ($dom_in_use,$lonhost_in_use) = @_;
+    my ($result,$cached)=&is_cached_new('spares',$dom_in_use);
+    if (defined($cached)) {
+        return $result;
+    } else {
+        my $cachetime = 60*60*24;
+        my %domconfig =
+            &Apache::lonnet::get_dom('configuration',['usersessions'],$dom_in_use);
+        if (ref($domconfig{'usersessions'}) eq 'HASH') {
+            if (ref($domconfig{'usersessions'}{'spares'}) eq 'HASH') {
+                if (ref($domconfig{'usersessions'}{'spares'}{$lonhost_in_use}) eq 'HASH') {
+                    return &do_cache_new('spares',$dom_in_use,$domconfig{'usersessions'}{'spares'}{$lonhost_in_use},$cachetime);
+                }
+            }
+        }
+    }
+    return;
+}
+
+sub internet_dom_servers {
+    my ($dom) = @_;
+    my (%uniqservers,%servers);
+    my $primaryserver = &hostname(&domain($dom,'primary'));
+    my @machinedoms = &machine_domains($primaryserver);
+    foreach my $mdom (@machinedoms) {
+        my %currservers = %servers;
+        my %server = &get_servers($mdom);
+        %servers = (%currservers,%server);
+    }
+    my %by_hostname;
+    foreach my $id (keys(%servers)) {
+        push(@{$by_hostname{$servers{$id}}},$id);
+    }
+    foreach my $hostname (sort(keys(%by_hostname))) {
+        if (@{$by_hostname{$hostname}} > 1) {
+            my $match = 0;
+            foreach my $id (@{$by_hostname{$hostname}}) {
+                if (&host_domain($id) eq $dom) {
+                    $uniqservers{$id} = $hostname;
+                    $match = 1;
+                }
+            }
+            unless ($match) {
+                $uniqservers{$by_hostname{$hostname}[0]} = $hostname;
+            }
+        } else {
+            $uniqservers{$by_hostname{$hostname}[0]} = $hostname;
+        }
+    }
+    return %uniqservers;
+}
+
 # ---------------------- Find the homebase for a user from domain's lib servers
 
 my %homecache;
@@ -5234,12 +5378,16 @@ sub is_advanced_user {
     my ($udom,$uname) = @_;
     if ($udom ne '' && $uname ne '') {
         if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
-            return $env{'user.adv'};  
+            if (wantarray) {
+                return ($env{'user.adv'},$env{'user.author'});
+            } else {
+                return $env{'user.adv'};
+            }
         }
     }
     my %roleshash = &get_my_roles($uname,$udom,'userroles',undef,undef,undef,1);
     my %allroles;
-    my $is_adv;
+    my ($is_adv,$is_author);
     foreach my $role (keys(%roleshash)) {
         my ($trest,$tdomain,$trole,$sec) = split(/:/,$role);
         my $area = '/'.$tdomain.'/'.$trest;
@@ -5253,6 +5401,9 @@ sub is_advanced_user {
             } elsif ($trole ne 'gr') {
                 &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);
             }
+            if ($trole eq 'au') {
+                $is_author = 1;
+            }
         }
     }
     foreach my $role (keys(%allroles)) {
@@ -5267,6 +5418,9 @@ sub is_advanced_user {
             }
         }
     }
+    if (wantarray) {
+        return ($is_adv,$is_author);
+    }
     return $is_adv;
 }