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

[raeburn]

raeburn		Sat May 14 17:16:50 2011 EDT

  Modified files:              (Branch: version_2_10_X)
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - Backport 1.1106, 1.1107.
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1056.4.24 loncom/lonnet/perl/lonnet.pm:1.1056.4.25
--- loncom/lonnet/perl/lonnet.pm:1.1056.4.24	Thu Mar 10 23:51:52 2011
+++ loncom/lonnet/perl/lonnet.pm	Sat May 14 17:16:49 2011
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1056.4.24 2011/03/10 23:51:52 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_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)) {
@@ -10062,13 +10085,19 @@
     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) {