--- loncom/lonnet/perl/lonnet.pm	2011/01/11 22:36:11	1.1056.4.19
+++ loncom/lonnet/perl/lonnet.pm	2011/06/13 14:09:26	1.1056.4.27
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1056.4.19 2011/01/11 22:36:11 raeburn Exp $
+# $Id: lonnet.pm,v 1.1056.4.27 2011/06/13 14:09:26 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'; 
@@ -8578,7 +8601,7 @@ sub metadata {
     if (($uri eq '') || 
 	(($uri =~ m|^/*adm/|) && 
 	     ($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)) ||
-        ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ /^\*uploaded\/.+\.sequence$/) || ($uri =~ m{^/*uploaded/$match_domain/$match_courseid/docs/})) {
+        ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$})) {
 	return undef;
     }
     if (($uri =~ /^~/ || $uri =~ m{home/$match_username/public_html/}) 
@@ -8620,7 +8643,8 @@ sub metadata {
 		&Apache::lonnet::ssi_body($which,
 					  ('grade_target' => 'meta'));
 	    $cachetime = 1; # only want this cached in the child not long term
-	} elsif ($uri !~ m -^(editupload)/-) {
+	} elsif (($uri !~ m -^(editupload)/-) && 
+                 ($uri !~ m{^/*uploaded/$match_domain/$match_courseid/docs/})) {
 	    my $file=&filelocation('',&clutter($filename));
 	    #push(@{$metaentry{$uri.'.file'}},$file);
 	    $metastring=&getfile($file);
@@ -8968,7 +8992,8 @@ sub symbverify {
         }
         my $ids=$bighash{'ids_'.&clutter($thisurl)};
         unless ($ids) { 
-           $ids=$bighash{'ids_/'.$thisurl};
+           my $idkey = 'ids_'.($thisurl =~ m{^/}? '' : '/').$thisurl;
+           $ids=$bighash{$idkey};
         }
         if ($ids) {
 # ------------------------------------------------------------------- Has ID(s)
@@ -8981,7 +9006,8 @@ sub symbverify {
   &symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn)
    eq $symb) { 
 		   if (($env{'request.role.adv'}) ||
-		       $bighash{'encrypted_'.$id} eq $env{'request.enc'}) {
+		       ($bighash{'encrypted_'.$id} eq $env{'request.enc'}) ||
+		       ($thisurl eq '/adm/navmaps')) {
 		       $okay=1; 
 		   }
 	       }
@@ -10060,13 +10086,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) {
@@ -10202,6 +10234,14 @@ sub get_dns {
         my ($lonid) = @_;
         return $internetdom{$lonid};
     }
+
+    sub is_LC_dns {
+        &load_hosts_tab() if (!$loaded);
+
+        my ($hostname) = @_;
+        return exists($LC_dns_serv{$hostname});
+    }
+
 }
 
 {