[LON-CAPA-cvs] cvs: doc /loncapafiles loncapafiles.lpml loncom loncaparevs.tab loncron lond serverhomeIDs.tab loncom/auth lonauth.pm switchserver.pm loncom/interface domainprefs.pm loncom/lonnet/perl lonnet.pm
raeburn
raeburn@source.lon-capa.org
Tue, 20 Jul 2010 02:42:55 -0000
This is a MIME encoded message
--raeburn1279593775
Content-Type: text/plain
raeburn Tue Jul 20 02:42:55 2010 EDT
Added files:
/loncom loncaparevs.tab serverhomeIDs.tab
Modified files:
/loncom lond loncron
/loncom/auth lonauth.pm switchserver.pm
/loncom/interface domainprefs.pm
/loncom/lonnet/perl lonnet.pm
/doc/loncapafiles loncapafiles.lpml
Log:
- Control hosting of user sessions.
- To accommodate multi-domain library servers, use internet domain names (e.g., msu.edu)
instead of LON-CAPA domains in interface DC uses to set options for session hosting.
- Provide mechanism to retrieve lonHostID for a hostname, so we can tell which
domain determines session hosting config for external users on a multi-domain
machine.
- New routines in lonnet.pm:
&get_server_homeID() -- gets lonHostID for a hostname
&internet_dom() -- gets internet domain name for a LON-CAPA Host ID
&get_internet_names() -- gets internet domain names for all domains
for a server given one of the LC host IDs for the server.
- New file in /home/httpd/lonTabs:
- serverhomeIDs.tab (populated by loncron). : paired hostname:lonHostID
- New subroutine in loncron: &write_serverhomeIDs() -- populates serverhomeIDs.tab
- New subroutine in lond: &server_homeID_handler() -- returns LON-CAPA Host ID of server
- New scalar in lond: $clienthomedom -- set to domain of LON-CAPA Host ID of client
- New subroutine in domainprefs.pm: &build_location_hashes()
-- used to set up options for session hosting as internet domain names
- where two names (e.g., msu.edu, loncapa.org) are controlled by the same
institution these will receive a single checkbox.
--raeburn1279593775
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20100720024255.txt"
Index: loncom/lond
diff -u loncom/lond:1.447 loncom/lond:1.448
--- loncom/lond:1.447 Sat Jul 17 20:01:56 2010
+++ loncom/lond Tue Jul 20 02:42:27 2010
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.447 2010/07/17 20:01:56 raeburn Exp $
+# $Id: lond,v 1.448 2010/07/20 02:42:27 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -58,7 +58,7 @@
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.447 $'; #' stupid emacs
+my $VERSION='$Revision: 1.448 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -66,8 +66,9 @@
my $client;
my $clientip; # IP address of client.
my $clientname; # LonCAPA name of client.
-my $clientversion; # LonCAPA version running on client
-my @clientdoms; # Array of domains on $clientip
+my $clientversion; # LonCAPA version running on client.
+my $clienthomedom; # LonCAPA domain of homeID for client.
+ # primary library server.
my $server;
@@ -1072,7 +1073,7 @@
# Implicit Inputs:
# $currenthostid - Global variable that carries the name of the host
# known as.
-# $clientname - Global variable that carries the name of the hsot we're connected to.
+# $clientname - Global variable that carries the name of the host we're connected to.
# Returns:
# 1 - Ok to continue processing.
# 0 - Program should exit.
@@ -1111,7 +1112,7 @@
# Implicit Inputs:
# $currenthostid - Global variable that carries the name of the host
# known as.
-# $clientname - Global variable that carries the name of the hsot we're connected to.
+# $clientname - Global variable that carries the name of the host we're connected to.
# Returns:
# 1 - Ok to continue processing.
# 0 - Program should exit.
@@ -1148,7 +1149,7 @@
# Implicit Inputs:
# $currenthostid - Global variable that carries the name of the host
# known as.
-# $clientname - Global variable that carries the name of the hsot we're connected to.
+# $clientname - Global variable that carries the name of the host we're connected to.
# Returns:
# 1 - Ok to continue processing.
# 0 - Program should exit
@@ -1657,6 +1658,14 @@
}
®ister_handler("serverloncaparev", \&server_loncaparev_handler, 0, 1, 0);
+sub server_homeID_handler {
+ my ($cmd,$tail,$client) = @_;
+ my $userinput = "$cmd:$tail";
+ &Reply($client,\$perlvar{'lonHostID'},$userinput);
+ return 1;
+}
+®ister_handler("serverhomeID", \&server_homeID_handler, 0, 1, 0);
+
# Process a reinit request. Reinit requests that either
# lonc or lond be reinitialized so that an updated
# host.tab or domain.tab can be processed.
@@ -1778,17 +1787,21 @@
if($pwdcorrect) {
my $canhost = 1;
unless ($clientcancheckhost) {
- unless (grep(/^\Q$udom\E$/,@clientdoms)) {
+ my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
+ my $uint_dom = &Apache::lonnet::internet_dom($uprimary_id);
+ my @intdoms = &Apache::lonnet::get_internet_names($clientname);
+ unless ($uint_dom ne '' && grep(/^\Q$uint_dom\E$/,@intdoms)) {
my ($remote,$hosted);
my $remotesession = &get_usersession_config($udom,'remotesession');
if (ref($remotesession) eq 'HASH') {
$remote = $remotesession->{'remote'}
}
- my $hostedsession = &get_usersession_config($clientdoms[0],'hostedsession');
+ my $hostedsession = &get_usersession_config($clienthomedom,'hostedsession');
if (ref($hostedsession) eq 'HASH') {
$hosted = $hostedsession->{'hosted'};
}
- $canhost = &Apache::lonnet::can_host_session($udom,$currentdomainid,$clientversion,
+ $canhost = &Apache::lonnet::can_host_session($udom,$clientname,
+ $clientversion,
$remote,$hosted);
}
}
@@ -6490,15 +6503,9 @@
# ------------------------------------------------------------ Process requests
my $keep_going = 1;
my $user_input;
- @clientdoms = ();
- if (ref($iphost{$clientip}) eq 'ARRAY') {
- foreach my $id (@{$iphost{$clientip}}) {
- my $clientdom = &Apache::lonnet::host_domain($id);
- unless (grep(/^\Q$clientdom\E/,@clientdoms)) {
- push(@clientdoms,$clientdom);
- }
- }
- }
+ my $clienthost = &Apache::lonnet::hostname($clientname);
+ my $clientserverhomeID = &Apache::lonnet::get_server_homeID($clienthost);
+ $clienthomedom = &Apache::lonnet::host_domain($clientserverhomeID);
while(($user_input = get_request) && $keep_going) {
alarm(120);
Debug("Main: Got $user_input\n");
Index: loncom/loncron
diff -u loncom/loncron:1.84 loncom/loncron:1.85
--- loncom/loncron:1.84 Sat Jul 17 20:01:56 2010
+++ loncom/loncron Tue Jul 20 02:42:27 2010
@@ -2,7 +2,7 @@
# Housekeeping program, started by cron, loncontrol and loncron.pl
#
-# $Id: loncron,v 1.84 2010/07/17 20:01:56 raeburn Exp $
+# $Id: loncron,v 1.85 2010/07/20 02:42:27 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -701,6 +701,26 @@
return;
}
+sub write_serverhomeIDs {
+ if (open(my $fh,">$perlvar{'lonTabDir'}/serverhomeIDs.tab")) {
+ my %name_to_host = &Apache::lonnet::all_names();
+ foreach my $name (sort(keys(%name_to_host))) {
+ if ($name ne '') {
+ if (ref($name_to_host{$name}) eq 'ARRAY') {
+ my $serverhomeID = &Apache::lonnet::get_server_homeID($name,1,'loncron');
+ if ($serverhomeID ne '') {
+ print $fh $name.':'.$serverhomeID."\n";
+ } else {
+ print $fh $name.':'.$name_to_host{$name}->[0]."\n";
+ }
+ }
+ }
+ }
+ close($fh);
+ }
+ return;
+}
+
sub send_mail {
print "sending mail\n";
my $defdom = $perlvar{'lonDefDomain'};
@@ -851,6 +871,7 @@
}
if (!$justcheckconnections && !$justreload) {
&write_loncaparevs();
+ &write_serverhomeIDs();
}
}
Index: loncom/auth/lonauth.pm
diff -u loncom/auth/lonauth.pm:1.105 loncom/auth/lonauth.pm:1.106
--- loncom/auth/lonauth.pm:1.105 Sat Jul 17 20:02:02 2010
+++ loncom/auth/lonauth.pm Tue Jul 20 02:42:33 2010
@@ -1,7 +1,7 @@
# The LearningOnline Network
# User Authentication Module
#
-# $Id: lonauth.pm,v 1.105 2010/07/17 20:02:02 raeburn Exp $
+# $Id: lonauth.pm,v 1.106 2010/07/20 02:42:33 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -421,19 +421,27 @@
my ($r,$form,$authhost,$domdesc) = @_;
return unless (ref($form) eq 'HASH');
my $canhost = 1;
- my @machinedoms = &Apache::lonnet::current_machine_domains();
+ my $lonhost = $r->dir_config('lonHostID');
my $udom = $form->{'udom'};
- unless (grep(/^\Q$udom\E/,@machinedoms)) {
- my $defdom = &Apache::lonnet::default_login_domain();
- my %defdomdefaults = &Apache::lonnet::get_domain_defaults($defdom);
+ my @intdoms = &Apache::lonnet::get_internet_names($lonhost);
+ my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
+ my $uint_dom = &Apache::lonnet::internet_dom($uprimary_id);
+ unless ($uint_dom ne '' && grep(/^\Q$uint_dom\E$/,@intdoms)) {
+ my $machine_dom = &Apache::lonnet::host_domain($lonhost);
+ my $hostname = &Apache::lonnet::hostname($lonhost);
+ my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
+ my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
+ my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
my %udomdefaults = &Apache::lonnet::get_domain_defaults($udom);
my $loncaparev;
if ($authhost eq 'no_account_on_host') {
- $loncaparev = &Apache::lonnet::get_server_loncaparev($defdom);
+ $loncaparev = &Apache::lonnet::get_server_loncaparev($machine_dom);
} else {
- $loncaparev = &Apache::lonnet::get_server_loncaparev($defdom,$authhost);
+ $loncaparev = &Apache::lonnet::get_server_loncaparev($machine_dom,$lonhost);
}
- $canhost = &Apache::lonnet::can_host_session($udom,$defdom,$loncaparev,$udomdefaults{'remotesessions'},$defdomdefaults{'hostedsessions'});
+ $canhost = &Apache::lonnet::can_host_session($udom,$lonhost,$loncaparev,
+ $udomdefaults{'remotesessions'},
+ $defdomdefaults{'hostedsessions'});
}
unless ($canhost) {
if ($authhost eq 'no_account_on_host') {
Index: loncom/auth/switchserver.pm
diff -u loncom/auth/switchserver.pm:1.26 loncom/auth/switchserver.pm:1.27
--- loncom/auth/switchserver.pm:1.26 Sat Jul 17 20:02:02 2010
+++ loncom/auth/switchserver.pm Tue Jul 20 02:42:33 2010
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Switch Servers Handler
#
-# $Id: switchserver.pm,v 1.26 2010/07/17 20:02:02 raeburn Exp $
+# $Id: switchserver.pm,v 1.27 2010/07/20 02:42:33 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -96,15 +96,21 @@
}
my $canhost = 1;
- my @machinedoms = &Apache::lonnet::machine_domains($switch_to);
- unless (grep(/^\Q$env{'user.domain'}\E/,@machinedoms)) {
- my $machinedom = &Apache::lonnet::host_domain($env{'form.otherserver'});
- my %defdomdefaults = &Apache::lonnet::get_domain_defaults($machinedom);
+ my $uprimary_id = &Apache::lonnet::domain($env{'user.domain'},'primary');
+ my $uint_dom = &Apache::lonnet::internet_dom($uprimary_id);
+ my @intdoms = &Apache::lonnet::get_internet_names($env{'form.otherserver'});
+ unless ($uint_dom ne '' && grep(/^\Q$uint_dom\E$/,@intdoms)) {
+ my $serverhomeID = &Apache::lonnet::get_server_homeID($switch_to);
+ my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
+ my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
my $remoterev = &Apache::lonnet::get_server_loncaparev($env{'user.domain'},$env{'form.otherserver'});
- $canhost = &Apache::lonnet::can_host_session($env{'user.domain'},$machinedom,
- $remoterev,$udomdefaults{'remotesessions'},
- $defdomdefaults{'hostedsessions'});
+ $canhost =
+ &Apache::lonnet::can_host_session($env{'user.domain'},
+ $env{'form.otherserver'},
+ $remoterev,
+ $udomdefaults{'remotesessions'},
+ $defdomdefaults{'hostedsessions'});
}
unless ($canhost) { return FORBIDDEN; }
Index: loncom/interface/domainprefs.pm
diff -u loncom/interface/domainprefs.pm:1.137 loncom/interface/domainprefs.pm:1.138
--- loncom/interface/domainprefs.pm:1.137 Sat Jul 17 20:02:07 2010
+++ loncom/interface/domainprefs.pm Tue Jul 20 02:42:40 2010
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to set domain-wide configuration settings
#
-# $Id: domainprefs.pm,v 1.137 2010/07/17 20:02:07 raeburn Exp $
+# $Id: domainprefs.pm,v 1.138 2010/07/20 02:42:40 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -2270,10 +2270,12 @@
} else {
$prefix = 'remote';
@types = ('version','excludedomain','includedomain');
- }
+ }
my (%current,%checkedon,%checkedoff);
my @lcversions = &Apache::lonnet::all_loncaparevs();
- my @alldoms = sort(&Apache::lonnet::all_domains());
+ my (%by_ip,%by_location,@intdoms);
+ &build_location_hashes(\@intdoms,\%by_ip,\%by_location);
+ my @locations = sort(keys(%by_location));
foreach my $type (@types) {
$checkedon{$type} = '';
$checkedoff{$type} = ' checked="checked"';
@@ -2322,12 +2324,21 @@
"\n".
'</div><div><table>';
my $rem;
- for (my $i=0; $i<@alldoms; $i++) {
- next if ($alldoms[$i] eq $dom);
- my $checkedtype;
- if (ref($current{$type}) eq 'ARRAY') {
- if (grep(/^\Q$alldoms[$i]\E$/,@{$current{$type}})) {
- $checkedtype = ' checked="checked"';
+ for (my $i=0; $i<@locations; $i++) {
+ my ($showloc,$value,$checkedtype);
+ if (ref($by_location{$locations[$i]}) eq 'ARRAY') {
+ my $ip = $by_location{$locations[$i]}->[0];
+ if (ref($by_ip{$ip}) eq 'ARRAY') {
+ $value = join(':',@{$by_ip{$ip}});
+ $showloc = join(', ',@{$by_ip{$ip}});
+ if (ref($current{$type}) eq 'ARRAY') {
+ foreach my $loc (@{$by_ip{$ip}}) {
+ if (grep(/^\Q$loc\E$/,@{$current{$type}})) {
+ $checkedtype = ' checked="checked"';
+ last;
+ }
+ }
+ }
}
}
$rem = $i%($numinrow);
@@ -2340,10 +2351,10 @@
$datatable .= '<td class="LC_left_item">'.
'<span class="LC_nobreak"><label>'.
'<input type="checkbox" name="'.$prefix.'_'.$type.
- '" value="'.$alldoms[$i].'"'.$checkedtype.' />'.$alldoms[$i].
+ '" value="'.$value.'"'.$checkedtype.' />'.$showloc.
'</label></span></td>';
}
- $rem = @alldoms%($numinrow);
+ $rem = @locations%($numinrow);
my $colsleft = $numinrow - $rem;
if ($colsleft > 1 ) {
$datatable .= '<td colspan="'.$colsleft.'" class="LC_left_item">'.
@@ -2360,6 +2371,54 @@
return $datatable;
}
+sub build_location_hashes {
+ my ($intdoms,$by_ip,$by_location) = @_;
+ return unless((ref($intdoms) eq 'ARRAY') && (ref($by_ip) eq 'HASH') &&
+ (ref($by_location) eq 'HASH'));
+ my %iphost = &Apache::lonnet::get_iphost();
+ my $primary_id = &Apache::lonnet::domain($env{'request.role.domain'},'primary');
+ my $primary_ip = &Apache::lonnet::get_host_ip($primary_id);
+ if (ref($iphost{$primary_ip}) eq 'ARRAY') {
+ foreach my $id (@{$iphost{$primary_ip}}) {
+ my $intdom = &Apache::lonnet::internet_dom($id);
+ unless(grep(/^\Q$intdom\E$/,@{$intdoms})) {
+ push(@{$intdoms},$intdom);
+ }
+ }
+ }
+ foreach my $ip (keys(%iphost)) {
+ if (ref($iphost{$ip}) eq 'ARRAY') {
+ foreach my $id (@{$iphost{$ip}}) {
+ my $location = &Apache::lonnet::internet_dom($id);
+ if ($location) {
+ next if (grep(/^\Q$location\E$/,@{$intdoms}));
+ if (ref($by_ip->{$ip}) eq 'ARRAY') {
+ unless(grep(/^\Q$location\E$/,@{$by_ip->{$ip}})) {
+ push(@{$by_ip->{$ip}},$location);
+ }
+ } else {
+ $by_ip->{$ip} = [$location];
+ }
+ }
+ }
+ }
+ }
+ foreach my $ip (sort(keys(%{$by_ip}))) {
+ if (ref($by_ip->{$ip}) eq 'ARRAY') {
+ @{$by_ip->{$ip}} = sort(@{$by_ip->{$ip}});
+ my $first = $by_ip->{$ip}->[0];
+ if (ref($by_location->{$first}) eq 'ARRAY') {
+ unless (grep(/^\Q$ip\E$/,@{$by_location->{$first}})) {
+ push(@{$by_location->{$first}},$ip);
+ }
+ } else {
+ $by_location->{$first} = [$ip];
+ }
+ }
+ }
+ return;
+}
+
sub contact_titles {
my %titles = &Apache::lonlocal::texthash (
'supportemail' => 'Support E-mail address',
@@ -6642,12 +6701,16 @@
my @types = ('version','excludedomain','includedomain');
my @prefixes = ('remote','hosted');
my @lcversions = &Apache::lonnet::all_loncaparevs();
+ my (%by_ip,%by_location,@intdoms);
+ &build_location_hashes(\@intdoms,\%by_ip,\%by_location);
+ my @locations = sort(keys(%by_location));
my (%defaultshash,%changes);
foreach my $prefix (@prefixes) {
$defaultshash{'usersessions'}{$prefix} = {};
}
my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
my $resulttext;
+ my %iphost = &Apache::lonnet::get_iphost();
foreach my $prefix (@prefixes) {
foreach my $type (@types) {
my $inuse = $env{'form.'.$prefix.'_'.$type.'_inuse'};
@@ -6694,8 +6757,17 @@
my @vals = &Apache::loncommon::get_env_multiple('form.'.$prefix.'_'.$type);
my @okvals;
foreach my $val (@vals) {
- if (&Apache::lonnet::domain($val) ne '') {
- push(@okvals,$val);
+ if ($val =~ /:/) {
+ my @items = split(/:/,$val);
+ foreach my $item (@items) {
+ if (ref($by_location{$item}) eq 'ARRAY') {
+ push(@okvals,$item);
+ }
+ }
+ } else {
+ if (ref($by_location{$val}) eq 'ARRAY') {
+ push(@okvals,$val);
+ }
}
}
@okvals = sort(@okvals);
@@ -6942,8 +7014,8 @@
remote => 'Hosting of sessions for users in this domain on servers in other domains',
version => 'LON-CAPA version requirement',
- excludedomain => 'Specific domains excluded',
- includedomain => 'Specific domains included',
+ excludedomain => 'Allow all, but exclude specific domains',
+ includedomain => 'Deny all, but include specific domains',
);
}
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1073 loncom/lonnet/perl/lonnet.pm:1.1074
--- loncom/lonnet/perl/lonnet.pm:1.1073 Sat Jul 17 20:02:13 2010
+++ loncom/lonnet/perl/lonnet.pm Tue Jul 20 02:42:47 2010
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1073 2010/07/17 20:02:13 raeburn Exp $
+# $Id: lonnet.pm,v 1.1074 2010/07/20 02:42:47 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -76,7 +76,7 @@
use Image::Magick;
use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir
- $_64bit %env %protocol %loncaparevs);
+ $_64bit %env %protocol %loncaparevs %serverhomeIDs);
my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash,
%userrolehash, $processmarker, $dumpcount, %coursedombuf,
@@ -253,6 +253,34 @@
}
}
+sub get_server_homeID {
+ my ($hostname,$ignore_cache,$caller) = @_;
+ unless ($ignore_cache) {
+ my ($serverhomeID,$cached)=&is_cached_new('serverhomeID',$hostname);
+ if (defined($cached)) {
+ return $serverhomeID;
+ }
+ }
+ my $cachetime = 12*3600;
+ my $serverhomeID;
+ if ($caller eq 'loncron') {
+ my @machine_ids = &machine_ids($hostname);
+ foreach my $id (@machine_ids) {
+ my $response = &reply('serverhomeID',$id);
+ unless (($response eq 'unknown_cmd') || ($response eq 'con_lost')) {
+ $serverhomeID = $response;
+ last;
+ }
+ }
+ if ($serverhomeID eq '') {
+ $serverhomeID = $machine_ids[-1];
+ }
+ } else {
+ $serverhomeID = $serverhomeIDs{$hostname};
+ }
+ return &do_cache_new('serverhomeID',$hostname,$serverhomeID,$cachetime);
+}
+
# -------------------------------------------------- Non-critical communication
sub subreply {
my ($cmd,$server)=@_;
@@ -884,18 +912,19 @@
}
sub can_host_session {
- my ($udom,$machinedom,$remoterev,$remotesessions,$hostedsessions) = @_;
+ my ($udom,$lonhost,$remoterev,$remotesessions,$hostedsessions) = @_;
my $canhost = 1;
+ my $host_idn = &Apache::lonnet::internet_dom($lonhost);
if (ref($remotesessions) eq 'HASH') {
if (ref($remotesessions->{'excludedomain'}) eq 'ARRAY') {
- if (grep(/^\Q$machinedom\E$/,@{$remotesessions->{'excludedomain'}})) {
+ if (grep(/^\Q$host_idn\E$/,@{$remotesessions->{'excludedomain'}})) {
$canhost = 0;
} else {
$canhost = 1;
}
}
if (ref($remotesessions->{'includedomain'}) eq 'ARRAY') {
- if (grep(/^\Q$machinedom\E$/,@{$remotesessions->{'includedomain'}})) {
+ if (grep(/^\Q$host_idn\E$/,@{$remotesessions->{'includedomain'}})) {
$canhost = 1;
} else {
$canhost = 0;
@@ -9773,6 +9802,7 @@
my %libserv;
my $loaded;
my %name_to_host;
+ my %internetdom;
sub parse_hosts_tab {
my ($file) = @_;
@@ -9780,7 +9810,7 @@
next if ($configline =~ /^(\#|\s*$ )/x);
next if ($configline =~ /^\^/);
chomp($configline);
- my ($id,$domain,$role,$name,$protocol)=split(/:/,$configline);
+ my ($id,$domain,$role,$name,$protocol,$intdom)=split(/:/,$configline);
$name=~s/\s//g;
if ($id && $domain && $role && $name) {
$hostname{$id}=$name;
@@ -9796,6 +9826,9 @@
} else {
$protocol{$id} = 'http';
}
+ if (defined($intdom)) {
+ $internetdom{$id} = $intdom;
+ }
}
}
}
@@ -9905,6 +9938,13 @@
my @uniq = grep(!$seen{$_}++, values(%hostdom));
return @uniq;
}
+
+ sub internet_dom {
+ &load_hosts_tab() if (!$loaded);
+
+ my ($lonid) = @_;
+ return $internetdom{$lonid};
+ }
}
{
@@ -10022,6 +10062,36 @@
return undef;
}
+ sub get_internet_names {
+ my ($lonid) = @_;
+ return if ($lonid eq '');
+ my ($idnref,$cached)=
+ &Apache::lonnet::is_cached_new('internetnames',$lonid);
+ if ($cached) {
+ return $idnref;
+ }
+ my $ip = &get_host_ip($lonid);
+ my @hosts = &get_hosts_from_ip($ip);
+ my %iphost = &get_iphost();
+ my (@idns,%seen);
+ foreach my $id (@hosts) {
+ my $dom = &host_domain($id);
+ my $prim_id = &domain($dom,'primary');
+ my $prim_ip = &get_host_ip($prim_id);
+ next if ($seen{$prim_ip});
+ if (ref($iphost{$prim_ip}) eq 'ARRAY') {
+ foreach my $id (@{$iphost{$prim_ip}}) {
+ my $intdom = &internet_dom($id);
+ unless (grep(/^\Q$intdom\E$/,@idns)) {
+ push(@idns,$intdom);
+ }
+ }
+ }
+ $seen{$prim_ip} = 1;
+ }
+ return &Apache::lonnet::do_cache_new('internetnames',$lonid,\@idns,12*60*60);
+ }
+
}
BEGIN {
@@ -10113,6 +10183,20 @@
}
}
+# ---------------------------------------------------------- Read serverhostID table
+{
+ if (-e "$perlvar{'lonTabDir'}/serverhomeIDs.tab") {
+ if (open(my $config,"<$perlvar{'lonTabDir'}/serverhomeIDs.tab")) {
+ while (my $configline=<$config>) {
+ chomp($configline);
+ my ($name,$id)=split(/:/,$configline);
+ $serverhomeIDs{$name}=$id;
+ }
+ close($config);
+ }
+ }
+}
+
sub all_loncaparevs {
return qw(1.1 1.2 1.3 2.0 2.1 2.2 2.3 2.4 2.5 2.6 2.7 2.8 2.9 2.10);
}
Index: doc/loncapafiles/loncapafiles.lpml
diff -u doc/loncapafiles/loncapafiles.lpml:1.691 doc/loncapafiles/loncapafiles.lpml:1.692
--- doc/loncapafiles/loncapafiles.lpml:1.691 Sat Jul 17 20:18:56 2010
+++ doc/loncapafiles/loncapafiles.lpml Tue Jul 20 02:42:54 2010
@@ -2,7 +2,7 @@
"http://lpml.sourceforge.net/DTD/lpml.dtd">
<!-- loncapafiles.lpml -->
-<!-- $Id: loncapafiles.lpml,v 1.691 2010/07/17 20:18:56 raeburn Exp $ -->
+<!-- $Id: loncapafiles.lpml,v 1.692 2010/07/20 02:42:54 raeburn Exp $ -->
<!--
@@ -1485,6 +1485,15 @@
</description>
</file>
+<file type="private">
+ <source>loncom/serverhomeIDs.tab</source>
+ <target dist='default'>home/httpd/lonTabs/serverhomeIDs.tab</target>
+ <categoryname>www static conf</categoryname>
+ <description>
+File holds paired data -- hostname:lonHostID for all servers in the LON-CAPA network (useful for determining which domain should control server settings for a multi-domain server). Updated by loncron.
+ </description>
+</file>
+
<file>
<source>loncom/spare.tab</source>
<target dist='default'>home/httpd/lonTabs/spare.tab</target>
Index: loncom/loncaparevs.tab
+++ loncom/loncaparevs.tab
Index: loncom/serverhomeIDs.tab
+++ loncom/serverhomeIDs.tab
--raeburn1279593775--