loncom/lonc - diff

Return to lonc CVS log

Up to [LON-CAPA] / loncom

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

version 1.36, 2002/03/27 04:07:02	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 315 unless (	Line 316 unless (
%outbuffer = ();	%outbuffer = ();
%ready = ();	%ready = ();
%servers = (); # To be compatible with make filevector. indexed by	%servers = (); # To be compatible with make filevector. indexed by
# File descriptors, values are file descriptors.	# File ids, values are sockets.
# note that the accept socket is omitted.	# note that the accept socket is omitted.

tie %ready, 'Tie::RefHash';	tie %ready, 'Tie::RefHash';

nonblock($server);	# nonblock($server);
$select = IO::Select->new($server);	# $select = IO::Select->new($server);

# 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 $conserver");
while (1) {	while (1) {
my $client;	my $client;
my $rv;	my $rv;
my $data;	my $data;

my $infdset; # bit vec of fd's to select on input.	my $infdset; # bit vec of fd's to select on input.
my $inreadyset; # Bit vec of fd's ready for input.

my $outfdset; # Bit vec of fd's to select on output.	my $outfdset; # Bit vec of fd's to select on output.
my $outreadyset; # bit vec of fds ready for output.


$infdset = MakeFileVector(\%servers);	$infdset = MakeFileVector(\%servers);
$outfdset= MakeFileVector(\%outbuffer);	$outfdset= MakeFileVector(\%outbuffer);
	vec($infdset, $server->fileno, 1) = 1;
# check for new information on the connections we have	if($DEBUG) {
# anything to read or accept?	&logthis("Adding ".$server->fileno.
	" to input select vector (listner)".
foreach $client ($select->can_read(00.10)) {	unpack("b*",$infdset)."\n");
if ($client == $server) {
# accept a new connection
&status("Accept new connection: $conserver");
$client = $server->accept();
$select->add($client);
nonblock($client);
} else {
# read data
$data = '';
$rv = $client->recv($data, POSIX::BUFSIZ, 0);

unless (defined($rv) && length $data) {
# This would be the end of file, so close the client
delete $inbuffer{$client};
delete $outbuffer{$client};
delete $ready{$client};

&status("Idle");
$select->remove($client);
close $client;
next;
}

$inbuffer{$client} .= $data;


# test whether the data in the buffer or the data we
# just read means there is a complete request waiting
# to be fulfilled. If there is, set $ready{$client}
# to the requests waiting to be fulfilled.
while ($inbuffer{$client} =~ s/(.*\n)//) {
push( @{$ready{$client}}, $1 );
}
}
}	}
	DoSelect(\$infdset, \$outfdset); # Wait for input.
# Any complete requests to process?	if($DEBUG) {
foreach $client (keys %ready) {	&logthis("Doselect completed!");
handle($client);	&logthis("ins = ".unpack("b*",$infdset)."\n");
	&logthis("outs= ".unpack("b*",$outfdset)."\n");

}	}

# Buffers to flush?
foreach $client ($select->can_write(1)) {
# Skip this client if we have nothing to say
next unless exists $outbuffer{$client};

$rv = $client->send($outbuffer{$client}, 0);

unless ($outbuffer{$client} eq "con_lost\n") {
unless (defined $rv) {
# Whine, but move on.
&logthis("I was told I could write, but I can't.\n");
next;
}
$errno=$!;
if (($rv == length $outbuffer{$client}) \|\|
($errno == POSIX::EWOULDBLOCK) \|\| ($errno == 0)) {
substr($outbuffer{$client}, 0, $rv) = '';
delete $outbuffer{$client} unless length $outbuffer{$client};
} else {
# Couldn't write all the data, and it wasn't because
# it would have blocked. Shutdown and move on.

&logthis("Dropping data with ".$errno.": ".
length($outbuffer{$client}).", $rv");

delete $inbuffer{$client};	# Checkfor new connections:
delete $outbuffer{$client};	if (vec($infdset, $server->fileno, 1)) {
delete $ready{$client};	if($DEBUG) {
	&logthis("New connection established");
$select->remove($client);	}
close($client);	# accept a new connection
next;	&status("Accept new connection: $conserver");
}	$client = $server->accept();
} else {	if($DEBUG) {
	&logthis("New client fd = ".$client->fileno."\n");
	}
	$servers{$client->fileno} = $client;
	nonblock($client);
	$client->sockopt(SO_KEEPALIVE, 1);# Enable monitoring of
	# connection liveness.
	}
	HandleInput($infdset, \%servers, \%inbuffer, \%outbuffer, \%ready);
	HandleOutput($outfdset, \%servers, \%outbuffer, \%inbuffer,
	\%ready);
# -------------------------------------------------------- Wow, connection lost	# -------------------------------------------------------- Wow, connection lost
&logthis(
"<font color=red>CRITICAL: Closing connection</font>");
&status("Connection lost");
$remotesock->shutdown(2);
&logthis("Attempting to open new connection");
&openremote($conserver);
}
}

}	}

	}
}	}

# ------------------------------------------------------- End of make_new_child	# ------------------------------------------------------- End of make_new_child
Line 446 sub MakeFileVector	Line 394 sub MakeFileVector
my $fdhash = shift;	my $fdhash = shift;
my $selvar = "";	my $selvar = "";

