[LON-CAPA-cvs] cvs: loncom / lonc lond
albertel
lon-capa-cvs@mail.lon-capa.org
Tue, 18 Mar 2003 22:51:03 -0000
This is a MIME encoded message
--albertel1048027863
Content-Type: text/plain
albertel Tue Mar 18 17:51:03 2003 EDT
Modified files:
/loncom lonc lond
Log:
- Machines with multiple domains now supporteda somewhat
http://bugs.loncapa.org/show_bug.cgi?id=1320
- Requirements:
hosts.tab must have several enetries one for each hostid/domain
but the domain name and IP addresses must be the same
The last entry of the host must correspond with the entries in loncapa.conf
- Known isssues,
1) CSTR space has no domain info in it, username conflicts can occur
2) while you can add the Author role to user, if the role isn't the main domain they can't author
- Tested areas
1) Course creation
2) DOCS mods on course in main/non-main domain
3) problems in course in main/non-main domain
--albertel1048027863
Content-Type: text/plain
Content-Disposition: attachment; filename="albertel-20030318175103.txt"
Index: loncom/lonc
diff -u loncom/lonc:1.47 loncom/lonc:1.48
--- loncom/lonc:1.47 Mon Feb 24 14:56:30 2003
+++ loncom/lonc Tue Mar 18 17:51:03 2003
@@ -5,7 +5,7 @@
# provides persistent TCP connections to the other servers in the network
# through multiplexed domain sockets
#
-# $Id: lonc,v 1.47 2003/02/24 19:56:30 albertel Exp $
+# $Id: lonc,v 1.48 2003/03/18 22:51:03 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -722,7 +722,7 @@
&logthis("<font color=green>INFO Connected to $conserver, initing </font>");
&status("Init dialogue: $conserver");
- $answer = londtransaction($remotesock, "init", 60);
+ $answer = londtransaction($remotesock, "init:$conserver", 60);
chomp($answer);
$answer = londtransaction($remotesock, $answer, 60);
chomp($answer);
Index: loncom/lond
diff -u loncom/lond:1.114 loncom/lond:1.115
--- loncom/lond:1.114 Fri Mar 14 14:29:36 2003
+++ loncom/lond Tue Mar 18 17:51:03 2003
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.114 2003/03/14 19:29:36 albertel Exp $
+# $Id: lond,v 1.115 2003/03/18 22:51:03 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -52,7 +52,6 @@
# preforking is not really needed.
###
-
use lib '/home/httpd/lib/perl/';
use LONCAPA::Configuration;
@@ -74,6 +73,8 @@
my $status='';
my $lastlog='';
+my $currenthostid;
+my $currentdomainid;
#
# The array below are password error strings."
#
@@ -169,7 +170,7 @@
my $wwwid=getpwnam('www');
if ($wwwid!=$<) {
$emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
- $subj="LON: $perlvar{'lonHostID'} User ID mismatch";
+ $subj="LON: $currenthostid User ID mismatch";
system("echo 'User ID mismatch. lond must be run as user www.' |\
mailto $emailto -s '$subj' > /dev/null");
exit 1;
@@ -196,7 +197,9 @@
my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
chomp($ip); $ip=~s/\D+$//;
$hostid{$ip}=$id;
- if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; }
+ $hostdom{$id}=$domain;
+ $hostip{$id}=$ip;
+ if ($id eq $perlvar{'lonHostId'}) { $thisserver=$name; }
$PREFORK++;
}
close(CONFIG);
@@ -272,7 +275,7 @@
&logthis('Child '.$_.' did not respond');
kill 9 => $_;
$emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
- $subj="LON: $perlvar{'lonHostID'} killed lond process $_";
+ $subj="LON: $currenthostid killed lond process $_";
my $result=`echo 'Killed lond process $_.' | mailto $emailto -s '$subj' > /dev/null`;
$execdir=$perlvar{'lonDaemons'};
$result=`/bin/cp $execdir/logs/lond.log $execdir/logs/lond.log.$_`;
@@ -309,7 +312,7 @@
my $docdir=$perlvar{'lonDocRoot'};
{
my $fh=IO::File->new(">>$docdir/lon-status/londstatus.txt");
- print $fh $$."\t".$status."\t".$lastlog."\n";
+ print $fh $$."\t".$currenthostid."\t".$status."\t".$lastlog."\n";
$fh->close();
}
{
@@ -406,12 +409,12 @@
sub reply {
my ($cmd,$server)=@_;
my $answer;
- if ($server ne $perlvar{'lonHostID'}) {
+ if ($server ne $currenthostid) {
$answer=subreply($cmd,$server);
if ($answer eq 'con_lost') {
$answer=subreply("ping",$server);
if ($answer ne $server) {
- &logthis("sub reply: answer != server");
+ &logthis("sub reply: answer != server answer is $answer, server is $server");
&reconlonc("$perlvar{'lonSockDir'}/$server");
}
$answer=subreply($cmd,$server);
@@ -512,6 +515,22 @@
make_new_child($client);
}
+sub init_host_and_domain {
+ my ($remotereq) = @_;
+ my (undef,$hostid)=split(/:/,$remotereq);
+ if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; }
+ if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) {
+ $currenthostid=$hostid;
+ $currentdomainid=$hostdom{$hostid};
+ &logthis("Setting hostid to $hostid, and domain to $currentdomainid");
+ } else {
+ &logthis("Requested host id $hostid not an alias of ".
+ $perlvar{'lonHostID'}." refusing connection");
+ return 0;
+ }
+ return 1;
+}
+
sub make_new_child {
my $client;
my $pid;
@@ -564,15 +583,23 @@
my $clientip=inet_ntoa($iaddr);
my $clientrec=($hostid{$clientip} ne undef);
&logthis(
-"<font color=yellow>INFO: Connection $i, $clientip ($hostid{$clientip})</font>"
+"<font color=yellow>INFO: Connection, $clientip ($hostid{$clientip})</font>"
);
&status("Connecting $clientip ($hostid{$clientip})");
my $clientok;
if ($clientrec) {
&status("Waiting for init from $clientip ($hostid{$clientip})");
my $remotereq=<$client>;
- $remotereq=~s/\W//g;
- if ($remotereq eq 'init') {
+ $remotereq=~s/[^\w:]//g;
+ if ($remotereq =~ /^init/) {
+ if (!&init_host_and_domain($remotereq)) {
+ &status("Got bad init message, exiting");
+ print $client "refused\n";
+ $client->close();
+ &logthis("<font color=blue>WARNING: "
+ ."Bad init message $remotereq, closing connection</font>");
+ exit;
+ }
my $challenge="$$".time;
print $client "$challenge\n";
&status(
@@ -601,9 +628,15 @@
if ($clientok) {
# ---------------- New known client connecting, could mean machine online again
- &reconlonc("$perlvar{'lonSockDir'}/$hostid{$clientip}");
- &logthis(
- "<font color=green>Established connection: $hostid{$clientip}</font>");
+ foreach my $id (keys(%hostip)) {
+ if ($hostip{$id} ne $clientip ||
+ $hostip{$currenthostid} eq $clientip) {
+ # no need to try to do recon's to myself
+ next;
+ }
+ &reconlonc("$perlvar{'lonSockDir'}/$id");
+ }
+ &logthis("<font color=green>Established connection: $hostid{$clientip}</font>");
&status('Will listen to '.$hostid{$clientip});
# ------------------------------------------------------------ Process requests
while (my $userinput=<$client>) {
@@ -631,17 +664,17 @@
# ------------------------------------------------------------- Normal commands
# ------------------------------------------------------------------------ ping
if ($userinput =~ /^ping/) {
- print $client "$perlvar{'lonHostID'}\n";
+ print $client "$currenthostid\n";
# ------------------------------------------------------------------------ pong
} elsif ($userinput =~ /^pong/) {
$reply=reply("ping",$hostid{$clientip});
- print $client "$perlvar{'lonHostID'}:$reply\n";
+ print $client "$currenthostid:$reply\n";
# ------------------------------------------------------------------------ ekey
} elsif ($userinput =~ /^ekey/) {
my $buildkey=time.$$.int(rand 100000);
$buildkey=~tr/1-6/A-F/;
$buildkey=int(rand 100000).$buildkey.int(rand 100000);
- my $key=$perlvar{'lonHostID'}.$hostid{$clientip};
+ my $key=$currenthostid.$hostid{$clientip};
$key=~tr/a-z/A-Z/;
$key=~tr/G-P/0-9/;
$key=~tr/Q-Z/0-9/;
@@ -853,7 +886,7 @@
$passfilename);
if (-e $passfilename) {
print $client "already_exists\n";
- } elsif ($udom ne $perlvar{'lonDefDomain'}) {
+ } elsif ($udom ne $currentdomainid) {
print $client "not_right_domain\n";
} else {
@fpparts=split(/\//,$proname);
@@ -893,7 +926,7 @@
$npass=&unescape($npass);
my $proname=&propath($udom,$uname);
my $passfilename="$proname/passwd";
- if ($udom ne $perlvar{'lonDefDomain'}) {
+ if ($udom ne $currentdomainid) {
print $client "not_right_domain\n";
} else {
my $result=&make_passwd_file($uname, $umode,$npass,
--albertel1048027863--