loncom/lonc - diff

Return to lonc CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/Attic/lonc between versions 1.30 and 1.34

version 1.30, 2002/02/25 20:43:15	version 1.34, 2002/03/20 03:44:11
Line 45	Line 45
# 12/20 Scott Harrison	# 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
# based on nonforker from Perl Cookbook	# based on nonforker from Perl Cookbook
# - server who multiplexes without forking	# - server who multiplexes without forking

Line 57 use Socket;	Line 57 use Socket;
use Fcntl;	use Fcntl;
use Tie::RefHash;	use Tie::RefHash;
use Crypt::IDEA;	use Crypt::IDEA;
use Net::Ping;	#use Net::Ping;
use LWP::UserAgent();	use LWP::UserAgent();

$status='';	$status='';
$lastlog='';	$lastlog='';
$conserver='SHELL';	$conserver='SHELL';
	$DEBUG = 0; # Set to 1 for annoyingly complete logs.

# -------------------------------- Set signal handlers to record abnormal exits	# -------------------------------- Set signal handlers to record abnormal exits

Line 158 $SIG{HUP}=$SIG{USR1}='IGNORE';	Line 159 $SIG{HUP}=$SIG{USR1}='IGNORE';
&status("Forking ...");	&status("Forking ...");

foreach $thisserver (keys %hostip) {	foreach $thisserver (keys %hostip) {
if (&online($hostname{$thisserver})) {	#if (&online($hostname{$thisserver})) {
make_new_child($thisserver);	make_new_child($thisserver);
}	#}
}	}

&logthis("Done starting initial servers");	&logthis("Done starting initial servers");
# ----------------------------------------------------- Install signal handlers	# ----------------------------------------------------- Install signal handlers

$SIG{CHLD} = \&REAPER;
$SIG{INT} = $SIG{TERM} = \&HUNTSMAN;	$SIG{INT} = $SIG{TERM} = \&HUNTSMAN;
$SIG{HUP} = \&HUPSMAN;	$SIG{HUP} = \&HUPSMAN;
$SIG{USR1} = \&USRMAN;	$SIG{USR1} = \&USRMAN;

# And maintain the population.	# And maintain the population.
while (1) {	while (1) {
&status("Sleeping");	my $deadpid = wait; # Wait for the next child to die.
sleep; # wait for a signal (i.e., child's death)
# See who died and start new one	# See who died and start new one
&status("Woke up");	&status("Woke up");
my $skipping='';	my $skipping='';
foreach $thisserver (keys %hostip) {
if (!$childpid{$thisserver}) {	if(exists($children{$deadpid})) {
if (($childatt{$thisserver}<$childmaxattempts) &&
(&online($hostname{$thisserver}))) {	$thisserver = $children{$deadpid}; # Look name of dead guy's peer.
$childatt{$thisserver}++;
&logthis(	delete($children{$deadpid}); # Get rid of dead hash entry.
"<font color=yellow>INFO: Trying to reconnect for $thisserver "
."($childatt{$thisserver} of $childmaxattempts attempts)</font>");	if($childatt{$thisserver} < $childmaxattempts) {
make_new_child($thisserver);	$childatt{$thisserver}++;
} else {	&logthis(
$skipping.=$thisserver.' ';	"<font color=yellow>INFO: Trying to reconnect for $thisserver "
}	."($childatt{$thisserver} of $childmaxattempts attempts)</font>");
	make_new_child($thisserver);
}
}	}
if ($skipping) {	else {
&logthis("<font color=blue>WARNING: Skipped $skipping</font>");	$skipping .= $thisserver.' ';
	}
	if($skipping) {
	&logthis("<font color=blue>WARNING: Skipped $skipping</font>");

	}
}	}

}	}



