--- loncom/lonnet/perl/lonnet.pm	2011/01/25 09:56:17	1.1056.4.21
+++ loncom/lonnet/perl/lonnet.pm	2011/05/14 17:16:49	1.1056.4.25
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1056.4.21 2011/01/25 09:56:17 raeburn Exp $
+# $Id: lonnet.pm,v 1.1056.4.25 2011/05/14 17:16:49 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -196,6 +196,29 @@ sub get_server_timezone {
     }
 }
 
+sub get_server_distarch {
+    my ($lonhost,$ignore_cache) = @_;
+    if (defined($lonhost)) {
+        if (!defined(&hostname($lonhost))) {
+            return;
+        }
+        my $cachetime = 12*3600;
+        if (!$ignore_cache) {
+            my ($distarch,$cached)=&is_cached_new('serverdistarch',$lonhost);
+            if (defined($cached)) {
+                return $distarch;
+            }
+        }
+        my $rep = &reply('serverdistarch',$lonhost);
+        unless ($rep eq 'unknown_command' || $rep eq 'no_such_host' ||
+                $rep eq 'con_lost' || $rep eq 'rejected' || $rep eq 'refused' ||
+                $rep eq '') {
+            return &do_cache_new('serverdistarch',$lonhost,$rep,$cachetime);
+        }
+    }
+    return;
+}
+
 sub get_server_loncaparev {
     my ($dom,$lonhost,$ignore_cache,$caller) = @_;
     if (defined($lonhost)) {
@@ -752,22 +775,22 @@ sub overloaderror {
 # ------------------------------ Find server with least workload from spare.tab
 
 sub spareserver {
-    my ($loadpercent,$userloadpercent,$want_server_name) = @_;
+    my ($loadpercent,$userloadpercent,$want_server_name,$udom) = @_;
     my $spare_server;
     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');
+    if (($udom ne '') && (&domain($udom) ne '')) {
+        my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
         $uint_dom = &Apache::lonnet::internet_dom($uprimary_id);
-        my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
+        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($env{'user.domain'},$uint_dom,
-                                         $remotesessions,$try_server));
+            next unless (&spare_can_host($udom,$uint_dom,$remotesessions,
+                                         $try_server));
         }
 	($spare_server, $lowest_load) =
 	    &compare_server_load($try_server, $spare_server, $lowest_load);
@@ -778,8 +801,8 @@ sub spareserver {
     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));
+                next unless (&spare_can_host($udom,$uint_dom,$remotesessions,
+                                             $try_server));
             }
 	    ($spare_server, $lowest_load) =
 		&compare_server_load($try_server, $spare_server, $lowest_load);
@@ -5754,7 +5777,7 @@ sub allowed {
        my $unamedom=$env{'user.name'}.':'.$env{'user.domain'};
        if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.roles.denied'}
 	   =~/\Q$rolecode\E/) {
-	   if ($priv ne 'pch') { 
+           if (($priv ne 'pch') && ($priv ne 'plc')) {
 	       &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'.
 			'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '.
 			$env{'request.course.id'});
@@ -5764,7 +5787,7 @@ sub allowed {
 
        if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.users.denied'}
 	   =~/\Q$unamedom\E/) {
-	   if ($priv ne 'pch') { 
+           if (($priv ne 'pch') && ($priv ne 'plc')) {
 	       &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.
 			'Denied by user: '.$priv.' for '.$uri.' as '.$unamedom.' in '.
 			$env{'request.course.id'});
@@ -5778,7 +5801,7 @@ sub allowed {
    if ($thisallowed=~/R/) {
        my $rolecode=(split(/\./,$env{'request.role'}))[0];
        if (&metadata($uri,'roledeny')=~/\Q$rolecode\E/) {
-	   if ($priv ne 'pch') { 
+           if (($priv ne 'pch') && ($priv ne 'plc')) {
 	       &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'.
 			'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode);
 	   }
@@ -7350,8 +7373,8 @@ sub store_userdata {
                     $namevalue.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&';
                 }
                 $namevalue=~s/\&$//;
-                $result =  &reply("store:$env{'user.domain'}:$env{'user.name'}:".
-                                  "$namespace:$datakey:$namevalue",$uhome);
+                $result =  &reply("store:$udom:$uname:$namespace:$datakey:".
+                                  $namevalue,$uhome);
             }
         } else {
             $result = 'error: data to store was not a hash reference'; 
@@ -10062,13 +10085,19 @@ sub get_dns {
     my $loaded;
     my %name_to_host;
     my %internetdom;
+    my %LC_dns_serv;
 
     sub parse_hosts_tab {
 	my ($file) = @_;
 	foreach my $configline (@$file) {
 	    next if ($configline =~ /^(\#|\s*$ )/x);
-	    next if ($configline =~ /^\^/);
-	    chomp($configline);
+            chomp($configline);
+            if ($configline =~ /^\^/) {
+                if ($configline =~ /^\^([\w.\-]+)/) {
+                    $LC_dns_serv{$1} = 1;
+                }
+                next;
+            }
 	    my ($id,$domain,$role,$name,$protocol,$intdom)=split(/:/,$configline);
 	    $name=~s/\s//g;
 	    if ($id && $domain && $role && $name) {