loncom/lonc - diff

Return to lonc CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/Attic/lonc between versions 1.37 and 1.50

version 1.37, 2002/04/04 21:55:55	version 1.50, 2003/07/02 01:28:12
Line 37	Line 37
# 6/4/99,6/5,6/7,6/8,6/9,6/10,6/11,6/12,7/14,7/19,	# 6/4/99,6/5,6/7,6/8,6/9,6/10,6/11,6/12,7/14,7/19,
# 10/8,10/9,10/15,11/18,12/22,	# 10/8,10/9,10/15,11/18,12/22,
# 2/8,7/25 Gerd Kortemeyer	# 2/8,7/25 Gerd Kortemeyer
# 12/05 Scott Harrison
# 12/05 Gerd Kortemeyer	# 12/05 Gerd Kortemeyer
# YEAR=2001	# YEAR=2001
# 01/10/01 Scott Harrison
# 03/14/01,03/15,06/12,11/26,11/27,11/28 Gerd Kortemeyer	# 03/14/01,03/15,06/12,11/26,11/27,11/28 Gerd Kortemeyer
# 12/20 Scott Harrison
# YEAR=2002	# YEAR=2002
# 2/19/02,02/22/02,02/25/02 Gerd Kortemeyer	# 2/19/02,02/22/02,02/25/02 Gerd Kortemeyer
# 3/07/02 Ron Fox	# 3/07/02 Ron Fox
# based on nonforker from Perl Cookbook	# based on nonforker from Perl Cookbook
# - server who multiplexes without forking	# - server who multiplexes without forking

	use lib '/home/httpd/lib/perl/';
	use LONCAPA::Configuration;

use POSIX;	use POSIX;
use IO::Socket;	use IO::Socket;
use IO::Select;	use IO::Select;
Line 64 $status='';	Line 64 $status='';
$lastlog='';	$lastlog='';
$conserver='SHELL';	$conserver='SHELL';
$DEBUG = 0; # Set to 1 for annoyingly complete logs.	$DEBUG = 0; # Set to 1 for annoyingly complete logs.
	$VERSION='$Revison$'; #' stupid emacs
	$remoteVERSION;
# -------------------------------- Set signal handlers to record abnormal exits	# -------------------------------- Set signal handlers to record abnormal exits

&status("Init exception handlers");	&status("Init exception handlers");
$SIG{QUIT}=\&catchexception;	$SIG{QUIT}=\&catchexception;
$SIG{__DIE__}=\&catchexception;	$SIG{__DIE__}=\&catchexception;

# ------------------------------------ Read httpd access.conf and get variables	# ---------------------------------- Read loncapa_apache.conf and loncapa.conf
&status("Read access.conf");	&status("Read loncapa.conf and loncapa_apache.conf");
open (CONFIG,"/etc/httpd/conf/access.conf") \|\| die "Can't read access.conf";	my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
	my %perlvar=%{$perlvarref};
while ($configline=<CONFIG>) {	undef $perlvarref;
if ($configline =~ /PerlSetVar/) {
my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
chomp($varvalue);
$perlvar{$varname}=$varvalue;
}
}
close(CONFIG);

