loncom/lonc - diff

Return to lonc CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/Attic/lonc between versions 1.42 and 1.49

version 1.42, 2002/09/09 14:04:02	version 1.49, 2003/03/27 23:00:28
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
# 5/11/2002 Scott Harrison

use lib '/home/httpd/lib/perl/';	use lib '/home/httpd/lib/perl/';
use LONCAPA::Configuration;	use LONCAPA::Configuration;
Line 68 $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");
Line 259 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 329 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 369 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 704 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 977 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 1037 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.42
changed lines
	Added in v.1.49