[LON-CAPA-cvs] cvs: loncom /lonnet/perl lonnet.pm
albertel
lon-capa-cvs-allow@mail.lon-capa.org
Wed, 11 Apr 2007 22:52:09 -0000
albertel Wed Apr 11 18:52:09 2007 EDT
Modified files:
/loncom/lonnet/perl lonnet.pm
Log:
- caching DNS queries into memcache
- if DNS uncontactable default to on-disk dns_(hosts|domain).tab
- add in a valid_ip mechanism that may be faster for more testing
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.868 loncom/lonnet/perl/lonnet.pm:1.869
--- loncom/lonnet/perl/lonnet.pm:1.868 Wed Apr 11 17:37:20 2007
+++ loncom/lonnet/perl/lonnet.pm Wed Apr 11 18:52:03 2007
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.868 2007/04/11 21:37:20 raeburn Exp $
+# $Id: lonnet.pm,v 1.869 2007/04/11 22:52:03 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -182,7 +182,7 @@
$client=IO::Socket::UNIX->new(Peer =>"$peerfile",
Type => SOCK_STREAM,
Timeout => 10);
- if($client) {
+ if ($client) {
last; # Connected!
} else {
&create_connection(&hostname($server),$server);
@@ -7682,19 +7682,40 @@
}
sub get_dns {
- my ($url,$func) = @_;
+ my ($url,$func,$ignore_cache) = @_;
+ if (!$ignore_cache) {
+ my ($content,$cached)=
+ &Apache::lonnet::is_cached_new('dns',$url);
+ if ($cached) {
+ &$func($content);
+ return;
+ }
+ }
+
+ my %alldns;
open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");
foreach my $dns (<$config>) {
next if ($dns !~ /^\^(\S*)/x);
- $dns = $1;
+ $alldns{$1} = 1;
+ }
+ while (%alldns) {
+ my ($dns) = keys(%alldns);
+ delete($alldns{$dns});
my $ua=new LWP::UserAgent;
my $request=new HTTP::Request('GET',"http://$dns$url");
my $response=$ua->request($request);
next if ($response->is_error());
my @content = split("\n",$response->content);
+ &Apache::lonnet::do_cache_new('dns',$url,\@content,30*24*60*60);
&$func(\@content);
+ return;
}
close($config);
+ &logthis("unable to contact DNS defaulting to on disk file\n");
+ open($config,"<$perlvar{'lonTabDir'}/dns_hosts.tab");
+ my @content = <$config>;
+ &$func(\@content);
+ return;
}
# ------------------------------------------------------------ Read domain file
{
@@ -7724,7 +7745,8 @@
}
sub load_domain_tab {
- &get_dns('/adm/dns/domain',\&parse_domain_tab);
+ my ($ignore_cache) = @_;
+ &get_dns('/adm/dns/domain',\&parse_domain_tab,$ignore_cache);
my $fh;
if (open($fh,"<".$perlvar{'lonTabDir'}.'/domain.tab')) {
my @lines = <$fh>;
@@ -7781,7 +7803,8 @@
}
sub load_hosts_tab {
- &get_dns('/adm/dns/hosts',\&parse_hosts_tab);
+ my ($ignore_cache) = @_;
+ &get_dns('/adm/dns/hosts',\&parse_hosts_tab,$ignore_cache);
open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");
my @config = <$config>;
&parse_hosts_tab(\@config);
@@ -7857,6 +7880,25 @@
my %iphost;
my %name_to_ip;
my %lonid_to_ip;
+
+ my %valid_ip;
+ sub valid_ip {
+ my ($ip) = @_;
+ if (exists($iphost{$ip}) || exists($valid_ip{$ip})) {
+ return 1;
+ }
+ my $name = gethostbyip($ip);
+ my $lonid = &hostname($name);
+ if (defined($lonid)) {
+ $valid_ip{$ip} = $lonid;
+ return 1;
+ }
+ my %iphosts = &get_iphost();
+ if (ref($iphost{$ip})) {
+ return 1;
+ }
+ }
+
sub get_hosts_from_ip {
my ($ip) = @_;
my %iphosts = &get_iphost();
@@ -7887,7 +7929,20 @@
}
sub get_iphost {
- if (%iphost) { return %iphost; }
+ my ($ignore_cache) = @_;
+ if (!$ignore_cache) {
+ if (%iphost) {
+ return %iphost;
+ }
+ my ($ip_info,$cached)=
+ &Apache::lonnet::is_cached_new('iphost','iphost');
+ if ($cached) {
+ %iphost = %{$ip_info->[0]};
+ %name_to_ip = %{$ip_info->[1]};
+ %lonid_to_ip = %{$ip_info->[2]};
+ return %iphost;
+ }
+ }
my %hostname = &all_hostnames();
foreach my $id (keys(%hostname)) {
my $name=&hostname($id);
@@ -7906,6 +7961,10 @@
$lonid_to_ip{$id} = $ip;
push(@{$iphost{$ip}},$id);
}
+ &Apache::lonnet::do_cache_new('iphost','iphost',
+ [\%iphost,\%name_to_ip,\%lonid_to_ip],
+ 24*60*60);
+
return %iphost;
}
}