# ----------------------------- Make sure this process is running from user=www	# ----------------------------- Make sure this process is running from user=www
&status("Check user ID");	&status("Check user ID");
Line 175 $SIG{USR1} = \&USRMAN;	Line 169 $SIG{USR1} = \&USRMAN;
# And maintain the population.	# And maintain the population.
while (1) {	while (1) {
my $deadpid = wait; # Wait for the next child to die.	my $deadpid = wait; # Wait for the next child to die.
# See who died and start new one	# See who died and start new one
	# or a signal (e.g. USR1 for restart).
	# if a signal, the wait will fail
	# This is ordinarily detected by
	# checking for the existence of the
	# pid index inthe children hash since
	# the return value from a failed wait is -1
	# which is an impossible PID.
&status("Woke up");	&status("Woke up");
my $skipping='';	my $skipping='';

Line 255 unlink($port);	Line 256 unlink($port);
@allbuffered=grep /\.$conserver$/, readdir DIRHANDLE;	@allbuffered=grep /\.$conserver$/, readdir DIRHANDLE;
closedir(DIRHANDLE);	closedir(DIRHANDLE);
my $dfname;	my $dfname;
foreach (@allbuffered) {	foreach (sort @allbuffered) {
&status("Sending delayed: $_");	&status("Sending delayed: $_");
$dfname="$path/$_";	$dfname="$path/$_";
if($DEBUG) { &logthis('Sending '.$dfname); }	if($DEBUG) { &logthis('Sending '.$dfname); }
Line 325 tie %ready, 'Tie::RefHash';	Line 326 tie %ready, 'Tie::RefHash';

# Main loop: check reads/accepts, check writes, check ready to process	# Main loop: check reads/accepts, check writes, check ready to process

status("Main loop");	status("Main loop $conserver");
while (1) {	while (1) {
my $client;	my $client;
my $rv;	my $rv;
Line 365 while (1) {	Line 366 while (1) {
}	}
$servers{$client->fileno} = $client;	$servers{$client->fileno} = $client;
nonblock($client);	nonblock($client);
	$client->sockopt(SO_KEEPALIVE, 1);# Enable monitoring of
	# connection liveness.
}	}
HandleInput($infdset, \%servers, \%inbuffer, \%outbuffer, \%ready);	HandleInput($infdset, \%servers, \%inbuffer, \%outbuffer, \%ready);
HandleOutput($outfdset, \%servers, \%outbuffer, \%inbuffer,	HandleOutput($outfdset, \%servers, \%outbuffer, \%inbuffer,
Line 512 sub HandleInput	Line 515 sub HandleInput
my $ready = shift;	my $ready = shift;
my $sock;	my $sock;

&logthis("Entered HandleInput\n");	if($DEBUG) {
	&logthis("Entered HandleInput\n");
	}
foreach $sock (keys %$sockets) {	foreach $sock (keys %$sockets) {
my $socket = $sockets->{$sock};	my $socket = $sockets->{$sock};
if(vec($selvec, $sock, 1)) { # Socket which is readable.	if(vec($selvec, $sock, 1)) { # Socket which is readable.
Line 698 sub openremote {	Line 703 sub openremote {

my $conserver=shift;	my $conserver=shift;

&status("Opening TCP");	&status("Opening TCP $conserver");
my $st=120+int(rand(240)); # Sleep before opening:	my $st=120+int(rand(240)); # Sleep before opening:

unless (	unless (
$remotesock = IO::Socket::INET->new(PeerAddr => $hostip{$conserver},	$remotesock = IO::Socket::INET->new(PeerAddr => $hostip{$conserver},
PeerPort => $perlvar{'londPort'},	PeerPort => $perlvar{'londPort'},
Proto => "tcp",	Proto => "tcp",
Type => SOCK_STREAM)	Type => SOCK_STREAM)
) {	) {

&logthis(	&logthis(
"<font color=blue>WARNING: Couldn't connect to $conserver ($st secs): </font>");	"<font color=blue>WARNING: Couldn't connect to $conserver ($st secs): </font>");
sleep($st);	sleep($st);
exit;	exit;
};	};
# ----------------------------------------------------------------- Init dialog	# ----------------------------------------------------------------- Init dialog

&logthis("<font color=green>INFO Connected to $conserver, initing </font>");	&logthis("<font color=green>INFO Connected to $conserver, initing</font>");
&status("Init dialogue: $conserver");	&status("Init dialogue: $conserver");

$answer = londtransaction($remotesock, "init", 60);	$answer = londtransaction($remotesock, "init", 60);
chomp($answer);	chomp($answer);
$answer = londtransaction($remotesock, $answer, 60);	$answer = londtransaction($remotesock, $answer, 60);
chomp($answer);	chomp($answer);

if ($@=~/timeout/) {
&logthis("Timed out during init.. exiting");
exit;
}

if ($answer ne 'ok') {	if ($@=~/timeout/) {
&logthis("Init reply: >$answer<");	&logthis("Timed out during init.. exiting");
my $st=120+int(rand(240));	exit;
&logthis(	}
"<font color=blue>WARNING: Init failed ($st secs)</font>");
sleep($st);
exit;
}

sleep 5;	if ($answer ne 'ok') {
&status("Ponging");	&logthis("Init reply: >$answer<");
print $remotesock "pong\n";	my $st=120+int(rand(240));
$answer=<$remotesock>;	&logthis("<font color=blue>WARNING: Init failed ($st secs)</font>");
chomp($answer);	sleep($st);
if ($answer!~/^$conserver/) {	exit;
&logthis("Pong reply: >$answer<");	}
}
	$answer = londtransaction($remotesock,"sethost:$conserver",60);
	chomp($answer);
	if ( $answer ne 'ok') {
	&logthis('<font color="blue">WARNING: unable to specify remote host'.
	$answer.'</font>');
	}

	$answer = londtransaction($remotesock,"version:$VERSION",60);
	chomp($answer);
	if ($answer =~ /^version:/) {
	$remoteVERSION=(split(/:/,$answer))[1];
	} else {
	&logthis('<font color="blue">WARNING: request remote version failed :'.
	$answer.': my version is :'.$VERSION.':</font>');
	}

	sleep 5;
	&status("Ponging $conserver");
	print $remotesock "pong\n";
	$answer=<$remotesock>;
	chomp($answer);
	if ($answer!~/^$conserver/) {
	&logthis("Pong reply: >$answer<");
	}
# ----------------------------------------------------------- Initialize cipher	# ----------------------------------------------------------- Initialize cipher

&status("Initialize cipher");	&status("Initialize cipher");
print $remotesock "ekey\n";	print $remotesock "ekey\n";
my $buildkey=<$remotesock>;	my $buildkey=<$remotesock>;
my $key=$conserver.$perlvar{'lonHostID'};	my $key=$conserver.$perlvar{'lonHostID'};
$key=~tr/a-z/A-Z/;	$key=~tr/a-z/A-Z/;
$key=~tr/G-P/0-9/;	$key=~tr/G-P/0-9/;
$key=~tr/Q-Z/0-9/;	$key=~tr/Q-Z/0-9/;
$key=$key.$buildkey.$key.$buildkey.$key.$buildkey;	$key=$key.$buildkey.$key.$buildkey.$key.$buildkey;
$key=substr($key,0,32);	$key=substr($key,0,32);
my $cipherkey=pack("H32",$key);	my $cipherkey=pack("H32",$key);
if ($cipher=new IDEA $cipherkey) {	if ($cipher=new IDEA $cipherkey) {
&logthis("Secure connection initialized");	&logthis("Secure connection initialized");
} else {	} else {
my $st=120+int(rand(240));	my $st=120+int(rand(240));
&logthis(	&logthis("<font color=blue>WARNING: ".
"<font color=blue>WARNING: ".	"Could not establish secure connection ($st secs)!</font>");
"Could not establish secure connection ($st secs)!</font>");	sleep($st);
sleep($st);	exit;
exit;	}
}
&logthis("<font color=green> Remote open success </font>");	&logthis("<font color=green> Remote open success </font>");
}	}

Line 848 sub HUPSMAN { # sig	Line 867 sub HUPSMAN { # sig
local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children	local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children
&hangup();	&hangup();
&logthis("<font color=red>CRITICAL: Restarting</font>");	&logthis("<font color=red>CRITICAL: Restarting</font>");
unlink("$execdir/logs/lonc.pid");
my $execdir=$perlvar{'lonDaemons'};	my $execdir=$perlvar{'lonDaemons'};
	unlink("$execdir/logs/lonc.pid");
exec("$execdir/lonc"); # here we go again	exec("$execdir/lonc"); # here we go again
}	}

Line 868 sub checkchildren {	Line 887 sub checkchildren {

sub USRMAN {	sub USRMAN {
&logthis("USR1: Trying to establish connections again");	&logthis("USR1: Trying to establish connections again");
%childatt=();	#
&checkchildren();	# It is really important not to just clear the childatt hash or we will
	# lose all memory of the children. What we really want to do is this:
	# For each index where childatt is >= $childmaxattempts
	# Zero the associated counter and do a make_child for the host.
	# Regardles, the childatt entry is zeroed:
	my $host;
	foreach $host (keys %childatt) {
	if ($childatt{$host} >= $childmaxattempts) {
	$childatt{$host} = 0;
	&logthis("<font color=green>INFO: Restarting child for server: "
	.$host."</font>\n");
	make_new_child($host);
	}
	else {
	$childatt{$host} = 0;
	}
	}
	&checkchildren(); # See if any children are still dead...
}	}

# -------------------------------------------------- Non-critical communication	# -------------------------------------------------- Non-critical communication
Line 954 sub londtransaction {	Line 990 sub londtransaction {
alarm(0);	alarm(0);
};	};
} else {	} else {
if($DEBUG) {	&logthis("lonc - suiciding on send Timeout");
&logthis("Timeout on send in londtransaction");	die("lonc - suiciding on send Timeout");
}
}	}
if( ($@ =~ /timeout/) && ($DEBUG)) {	if ($@ =~ /timeout/) {
&logthis("Timeout on receive in londtransaction");	&logthis("lonc - suiciding on read Timeout");
	die("lonc - suiciding on read Timeout");
}	}
#	#
# Restore the initial sigmask set.	# Restore the initial sigmask set.
Line 1014 sub status {	Line 1050 sub status {
my $now=time;	my $now=time;
my $local=localtime($now);	my $local=localtime($now);
$status=$local.': '.$what;	$status=$local.': '.$what;
	$0='lonc: '.$what.' '.$local;
}	}

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.37
changed lines
	Added in v.1.50