foreach $socket (keys %fdhash) {	foreach $socket (keys %$fdhash) {
vec($selvar, ($fdhash->{$socket})->fileno, 1) = 1;	if($DEBUG) {
	&logthis("Adding ".$socket.
	"to select vector. (client)\n");
	}
	vec($selvar, $socket, 1) = 1;
}	}
return $selvar;	return $selvar;
}	}
Line 458 sub MakeFileVector	Line 410 sub MakeFileVector
# Processes output on a buffered set of file descriptors which are	# Processes output on a buffered set of file descriptors which are
# ready to be read.	# ready to be read.
# Parameters:	# Parameters:
# $selvector - Vector of writable file descriptors which are writable.	# $selvector - Vector of file descriptors which are writable.
# \%sockets - Vector of socket references indexed by socket.	# \%sockets - Vector of socket references indexed by socket.
# \%buffers - Reference to a hash containing output buffers.	# \%buffers - Reference to a hash containing output buffers.
# Hashes are indexed by sockets. The file descriptors of some	# Hashes are indexed by sockets. The file descriptors of some
Line 477 sub HandleOutput	Line 429 sub HandleOutput
my $buffers = shift;	my $buffers = shift;
my $inbufs = shift;	my $inbufs = shift;
my $readys = shift;	my $readys = shift;
	my $sock;

	if($DEBUG) {
	&logthis("HandleOutput entered\n");
	}

foreach $sock (keys %buffers) {	foreach $sock (keys %$sockets) {
my $socket = $sockets->{$sock};	my $socket = $sockets->{$sock};
if(vec($selvector, $$socket->fileno, 1)) { # $socket is writable.	if(vec($selvector, $sock, 1)) { # $socket is writable.
my $rv = $$socket->send($buffers->{$sock}, 0);	if($DEBUG) {
	&logthis("Sending $buffers->{$sock} \n");
	}
	my $rv = $socket->send($buffers->{$sock}, 0);
$errno = $!;	$errno = $!;
unless ($buffers->{$sock} eq "con_lost\n") {	unless ($buffers->{$sock} eq "con_lost\n") {
unless (defined $rv) { # Write failed... could be EINTR	unless (defined $rv) { # Write failed... could be EINTR
Line 510 sub HandleOutput	Line 470 sub HandleOutput
delete $inbufs->{$sock};	delete $inbufs->{$sock};
delete $readys->{$sock};	delete $readys->{$sock};

close($$socket); # Close the client socket.	close($socket); # Close the client socket.
next;	next;
}	}
} else { # Kludgy way to mark lond connection lost.	} else { # Kludgy way to mark lond connection lost.
Line 519 sub HandleOutput	Line 479 sub HandleOutput
status("Connection lost");	status("Connection lost");
$remotesock->shutdown(2);	$remotesock->shutdown(2);
&logthis("Attempting to open a new connection");	&logthis("Attempting to open a new connection");
&openremot($conserver);	&openremote($conserver);
}	}

}	}
Line 553 sub HandleInput	Line 513 sub HandleInput
my $ibufs = shift;	my $ibufs = shift;
my $obufs = shift;	my $obufs = shift;
my $ready = shift;	my $ready = shift;
	my $sock;

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

# Attempt to read the data and do error management.	# Attempt to read the data and do error management.
my $data = '';	my $data = '';
my $rv = $$socket->recv($data, POSIX::BUFSIZ, 0);	my $rv = $socket->recv($data, POSIX::BUFSIZ, 0);
	if($DEBUG) {
	&logthis("Received $data from socket");
	}
unless (defined($rv) && length $data) {	unless (defined($rv) && length $data) {

# Read an end of file.. this is a disconnect from the peer.	# Read an end of file.. this is a disconnect from the peer.
Line 571 sub HandleInput	Line 538 sub HandleInput
delete $ready->{$sock};	delete $ready->{$sock};

status("Idle");	status("Idle");
close $$socket;	close $socket;
next;	next;
}	}
# Append the read data to the input buffer. If the buffer	# Append the read data to the input buffer. If the buffer
Line 611 sub DoSelect {	Line 578 sub DoSelect {
my $ins;	my $ins;

while (1) {	while (1) {
my $nfds = select($outs = $$writevec, $ins = $$readvec, undef, undef);	my $nfds = select( $ins = $$readvec, $outs = $$writevec, undef, undef);
if($nfound) {	if($nfds) {
	if($DEBUG) {
	&logthis("select exited with ".$nfds." fds\n");
	&logthis("ins = ".unpack("b*",$ins).
	" readvec = ".unpack("b*",$$readvec)."\n");
	&logthis("outs = ".unpack("b*",$outs).
	" writevec = ".unpack("b*",$$writevec)."\n");
	}
$$readvec = $ins;	$$readvec = $ins;
$$writevec = $outs;	$$writevec = $outs;
return;	return;
} else {	} else {
	if($DEBUG) {
	&logthis("Select exited with no bits set in mask\n");
	}
die "Select failed" unless $! == EINTR;	die "Select failed" unless $! == EINTR;
}	}
}	}
Line 707 sub handle {	Line 684 sub handle {
}	}
}	}
# ---------------------------------------------------------- End make_new_child	# ---------------------------------------------------------- End make_new_child
}

# nonblock($socket) puts socket into nonblocking mode	# nonblock($socket) puts socket into nonblocking mode
sub nonblock {	sub nonblock {
Line 727 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 877 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 897 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 983 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 1043 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.36
changed lines
	Added in v.1.50