sub make_new_child {	sub make_new_child {

$newserver=shift;	$newserver=shift;
Line 217 sub make_new_child {	Line 224 sub make_new_child {
sigprocmask(SIG_UNBLOCK, $sigset)	sigprocmask(SIG_UNBLOCK, $sigset)
or die "Can't unblock SIGINT for fork: $!\n";	or die "Can't unblock SIGINT for fork: $!\n";
$children{$pid} = $newserver;	$children{$pid} = $newserver;
$childpid{$conserver} = $pid;	$childpid{$newserver} = $pid;
return;	return;
} else {	} else {
$conserver=$newserver;	$conserver=$newserver;
Line 238 unlink($port);	Line 245 unlink($port);
# -------------------------------------------------------------- Open other end	# -------------------------------------------------------------- Open other end

&openremote($conserver);	&openremote($conserver);
	&logthis("<font color=green> Connection to $conserver open </font>");
# ----------------------------------------- We're online, send delayed messages	# ----------------------------------------- We're online, send delayed messages
&status("Checking for delayed messages");	&status("Checking for delayed messages");

my @allbuffered;	my @allbuffered;
my $path="$perlvar{'lonSockDir'}/delayed";	my $path="$perlvar{'lonSockDir'}/delayed";
opendir(DIRHANDLE,$path);	opendir(DIRHANDLE,$path);
Line 250 unlink($port);	Line 258 unlink($port);
foreach (@allbuffered) {	foreach (@allbuffered) {
&status("Sending delayed: $_");	&status("Sending delayed: $_");
$dfname="$path/$_";	$dfname="$path/$_";
&logthis('Sending '.$dfname);	if($DEBUG) { &logthis('Sending '.$dfname); }
my $wcmd;	my $wcmd;
{	{
my $dfh=IO::File->new($dfname);	my $dfh=IO::File->new($dfname);
Line 271 unlink($port);	Line 279 unlink($port);
}	}
$cmd="enc:$cmdlength:$encrequest\n";	$cmd="enc:$cmdlength:$encrequest\n";
}	}
$SIG{ALRM}=sub { die "timeout" };	$answer = londtransaction($remotesock, $cmd, 60);
$SIG{__DIE__}='DEFAULT';
eval {
alarm(60);
print $remotesock "$cmd\n";
$answer=<$remotesock>;
chomp($answer);	chomp($answer);
alarm(0);
};
$SIG{ALRM}='DEFAULT';
$SIG{__DIE__}=\&catchexception;

if (($answer ne '') && ($@!~/timeout/)) {	if (($answer ne '') && ($@!~/timeout/)) {
unlink("$dfname");	unlink("$dfname");
Line 289 unlink($port);	Line 288 unlink($port);
&logperm("S:$conserver:$bcmd");	&logperm("S:$conserver:$bcmd");
}	}
}	}
	if($DEBUG) { &logthis("<font color=green> Delayed transactions sent"); }

# ------------------------------------------------------- Listen to UNIX socket	# ------------------------------------------------------- Listen to UNIX socket
&status("Opening socket");	&status("Opening socket");
Line 300 unless (	Line 300 unless (
my $st=120+int(rand(240));	my $st=120+int(rand(240));
&logthis(	&logthis(
"<font color=blue>WARNING: ".	"<font color=blue>WARNING: ".
"Can't make server socket ($st secs): $@</font>");	"Can't make server socket ($st secs): .. exiting</font>");
sleep($st);	sleep($st);
exit;	exit;
};	};

# -----------------------------------------------------------------------------	# -----------------------------------------------------------------------------

&logthis("<font color=green>$conserver online</font>");	&logthis("<font color=green>$conserver online</font>");
Line 329 while (1) {	Line 329 while (1) {
# check for new information on the connections we have	# check for new information on the connections we have

# anything to read or accept?	# anything to read or accept?
foreach $client ($select->can_read(0.1)) {

	foreach $client ($select->can_read(00.10)) {
if ($client == $server) {	if ($client == $server) {
# accept a new connection	# accept a new connection
&status("Accept new connection: $conserver");	&status("Accept new connection: $conserver");
Line 356 while (1) {	Line 356 while (1) {

$inbuffer{$client} .= $data;	$inbuffer{$client} .= $data;


# test whether the data in the buffer or the data we	# test whether the data in the buffer or the data we
# just read means there is a complete request waiting	# just read means there is a complete request waiting
# to be fulfilled. If there is, set $ready{$client}	# to be fulfilled. If there is, set $ready{$client}
Line 365 while (1) {	Line 366 while (1) {
}	}
}	}
}	}

# Any complete requests to process?	# Any complete requests to process?
foreach $client (keys %ready) {	foreach $client (keys %ready) {
handle($client);	handle($client);
}	}

# Buffers to flush?	# Buffers to flush?
foreach $client ($select->can_write(1)) {	foreach $client ($select->can_write(1)) {
# Skip this client if we have nothing to say	# Skip this client if we have nothing to say
Line 426 sub handle {	Line 427 sub handle {
# send output to $outbuffer{$client}	# send output to $outbuffer{$client}
my $client = shift;	my $client = shift;
my $request;	my $request;

foreach $request (@{$ready{$client}}) {	foreach $request (@{$ready{$client}}) {
# ============================================================= Process request	# ============================================================= Process request
# $request is the text of the request	# $request is the text of the request
# put text of reply into $outbuffer{$client}	# put text of reply into $outbuffer{$client}
# ------------------------------------------------------------ Is this the end?	# ------------------------------------------------------------ Is this the end?
	chomp($request);
	if($DEBUG) {
	&logthis("<font color=green> Request $request processing starts</font>");
	}
if ($request eq "close_connection_exit\n") {	if ($request eq "close_connection_exit\n") {
&status("Request close connection");	&status("Request close connection");
&logthis(	&logthis(
"<font color=red>CRITICAL: Request Close Connection</font>");	"<font color=red>CRITICAL: Request Close Connection ... exiting</font>");
$remotesock->shutdown(2);	$remotesock->shutdown(2);
$server->close();	$server->close();
exit;	exit;
Line 452 sub handle {	Line 456 sub handle {
$encrequest.=	$encrequest.=
unpack("H16",$cipher->encrypt(substr($cmd,$encidx,8)));	unpack("H16",$cipher->encrypt(substr($cmd,$encidx,8)));
}	}
$request="enc:$cmdlength:$encrequest\n";	$request="enc:$cmdlength:$encrequest";
}	}
# --------------------------------------------------------------- Main exchange	# --------------------------------------------------------------- Main exchange
$SIG{ALRM}=sub { die "timeout" };	$answer = londtransaction($remotesock, $request, 300);
$SIG{__DIE__}='DEFAULT';
eval {	if($DEBUG) {
alarm(300);	&logthis("<font color=green> Request data exchange complete");
&status("Sending: $request");	}
print $remotesock "$request";	if ($@=~/timeout/) {
&status("Waiting for reply from $conserver: $request");	$answer='';
$answer=<$remotesock>;	&logthis(
&status("Received reply: $request");	"<font color=red>CRITICAL: Timeout: $request</font>");
alarm(0);	}
};
if ($@=~/timeout/) {
$answer='';
&logthis(
"<font color=red>CRITICAL: Timeout: $request</font>");
}
$SIG{ALRM}='DEFAULT';
$SIG{__DIE__}=\&catchexception;


if ($answer) {	if ($answer) {
Line 488 sub handle {	Line 484 sub handle {
$answer=substr($answer,0,$cmdlength);	$answer=substr($answer,0,$cmdlength);
$answer.="\n";	$answer.="\n";
}	}
	if($DEBUG) {
	&logthis("sending $answer to client\n");
	}
$outbuffer{$client} .= $answer;	$outbuffer{$client} .= $answer;
} else {	} else {
$outbuffer{$client} .= "con_lost\n";	$outbuffer{$client} .= "con_lost\n";
}	}

&status("Completed: $request");	&status("Completed: $request");
	if($DEBUG) {
	&logthis("<font color=green> Request processing complete</font>");
	}
# ===================================================== Done processing request	# ===================================================== Done processing request
}	}
delete $ready{$client};	delete $ready{$client};
# -------------------------------------------------------------- End non-forker	# -------------------------------------------------------------- End non-forker
	if($DEBUG) {
	&logthis("<font color=green> requests for child handled</font>");
	}
}	}
# ---------------------------------------------------------- End make_new_child	# ---------------------------------------------------------- End make_new_child
}	}
Line 522 sub openremote {	Line 526 sub openremote {
my $conserver=shift;	my $conserver=shift;

&status("Opening TCP");	&status("Opening TCP");
	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},
Line 529 unless (	Line 534 unless (
Proto => "tcp",	Proto => "tcp",
Type => SOCK_STREAM)	Type => SOCK_STREAM)
) {	) {
my $st=120+int(rand(240));
&logthis(	&logthis(
"<font color=blue>WARNING: Couldn't connect ($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>");
&status("Init dialogue: $conserver");	&status("Init dialogue: $conserver");

$SIG{ALRM}=sub { die "timeout" };	$answer = londtransaction($remotesock, "init", 60);
$SIG{__DIE__}='DEFAULT';	chomp($answer);
eval {	$answer = londtransaction($remotesock, $answer, 60);
alarm(60);	chomp($answer);
print $remotesock "init\n";
$answer=<$remotesock>;
print $remotesock "$answer";
$answer=<$remotesock>;
chomp($answer);
alarm(0);
};
$SIG{ALRM}='DEFAULT';
$SIG{__DIE__}=\&catchexception;

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

Line 597 if ($cipher=new IDEA $cipherkey) {	Line 594 if ($cipher=new IDEA $cipherkey) {
sleep($st);	sleep($st);
exit;	exit;
}	}
	&logthis("<font color=green> Remote open success </font>");
}	}


Line 610 sub catchexception {	Line 607 sub catchexception {
chomp($signal);	chomp($signal);
&logthis("<font color=red>CRITICAL: "	&logthis("<font color=red>CRITICAL: "
."ABNORMAL EXIT. Child $$ for server [$wasserver] died through "	."ABNORMAL EXIT. Child $$ for server [$wasserver] died through "
."\"$signal\" with parameter [$@]</font>");	."\"$signal\" with parameter </font>");
die($@);	die("Signal abend");
}	}

# -------------------------------------- Routines to see if other box available	# -------------------------------------- Routines to see if other box available

sub online {	#sub online {
my $host=shift;	# my $host=shift;
&status("Pinging ".$host);	# &status("Pinging ".$host);
my $p=Net::Ping->new("tcp",20);	# my $p=Net::Ping->new("tcp",20);
my $online=$p->ping("$host");	# my $online=$p->ping("$host");
$p->close();	# $p->close();
undef ($p);	# undef ($p);
return $online;	# return $online;
}	#}

sub connected {	sub connected {
my ($local,$remote)=@_;	my ($local,$remote)=@_;
Line 635 sub connected {	Line 632 sub connected {
unless ($hostname{$local}) { return 'local_unknown'; }	unless ($hostname{$local}) { return 'local_unknown'; }
unless ($hostname{$remote}) { return 'remote_unknown'; }	unless ($hostname{$remote}) { return 'remote_unknown'; }

unless (&online($hostname{$local})) { return 'local_offline'; }	#unless (&online($hostname{$local})) { return 'local_offline'; }

my $ua=new LWP::UserAgent;	my $ua=new LWP::UserAgent;

Line 654 sub connected {	Line 651 sub connected {
}	}


sub REAPER { # takes care of dead children
$SIG{CHLD} = \&REAPER;
my $pid = wait;
my $wasserver=$children{$pid};
&logthis("<font color=red>CRITICAL: "
."Child $pid for server $wasserver died ($childatt{$wasserver})</font>");
delete $children{$pid};
delete $childpid{$wasserver};
my $port = "$perlvar{'lonSockDir'}/$wasserver";
unlink($port);
}

sub hangup {	sub hangup {
foreach (keys %children) {	foreach (keys %children) {
Line 725 sub subreply {	Line 711 sub subreply {
or return "con_lost";	or return "con_lost";


$SIG{ALRM}=sub { die "timeout" };	$answer = londtransaction($sclient, $cmd, 10);
$SIG{__DIE__}='DEFAULT';
eval {
alarm(10);
print $sclient "$cmd\n";
$answer=<$sclient>;
chomp($answer);
alarm(0);
};
if ((!$answer) \|\| ($@=~/timeout/)) { $answer="con_lost"; }	if ((!$answer) \|\| ($@=~/timeout/)) { $answer="con_lost"; }
$SIG{ALRM}='DEFAULT';	$SIG{ALRM}='DEFAULT';
$SIG{__DIE__}=\&catchexception;	$SIG{__DIE__}=\&catchexception;
Line 753 sub logthis {	Line 732 sub logthis {
print $fh "$local ($$) [$conserver] [$status]: $message\n";	print $fh "$local ($$) [$conserver] [$status]: $message\n";
}	}

	#-------------------------------------- londtransaction:
	#
	# Performs a transaction with lond with timeout support.
	# result = londtransaction(socket,request,timeout)
	#
	sub londtransaction {
	my ($socket, $request, $tmo) = @_;

	if($DEBUG) {
	&logthis("londtransaction request: $request");
	}

	# Set the signal handlers: ALRM for timeout and disble the others.

	$SIG{ALRM} = sub { die "timeout" };
	$SIG{__DIE__} = 'DEFAULT';

	# Disable all but alarm so that only that can interupt the
	# send /receive.
	#
	my $sigset = POSIX::SigSet->new(QUIT, USR1, HUP, INT, TERM);
	my $priorsigs = POSIX::SigSet->new;
	unless (defined sigprocmask(SIG_BLOCK, $sigset, $priorsigs)) {
	&logthis("<font color=red> CRITICAL -- londtransaction ".
	"failed to block signals </font>");
	die "could not block signals in londtransaction";
	}
	$answer = '';
	#
	# Send request to lond.
	#
	eval {
	alarm($tmo);
	print $socket "$request\n";
	alarm(0);
	};
	# If request didn't timeout, try for the response.
	#

	if ($@!~/timeout/) {
	eval {
	alarm($tmo);
	$answer = <$socket>;
	if($DEBUG) {
	&logthis("Received $answer in londtransaction");
	}
	alarm(0);
	};
	} else {
	if($DEBUG) {
	&logthis("Timeout on send in londtransaction");
	}
	}
	if( ($@ =~ /timeout/) && ($DEBUG)) {
	&logthis("Timeout on receive in londtransaction");
	}
	#
	# Restore the initial sigmask set.
	#
	unless (defined sigprocmask(SIG_UNBLOCK, $priorsigs)) {
	&logthis("<font color=red> CRITICAL -- londtransaction ".
	"failed to re-enable signal processing. </font>");
	die "londtransaction failed to re-enable signals";
	}
	#
	# go back to the prior handler set.
	#
	$SIG{ALRM} = 'DEFAULT';
	$SIG{__DIE__} = \&cathcexception;

	# chomp $answer;
	if ($DEBUG) {
	&logthis("Returning $answer in londtransaction");
	}
	return $answer;

	}

sub logperm {	sub logperm {
my $message=shift;	my $message=shift;
Line 797 lonc - LON TCP-MySQL-Server Daemon for h	Line 853 lonc - LON TCP-MySQL-Server Daemon for h

=head1 SYNOPSIS	=head1 SYNOPSIS

	Usage: B<lonc>

Should only be run as user=www. This is a command-line script which	Should only be run as user=www. This is a command-line script which
is invoked by loncron.	is invoked by B<loncron>. There is no expectation that a typical user
	will manually start B<lonc> from the command-line. (In other words,
	DO NOT START B<lonc> YOURSELF.)

=head1 DESCRIPTION	=head1 DESCRIPTION

Provides persistent TCP connections to the other servers in the network	Provides persistent TCP connections to the other servers in the network
through multiplexed domain sockets	through multiplexed domain sockets

PID in subdir logs/lonc.pid	B<lonc> forks off children processes that correspond to the other servers
kill kills	in the network. Management of these processes can be done at the
HUP restarts	parent process level or the child process level.
USR1 tries to open connections again
	After forking off the children, B<lonc> the B<parent>
	executes a main loop which simply waits for processes to exit.
	As a process exits, a new process managing a link to the same
	peer as the exiting process is created.

	B<logs/lonc.log> is the location of log messages.

	The process management is now explained in terms of linux shell commands,
	subroutines internal to this code, and signal assignments:

	=over 4

	=item *

	PID is stored in B<logs/lonc.pid>

	This is the process id number of the parent B<lonc> process.

	=item *

	SIGTERM and SIGINT

	Parent signal assignment:
	$SIG{INT} = $SIG{TERM} = \&HUNTSMAN;

	Child signal assignment:
	$SIG{INT} = 'DEFAULT'; (and SIGTERM is DEFAULT also)
	(The child dies and a SIGALRM is sent to parent, awaking parent from slumber
	to restart a new child.)

	Command-line invocations:
	B<kill> B<-s> SIGTERM I<PID>
	B<kill> B<-s> SIGINT I<PID>

	Subroutine B<HUNTSMAN>:
	This is only invoked for the B<lonc> parent I<PID>.
	This kills all the children, and then the parent.
	The B<lonc.pid> file is cleared.

	=item *

	SIGHUP

	Current bug:
	This signal can only be processed the first time
	on the parent process. Subsequent SIGHUP signals
	have no effect.

	Parent signal assignment:
	$SIG{HUP} = \&HUPSMAN;

	Child signal assignment:
	none (nothing happens)

	Command-line invocations:
	B<kill> B<-s> SIGHUP I<PID>

	Subroutine B<HUPSMAN>:
	This is only invoked for the B<lonc> parent I<PID>,
	This kills all the children, and then the parent.
	The B<lonc.pid> file is cleared.

	=item *

	SIGUSR1

	Parent signal assignment:
	$SIG{USR1} = \&USRMAN;

	Child signal assignment:
	$SIG{USR1}= \&logstatus;

	Command-line invocations:
	B<kill> B<-s> SIGUSR1 I<PID>

	Subroutine B<USRMAN>:
	When invoked for the B<lonc> parent I<PID>,
	SIGUSR1 is sent to all the children, and the status of
	each connection is logged.

=head1 README

Not yet written.	=back

=head1 PREREQUISITES	=head1 PREREQUISITES

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

Removed from v.1.30
changed lines
	Added in v.1.34