[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 @@
 }
 &register_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;
+}
+&register_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--