[LON-CAPA-cvs] cvs: doc /loncapafiles loncapafiles.lpml loncom loncapa_apache.conf loncom/lonnet/perl londns.pm lonnet.pm
albertel
lon-capa-cvs@mail.lon-capa.org
Wed, 28 Mar 2007 00:13:23 -0000
This is a MIME encoded message
--albertel1175040803
Content-Type: text/plain
albertel Tue Mar 27 20:13:23 2007 EDT
Added files:
/loncom/lonnet/perl londns.pm
Modified files:
/loncom loncapa_apache.conf
/loncom/lonnet/perl lonnet.pm
/doc/loncapafiles loncapafiles.lpml
Log:
- adding in the dns handler
- currently expects dns servers to be listed in hosts.tab as
^dns.example.com
- lond currently doesn't support the dns mechanism
--albertel1175040803
Content-Type: text/plain
Content-Disposition: attachment; filename="albertel-20070327201323.txt"
Index: loncom/loncapa_apache.conf
diff -u loncom/loncapa_apache.conf:1.164 loncom/loncapa_apache.conf:1.165
--- loncom/loncapa_apache.conf:1.164 Tue Mar 27 20:05:38 2007
+++ loncom/loncapa_apache.conf Tue Mar 27 20:12:48 2007
@@ -1,7 +1,7 @@
##
## loncapa_apache.conf -- Apache HTTP LON-CAPA configuration file
##
-## $Id: loncapa_apache.conf,v 1.164 2007/03/28 00:05:38 albertel Exp $
+## $Id: loncapa_apache.conf,v 1.165 2007/03/28 00:12:48 albertel Exp $
##
#
@@ -1190,11 +1190,11 @@
ErrorDocument 500 /adm/errorhandler
</LocationMatch>
-#<LocationMatch "^/adm/dns">
-#SetHandler perl-script
-#PerlHandler Apache::londns
-#ErrorDocument 500 /adm/errorhandler
-#</LocationMatch>
+<LocationMatch "^/adm/dns">
+SetHandler perl-script
+PerlHandler Apache::londns
+ErrorDocument 500 /adm/errorhandler
+</LocationMatch>
# ------------------------------------------------- Backdoor Adm Tests/Programs
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.851 loncom/lonnet/perl/lonnet.pm:1.852
--- loncom/lonnet/perl/lonnet.pm:1.851 Tue Mar 27 20:05:45 2007
+++ loncom/lonnet/perl/lonnet.pm Tue Mar 27 20:12:58 2007
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.851 2007/03/28 00:05:45 albertel Exp $
+# $Id: lonnet.pm,v 1.852 2007/03/28 00:12:58 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -7587,17 +7587,33 @@
%perlvar = (%perlvar,%{$configvars});
}
+sub get_dns {
+ my ($url,$func) = @_;
+ open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");
+ foreach my $dns (<$config>) {
+ next if ($dns !~ /^\^(\S*)/x);
+ $dns = $1;
+ 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);
+ &$func(\@content);
+ }
+ close($config);
+}
# ------------------------------------------------------------ Read domain file
{
+ my $loaded;
my %domain;
- my $fh;
- if (open($fh,"<".$Apache::lonnet::perlvar{'lonTabDir'}.'/domain.tab')) {
- while (my $line = <$fh>) {
- next if ($line =~ /^(\#|\s*$ )/);
+ sub parse_domain_tab {
+ my ($lines) = @_;
+ foreach my $line (@$lines) {
+ next if ($line =~ /^(\#|\s*$ )/x);
chomp($line);
- my ($name,@elements) = split(/:/,$line,9);
+ my ($name,@elements) = split(/:/,$line,9);
my %this_domain;
foreach my $field ('description', 'auth_def', 'auth_arg_def',
'lang_def', 'city', 'longi', 'lati',
@@ -7605,12 +7621,24 @@
$this_domain{$field} = shift(@elements);
}
$domain{$name} = \%this_domain;
-# &logthis("Domain.tab: $domain ".$domaindescription{$domain} );
+ &logthis("Domain.tab: $name ".$domain{$name}{'description'} );
+ }
+ }
+
+ sub load_domain_tab {
+ &get_dns('/adm/dns/domain',\&parse_domain_tab);
+ my $fh;
+ if (open($fh,"<".$perlvar{'lonTabDir'}.'/domain.tab')) {
+ my @lines = <$fh>;
+ &parse_domain_tab(\@lines);
}
+ close($fh);
+ $loaded = 1;
}
- close ($fh);
sub domain {
+ &load_domain_tab() if (!$loaded);
+
my ($name,$what) = @_;
return if ( !exists($domain{$name}) );
@@ -7627,41 +7655,65 @@
my %hostname;
my %hostdom;
my %libserv;
- open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");
+ my $loaded;
- while (my $configline=<$config>) {
- next if ($configline =~ /^(\#|\s*$)/);
- chomp($configline);
- my ($id,$domain,$role,$name)=split(/:/,$configline);
- $name=~s/\s//g;
- if ($id && $domain && $role && $name) {
- $hostname{$id}=$name;
- $hostdom{$id}=$domain;
- if ($role eq 'library') { $libserv{$id}=$name; }
- }
+ sub parse_hosts_tab {
+ my ($file) = @_;
+ foreach my $configline (@$file) {
+ next if ($configline =~ /^(\#|\s*$ )/x);
+ next if ($configline =~ /^\^/);
+ chomp($configline);
+ my ($id,$domain,$role,$name)=split(/:/,$configline);
+ $name=~s/\s//g;
+ if ($id && $domain && $role && $name) {
+ $hostname{$id}=$name;
+ $hostdom{$id}=$domain;
+ if ($role eq 'library') { $libserv{$id}=$name; }
+ }
+ &logthis("Hosts.tab: $name ".$id );
+ }
}
- close($config);
+
+ sub load_hosts_tab {
+ &get_dns('/adm/dns/hosts',\&parse_hosts_tab);
+ open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");
+ my @config = <$config>;
+ &parse_hosts_tab(\@config);
+ close($config);
+ $loaded=1;
+ }
+
# FIXME: dev server don't want this, production servers _do_ want this
#&get_iphost();
sub hostname {
+ &load_hosts_tab() if (!$loaded);
+
my ($lonid) = @_;
return $hostname{$lonid};
}
sub all_hostnames {
+ &load_hosts_tab() if (!$loaded);
+
return %hostname;
}
sub is_library {
+ &load_hosts_tab() if (!$loaded);
+
return exists($libserv{$_[0]});
}
sub all_library {
+ &load_hosts_tab() if (!$loaded);
+
return %libserv;
}
sub get_servers {
+ &load_hosts_tab() if (!$loaded);
+
my ($domain,$type) = @_;
my %possible_hosts = ($type eq 'library') ? %libserv
: %hostname;
@@ -7683,11 +7735,15 @@
}
sub host_domain {
+ &load_hosts_tab() if (!$loaded);
+
my ($lonid) = @_;
return $hostdom{$lonid};
}
sub all_domains {
+ &load_hosts_tab() if (!$loaded);
+
my %seen;
my @uniq = grep(!$seen{$_}++, values(%hostdom));
return @uniq;
Index: doc/loncapafiles/loncapafiles.lpml
diff -u doc/loncapafiles/loncapafiles.lpml:1.524 doc/loncapafiles/loncapafiles.lpml:1.525
--- doc/loncapafiles/loncapafiles.lpml:1.524 Thu Mar 1 12:00:48 2007
+++ doc/loncapafiles/loncapafiles.lpml Tue Mar 27 20:13:22 2007
@@ -2,7 +2,7 @@
"http://lpml.sourceforge.net/DTD/lpml.dtd">
<!-- loncapafiles.lpml -->
-<!-- $Id: loncapafiles.lpml,v 1.524 2007/03/01 17:00:48 raeburn Exp $ -->
+<!-- $Id: loncapafiles.lpml,v 1.525 2007/03/28 00:13:22 albertel Exp $ -->
<!--
@@ -5073,6 +5073,15 @@
</dependencies>
</file>
<file>
+<source>loncom/lonnet/perl/londns.pm</source>
+<target dist='default'>home/httpd/lib/perl/Apache/londns.pm</target>
+<categoryname>handler</categoryname>
+<description>
+Domain information serving.
+</description>
+<status>works/unverified</status>
+</file>
+<file>
<source>loncom/html/index.html</source>
<target dist='default'>home/httpd/html/index.html</target>
<categoryname>interface file</categoryname>
Index: loncom/lonnet/perl/londns.pm
+++ loncom/lonnet/perl/londns.pm
# The LearningOnline Network with CAPA
# A debugging harness.
#
# $Id: londns.pm,v 1.1 2007/03/28 00:12:59 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
#
package Apache::londns;
use strict;
use LONCAPA;
use Apache::Constants qw(:common :http);
use Apache::lonnet;
sub serve_file {
my ($r,$file,$type)=@_;
open(my $config,"<$Apache::lonnet::perlvar{'lonTabDir'}/$file");
my $file = join('',<$config>);
$r->content_type($type);
$r->send_http_header;
return OK if $r->header_only;
$r->print($file);
return OK;
}
sub handler {
my ($r) = @_;
my $command = (split('/',$r->uri))[3];
if ($command eq 'hosts') {
return &serve_file($r,'dns_hosts.tab','loncapa/hosts');
} elsif ($command eq 'domain') {
return &serve_file($r,'dns_domain.tab','loncapa/domain');
}
return FORBIDDEN;
}
1;
--albertel1175040803--