loncom/LondConnection.pm - diff

Return to LondConnection.pm CVS log

Up to [LON-CAPA] / loncom

Diff for /loncom/LondConnection.pm between versions 1.34 and 1.57

version 1.34, 2004/09/14 11:46:29	version 1.57, 2018/08/07 17:12:09
Line 40 use LONCAPA::lonlocal;	Line 40 use LONCAPA::lonlocal;
use LONCAPA::lonssl;	use LONCAPA::lonssl;




my $DebugLevel=0;	my $DebugLevel=0;
my %hostshash;
my %perlvar;	my %perlvar;
my $LocalDns = ""; # Need not be defined for managers.	my %secureconf;
	my %badcerts;
	my %hosttypes;
	my %crlchecked;
my $InsecureOk;	my $InsecureOk;

#	#
Line 71 sub ReadConfig {	Line 71 sub ReadConfig {

my $perlvarref = read_conf('loncapa.conf');	my $perlvarref = read_conf('loncapa.conf');
%perlvar = %{$perlvarref};	%perlvar = %{$perlvarref};
my $hoststab = read_hosts(
"$perlvar{lonTabDir}/hosts.tab") \|\|
die "Can't read host table!!";
%hostshash = %{$hoststab};
$ConfigRead = 1;	$ConfigRead = 1;

my $myLonCapaName = $perlvar{lonHostID};
Debug(8, "My loncapa name is $myLonCapaName");

if(defined $hostshash{$myLonCapaName}) {
Debug(8, "My loncapa name is in hosthash");
my @ConfigLine = @{$hostshash{$myLonCapaName}};
$LocalDns = $ConfigLine[3];
Debug(8, "Got local name $LocalDns");
}
$InsecureOk = $perlvar{loncAllowInsecure};

Debug(3, "ReadConfig - LocalDNS = $LocalDns");
}

#	$InsecureOk = $perlvar{loncAllowInsecure};
# Read a foreign configuration.
# This sub is intended for the cases where the package
# will be read from outside the LonCAPA environment, in that case
# the client will need to explicitly provide:
# - A file in hosts.tab format.
# - Some idea of the 'lonCAPA' name of the local host (for building
# the encryption key).
#
# Parameters:
# MyHost - Name of this host as far as LonCAPA is concerned.
# Filename - Name of a hosts.tab formatted file that will be used
# to build up the hosts table.
#
sub ReadForeignConfig {

my ($MyHost, $Filename) = @_;

&Debug(4, "ReadForeignConfig $MyHost $Filename\n");

$perlvar{lonHostID} = $MyHost; # Rmember my host.	unless (lonssl::Read_Connect_Config(\%secureconf,\%perlvar) eq 'ok') {
my $hosttab = read_hosts($Filename) \|\|	Debug(1,"Failed to retrieve secureconf hash.\n");
die "Can't read hosts table!!";
%hostshash = %{$hosttab};
if($DebugLevel > 3) {
foreach my $host (keys %hostshash) {
print STDERR "host $host => $hostshash{$host}\n";
}
}	}
$ConfigRead = 1;	unless (lonssl::Read_Host_Types(\%hosttypes,\%perlvar) eq 'ok') {
	Debug(1,"Failed to retrieve hosttypes hash.\n");
my $myLonCapaName = $perlvar{lonHostID};

if(defined $hostshash{$myLonCapaName}) {
my @ConfigLine = @{$hostshash{$myLonCapaName}};
$LocalDns = $ConfigLine[3];
}	}
$InsecureOk = $perlvar{loncAllowInsecure};	%badcerts = ();
	%crlchecked = ();
Debug(3, "ReadForeignConfig - LocalDNS = $LocalDns");	}

	sub ResetReadConfig {
	$ConfigRead = 0;
}	}

sub Debug {	sub Debug {
Line 154 Dump the internal state of the object: F	Line 109 Dump the internal state of the object: F
sub Dump {	sub Dump {
my $self = shift;	my $self = shift;
my $level = shift;	my $level = shift;
	my $now = time;
	my $local = localtime($now);

if ($level <= $DebugLevel) {	if ($level >= $DebugLevel) {
return;	return;
}	}


my $key;	my $key;
my $value;	my $value;
print STDERR "Dumping LondConnectionObject:\n";	print STDERR "[ $local ] Dumping LondConnectionObject:\n";
	print STDERR join(':',caller(1))."\n";
while(($key, $value) = each %$self) {	while(($key, $value) = each %$self) {
print STDERR "$key -> $value\n";	print STDERR "$key -> $value\n";
}	}
Line 209 host the remote lond is on. This host is	Line 168 host the remote lond is on. This host is
=cut	=cut

sub new {	sub new {
	my ($class, $DnsName, $Port, $lonid) = @_;
my ($class, $Hostname, $Port) = @_;

if (!$ConfigRead) {	if (!$ConfigRead) {
ReadConfig();	ReadConfig();
$ConfigRead = 1;	$ConfigRead = 1;
}	}
&Debug(4,$class."::new( ".$Hostname.",".$Port.")\n");	&Debug(4,$class."::new( ".$DnsName.",".$Port.",".$lonid.")\n");

	my ($conntype,$gotconninfo,$allowinsecure);
	if ((ref($secureconf{'connto'}) eq 'HASH') &&
	(exists($hosttypes{$lonid}))) {
	$conntype = $secureconf{'connto'}{$hosttypes{$lonid}};
	if ($conntype ne '') {
	if ($conntype ne 'req') {
	$allowinsecure = 1;
	}
	$gotconninfo = 1;
	}
	}
	unless ($gotconninfo) {
	$allowinsecure = $InsecureOk;
	}

# The host must map to an entry in the hosts table:	# The host must map to an entry in the hosts table:
# We connect to the dns host that corresponds to that	# We connect to the dns host that corresponds to that
Line 224 sub new {	Line 197 sub new {
# negotion. In the objec these become the Host and	# negotion. In the objec these become the Host and
# LoncapaHim fields of the object respectively.	# LoncapaHim fields of the object respectively.
#	#
if (!exists $hostshash{$Hostname}) {	# if it is me use loopback for connection
&Debug(8, "No Such host $Hostname");	if ($DnsName eq &main::my_hostname()) { $DnsName="127.0.0.1"; }
return undef; # No such host!!!	Debug(9, "Connecting to $DnsName");
}
my @ConfigLine = @{$hostshash{$Hostname}};
my $DnsName = $ConfigLine[3]; # 4'th item is dns of host.
Debug(5, "Connecting to ".$DnsName);
# Now create the object...	# Now create the object...
my $self = { Host => $DnsName,	my $self = { Host => $DnsName,
LoncapaHim => $Hostname,	LoncapaHim => $lonid,
Port => $Port,	Port => $Port,
State => "Initialized",	State => "Initialized",
AuthenticationMode => "",	AuthenticationMode => "",
	InsecureOK => $allowinsecure,
TransactionRequest => "",	TransactionRequest => "",
TransactionReply => "",	TransactionReply => "",
	NextRequest => "",
InformReadable => 0,	InformReadable => 0,
InformWritable => 0,	InformWritable => 0,
TimeoutCallback => undef,	TimeoutCallback => undef,
Line 249 sub new {	Line 220 sub new {
LocalKeyFile => "",	LocalKeyFile => "",
CipherKey => "",	CipherKey => "",
LondVersion => "Unknown",	LondVersion => "Unknown",
Cipher => undef};	Cipher => undef,
	ClientData => undef};
bless($self, $class);	bless($self, $class);
unless ($self->{Socket} = IO::Socket::INET->new(PeerHost => $self->{Host},	unless ($self->{Socket} = IO::Socket::INET->new(PeerHost => $self->{Host},
PeerPort => $self->{Port},	PeerPort => $self->{Port},
Type => SOCK_STREAM,	Type => SOCK_STREAM,
Proto => "tcp",	Proto => "tcp",
Timeout => 3)) {	Timeout => 3)) {
	Debug(8, "Error? \n$@ \n$!");
return undef; # Inidicates the socket could not be made.	return undef; # Inidicates the socket could not be made.
}	}
my $socket = $self->{Socket}; # For local use only.	my $socket = $self->{Socket}; # For local use only.
	$socket->sockopt(SO_KEEPALIVE, 1); # Turn on keepalive probes when idle.
# If we are local, we'll first try local auth mode, otherwise, we'll try	# If we are local, we'll first try local auth mode, otherwise, we'll try
# the ssl auth mode:	# the ssl auth mode:

Debug(8, "Connecting to $DnsName I am $LocalDns");
my $key;	my $key;
my $keyfile;	my $keyfile;
if ($DnsName eq $LocalDns) {	if ($DnsName eq '127.0.0.1') {
$self->{AuthenticationMode} = "local";	$self->{AuthenticationMode} = "local";
($key, $keyfile) = lonlocal::CreateKeyFile();	($key, $keyfile) = lonlocal::CreateKeyFile();
Debug(8, "Local key: $key, stored in $keyfile");	Debug(8, "Local key: $key, stored in $keyfile");
Line 274 sub new {	Line 247 sub new {
# allowed...else give up right away.	# allowed...else give up right away.

if(!(defined $key) \|\| !(defined $keyfile)) {	if(!(defined $key) \|\| !(defined $keyfile)) {
if($InsecureOk) {	my $canconnect = 0;
	if (ref($secureconf{'connto'}) eq 'HASH') {
	unless ($secureconf{'connto'}->{'dom'} eq 'req') {
	$canconnect = 1;
	}
	} else {
	$canconnect = $InsecureOk;
	}
	if ($canconnect) {
$self->{AuthenticationMode} = "insecure";	$self->{AuthenticationMode} = "insecure";
$self->{TransactionRequest} = "init\n";	$self->{TransactionRequest} = "init\n";
}	}
Line 290 sub new {	Line 271 sub new {
return undef;	return undef;
}	}

}	} else {
else {
# Remote peer: I'd like to do ssl, but if my host key or certificates	# Remote peer: I'd like to do ssl, but if my host key or certificates
# are not all installed, my only choice is insecure, if that's	# are not all installed, my only choice is insecure, if that's
# allowed:	# allowed:

my ($ca, $cert) = lonssl::CertificateFile;	my ($ca, $cert) = lonssl::CertificateFile;
my $sslkeyfile = lonssl::KeyFile;	my $sslkeyfile = lonssl::KeyFile;
	my $badcertfile = lonssl::has_badcert_file($self->{LoncapaHim});

if((defined $ca) && (defined $cert) && (defined $sslkeyfile)) {	if (($conntype ne 'no') && (defined($ca)) && (defined($cert)) && (defined($sslkeyfile)) &&
	(!exists($badcerts{$self->{LoncapaHim}})) && !$badcertfile) {
$self->{AuthenticationMode} = "ssl";	$self->{AuthenticationMode} = "ssl";
$self->{TransactionRequest} = "init:ssl\n";	$self->{TransactionRequest} = "init:ssl:$perlvar{'lonVersion'}\n";
	} elsif ($self->{InsecureOK}) {
	# Allowed to do insecure:
	$self->{AuthenticationMode} = "insecure";
	$self->{TransactionRequest} = "init::$perlvar{'lonVersion'}\n";
} else {	} else {
if($InsecureOk) { # Allowed to do insecure:	# Not allowed to do insecure...
$self->{AuthenticationMode} = "insecure";	$socket->close;
$self->{TransactionRequest} = "init\n";	return undef;
}
else { # Not allowed to do insecure...
$socket->close;
return undef;
}
}	}
}	}

Line 326 sub new {	Line 306 sub new {
#	#
# Set socket to nonblocking I/O.	# Set socket to nonblocking I/O.
#	#
my $socket = $self->{Socket};
my $flags = fcntl($socket, F_GETFL,0);	my $flags = fcntl($socket, F_GETFL,0);
if(!$flags) {	if(!$flags) {
$socket->close;	$socket->close;
Line 402 sub Readable {	Line 381 sub Readable {
$self->Transition("Disconnected");	$self->Transition("Disconnected");
return -1;	return -1;
}	}
	# If we actually got data, reset the timeout.

	if (length $data) {
	$self->{TimeoutRemaining} = $self->{TimeoutValue}; # getting data resets the timeout period.
	}
# Append the data to the buffer. And figure out if the read is done:	# Append the data to the buffer. And figure out if the read is done:

&Debug(9,"Received from host: ".$data);	&Debug(9,"Received from host: ".$data);
Line 454 sub Readable {	Line 438 sub Readable {
}	}
elsif ($ConnectionMode eq "ssl") {	elsif ($ConnectionMode eq "ssl") {
if($Response =~ /^ok:ssl/) { # Good ssl...	if($Response =~ /^ok:ssl/) { # Good ssl...
if($self->ExchangeKeysViaSSL()) { # Success skip to vsn stuff	my $sslresult = $self->ExchangeKeysViaSSL();
	if ($sslresult == 1) { # Success skip to vsn stuff
# Need to reset to non blocking:	# Need to reset to non blocking:

my $flags = fcntl($socket, F_GETFL, 0);	my $flags = fcntl($socket, F_GETFL, 0);
fcntl($socket, F_SETFL, $flags \| O_NONBLOCK);	fcntl($socket, F_SETFL, $flags \| O_NONBLOCK);
$self->ToVersionRequest();	$self->ToVersionRequest();
return 0;	return 0;
}	}
else { # Failed in ssl exchange.	else { # Failed in ssl exchange.
	if (($sslresult == -1) && (lonssl::LastError == -1) && ($self->{InsecureOK})) {
	my $badcertdir = &lonssl::BadCertDir();
	if (($badcertdir) && $self->{LoncapaHim}) {
	if (open(my $fh,'>',"$badcertdir/".$self->{LoncapaHim})) {
	close($fh);
	}
	}
	$badcerts{$self->{LoncapaHim}} = 1;
	&Debug(3,"SSL verification failed: close socket and initiate insecure connection");
	$self->Transition("ReInitNoSSL");
	$socket->close;
	return -1;
	}
&Debug(3,"init:ssl failed key negotiation!");	&Debug(3,"init:ssl failed key negotiation!");
$self->Transition("Disconnected");	$self->Transition("Disconnected");
$socket->close;	$socket->close;
return -1;	return -1;
}	}
}	}
elsif ($Response =~ /^[0-9]+/) { # Old style lond.	elsif ($Response =~ /^[0-9]+/) { # Old style lond.
return $self->CompleteInsecure();	return $self->CompleteInsecure();
Line 501 sub Readable {	Line 499 sub Readable {
return 0;	return 0;

} elsif ($self->{State} eq "ReadingVersionString") {	} elsif ($self->{State} eq "ReadingVersionString") {
$self->{LondVersion} = chomp($self->{TransactionReply});	chomp($self->{TransactionReply});
	$self->{LondVersion} = $self->{TransactionReply};
$self->Transition("SetHost");	$self->Transition("SetHost");
$self->{InformReadable} = 0;	$self->{InformReadable} = 0;
$self->{InformWritable} = 1;	$self->{InformWritable} = 1;
Line 554 sub Readable {	Line 553 sub Readable {
$answer = $self->Decrypt($answer);	$answer = $self->Decrypt($answer);
$self->{TransactionReply} = "$answer\n";	$self->{TransactionReply} = "$answer\n";
}	}
	# if we have a NextRequest do it immeadiately
	if ($self->{NextRequest}) {
	$self->{TransactionRequest} = $self->{NextRequest};
	undef( $self->{NextRequest} );
	$self->{TransactionReply} = "";
	$self->{InformWritable} = 1;
	$self->{InformReadable} = 0;
	$self->{Timeoutable} = 1;
	$self->Transition("SendingRequest");
	return 0;
	} else {
# finish the transaction	# finish the transaction

$self->ToIdle();	$self->ToIdle();
return 0;	return 0;
	}
} elsif ($self->{State} eq "Disconnected") { # No connection.	} elsif ($self->{State} eq "Disconnected") { # No connection.
return -1;	return -1;
} else { # Internal error: Invalid state.	} else { # Internal error: Invalid state.
Line 612 sub Writable {	Line 622 sub Writable {
($errno == POSIX::EAGAIN) \|\|	($errno == POSIX::EAGAIN) \|\|
($errno == POSIX::EINTR) \|\|	($errno == POSIX::EINTR) \|\|
($errno == 0)) {	($errno == 0)) {
	$self->{TimeoutRemaining} = $self->{TimeoutValue};
substr($self->{TransactionRequest}, 0, $nwritten) = ""; # rmv written part	substr($self->{TransactionRequest}, 0, $nwritten) = ""; # rmv written part
if(length $self->{TransactionRequest} == 0) {	if(length $self->{TransactionRequest} == 0) {
$self->{InformWritable} = 0;	$self->{InformWritable} = 0;
$self->{InformReadable} = 1;	$self->{InformReadable} = 1;
$self->{TransactionReply} = '';	$self->{TransactionReply} = '';
#	#
# Figure out the next state:	# Figure out the next state:
#	#
if($self->{State} eq "Connected") {	if($self->{State} eq "Connected") {
$self->Transition("Initialized");	$self->Transition("Initialized");
} elsif($self->{State} eq "ChallengeReceived") {	} elsif($self->{State} eq "ChallengeReceived") {
$self->Transition("ChallengeReplied");	$self->Transition("ChallengeReplied");
} elsif($self->{State} eq "RequestingVersion") {	} elsif($self->{State} eq "RequestingVersion") {
$self->Transition("ReadingVersionString");	$self->Transition("ReadingVersionString");
} elsif ($self->{State} eq "SetHost") {	} elsif ($self->{State} eq "SetHost") {
$self->Transition("HostSet");	$self->Transition("HostSet");
} elsif($self->{State} eq "RequestingKey") {	} elsif($self->{State} eq "RequestingKey") {
$self->Transition("ReceivingKey");	$self->Transition("ReceivingKey");
# $self->{InformWritable} = 0;	# $self->{InformWritable} = 0;
# $self->{InformReadable} = 1;	# $self->{InformReadable} = 1;
# $self->{TransactionReply} = '';	# $self->{TransactionReply} = '';
} elsif ($self->{State} eq "SendingRequest") {	} elsif ($self->{State} eq "SendingRequest") {
$self->Transition("ReceivingReply");	$self->Transition("ReceivingReply");
$self->{TimeoutRemaining} = $self->{TimeoutValue};	$self->{TimeoutRemaining} = $self->{TimeoutValue};
} elsif ($self->{State} eq "Disconnected") {	} elsif ($self->{State} eq "Disconnected") {
return -1;	return -1;
}	}
return 0;	return 0;
}	}
} else { # The write failed (e.g. partner disconnected).	} else { # The write failed (e.g. partner disconnected).
$self->Transition("Disconnected");	$self->Transition("Disconnected");
$socket->close();	$socket->close();
return -1;	return -1;
}	}

}	}
=pod	=pod

Line 710 sub InitiateTransaction {	Line 721 sub InitiateTransaction {
return -1; # Error indicator.	return -1; # Error indicator.
}	}
# if the transaction is to be encrypted encrypt the data:	# if the transaction is to be encrypted encrypt the data:
	(my $sethost, my $server,$data)=split(/:/,$data,3);

if($data =~ /^encrypt\:/) {	if($data =~ /^encrypt\:/) {
$data = $self->Encrypt($data);	$data = $self->Encrypt($data);
}	}

# Setup the trasaction	# Setup the trasaction
	# currently no version of lond supports inlining the sethost
$self->{TransactionRequest} = $data;	if ($self->PeerVersion() <= 321) {
	if ($server ne $self->{LoncapaHim}) {
	$self->{NextRequest} = $data;
	$self->{TransactionRequest} = "$sethost:$server\n";
	$self->{LoncapaHim} = $server;
	} else {
	$self->{TransactionRequest} = $data;
	}
	} else {
	$self->{LoncapaHim} = $server;
	$self->{TransactionRequest} = "$sethost:$server:$data";
	}
$self->{TransactionReply} = "";	$self->{TransactionReply} = "";
$self->{InformWritable} = 1;	$self->{InformWritable} = 1;
$self->{InformReadable} = 0;	$self->{InformReadable} = 0;
Line 781 sub Shutdown {	Line 804 sub Shutdown {
$socket->shutdown(2);	$socket->shutdown(2);
}	}
}	}
	$self->{Timeoutable} = 0; # Shutdown sockets can't timeout.
}	}

=pod	=pod
Line 1031 sub CreateCipher {	Line 1055 sub CreateCipher {
sub ExchangeKeysViaSSL {	sub ExchangeKeysViaSSL {
my $self = shift;	my $self = shift;
my $socket = $self->{Socket};	my $socket = $self->{Socket};
	my $peer = $self->{LoncapaHim};

# Get our signed certificate, the certificate authority's	# Get our signed certificate, the certificate authority's
# certificate and our private key file. All of these	# certificate and our private key file. All of these
Line 1039 sub ExchangeKeysViaSSL {	Line 1064 sub ExchangeKeysViaSSL {
my ($SSLCACertificate,	my ($SSLCACertificate,
$SSLCertificate) = lonssl::CertificateFile();	$SSLCertificate) = lonssl::CertificateFile();
my $SSLKey = lonssl::KeyFile();	my $SSLKey = lonssl::KeyFile();
	my $CRLFile;
	unless ($crlchecked{$peer}) {
	$CRLFile = lonssl::CRLFile();
	$crlchecked{$peer} = 1;
	}
# Promote our connection to ssl and read the key from lond.	# Promote our connection to ssl and read the key from lond.

my $SSLSocket = lonssl::PromoteClientSocket($socket,	my $SSLSocket = lonssl::PromoteClientSocket($socket,
$SSLCACertificate,	$SSLCACertificate,
$SSLCertificate,	$SSLCertificate,
$SSLKey);	$SSLKey,
	$peer,
	$CRLFile);
if(defined $SSLSocket) {	if(defined $SSLSocket) {
my $key = <$SSLSocket>;	my $key = <$SSLSocket>;
lonssl::Close($SSLSocket);	lonssl::Close($SSLSocket);
Line 1061 sub ExchangeKeysViaSSL {	Line 1092 sub ExchangeKeysViaSSL {
else {	else {
# Failed!!	# Failed!!
Debug(3, "Failed to negotiate SSL connection!");	Debug(3, "Failed to negotiate SSL connection!");
return 0;	return -1;
}	}
# should not get here	# should not get here
return 0;	return 0;
Line 1086 sub ExchangeKeysViaSSL {	Line 1117 sub ExchangeKeysViaSSL {
#	#
sub CompleteInsecure {	sub CompleteInsecure {
my $self = shift;	my $self = shift;
if($InsecureOk) {	if ($self->{InsecureOK}) {
$self->{AuthenticationMode} = "insecure";	$self->{AuthenticationMode} = "insecure";
&Debug(8," Transition out of Initialized:insecure");	&Debug(8," Transition out of Initialized:insecure");
$self->{TransactionRequest} = $self->{TransactionReply};	$self->{TransactionRequest} = $self->{TransactionReply};
Line 1106 sub CompleteInsecure {	Line 1137 sub CompleteInsecure {
}	}
}	}

=pod

=head2 GetHostIterator

Returns a hash iterator to the host information. Each get from
this iterator returns a reference to an array that contains
information read from the hosts configuration file. Array elements
are used as follows:

[0] - LonCapa host name.
[1] - LonCapa domain name.
[2] - Loncapa role (e.g. library or access).
[3] - DNS name server hostname.
[4] - IP address (result of e.g. nslookup [3]).
[5] - Maximum connection count.
[6] - Idle timeout for reducing connection count.
[7] - Minimum connection count.

=cut

sub GetHostIterator {

return HashIterator->new(\%hostshash);
}

###########################################################	###########################################################
#	#
# The following is an unashamed kludge that is here to	# The following is an unashamed kludge that is here to
Line 1142 sub GetHostIterator {	Line 1148 sub GetHostIterator {
#	#


my $confdir='/etc/httpd/conf/';	my @confdirs=('/etc/httpd/conf/','/etc/apache2/');

# ------------------- Subroutine read_conf: read LON-CAPA server configuration.	# ------------------- Subroutine read_conf: read LON-CAPA server configuration.
# This subroutine reads PerlSetVar values out of specified web server	# This subroutine reads PerlSetVar values out of specified web server
Line 1150 my $confdir='/etc/httpd/conf/';	Line 1156 my $confdir='/etc/httpd/conf/';
sub read_conf	sub read_conf
{	{
my (@conf_files)=@_;	my (@conf_files)=@_;
my %perlvar;	my (%perlvar,%configdirs);
foreach my $filename (@conf_files,'loncapa_apache.conf')	foreach my $filename (@conf_files,'loncapa_apache.conf') {
{	my $configdir = '';
if($DebugLevel > 3) {	$configdirs{$filename} = [@confdirs];
print STDERR ("Going to read $confdir.$filename\n");	while ($configdir eq '' && @{$configdirs{$filename}} > 0) {
}	my $testdir = shift(@{$configdirs{$filename}});
open(CONFIG,'<'.$confdir.$filename) or	if (-e $testdir.$filename) {
die("Can't read $confdir$filename");	$configdir = $testdir;
while (my $configline=<CONFIG>)	}
{	}
if ($configline =~ /^[^\#]*PerlSetVar/)	if ($configdir eq '') {
{	die("Couldn't find a directory containing $filename");
my ($unused,$varname,$varvalue)=split(/\s+/,$configline);	}
	if($DebugLevel > 3) {
	print STDERR ("Going to read $configdir.$filename\n");
	}
	open(CONFIG,'<'.$configdir.$filename) or
	die("Can't read $configdir$filename");
	while (my $configline=<CONFIG>) {
	if ($configline =~ /^[^\#]*PerlSetVar/) {
	my ($unused,$varname,$varvalue)=split(/\s+/,$configline);
chomp($varvalue);	chomp($varvalue);
$perlvar{$varname}=$varvalue;	$perlvar{$varname}=$varvalue;
}	}
}	}
close(CONFIG);	close(CONFIG);
}	}
if($DebugLevel > 3) {	if($DebugLevel > 3) {
print STDERR "Dumping perlvar:\n";	print STDERR "Dumping perlvar:\n";
foreach my $var (keys %perlvar) {	foreach my $var (keys %perlvar) {
Line 1179 sub read_conf	Line 1193 sub read_conf
return $perlvarref;	return $perlvarref;
}	}

#---------------------- Subroutine read_hosts: Read a LON-CAPA hosts.tab
# formatted configuration file.
#
my $RequiredCount = 5; # Required item count in hosts.tab.
my $DefaultMaxCon = 5; # Default value for maximum connections.
my $DefaultIdle = 1000; # Default connection idle time in seconds.
my $DefaultMinCon = 0; # Default value for minimum connections.

sub read_hosts {
my $Filename = shift;
my %HostsTab;

open(CONFIG,'<'.$Filename) or die("Can't read $Filename");
while (my $line = <CONFIG>) {
if (!($line =~ /^\s*\#/)) {
my @items = split(/:/, $line);
if(scalar @items >= $RequiredCount) {
if (scalar @items == $RequiredCount) { # Only required items:
$items[$RequiredCount] = $DefaultMaxCon;
}
if(scalar @items == $RequiredCount + 1) { # up through maxcon.
$items[$RequiredCount+1] = $DefaultIdle;
}
if(scalar @items == $RequiredCount + 2) { # up through idle.
$items[$RequiredCount+2] = $DefaultMinCon;
}
{
my @list = @items; # probably not needed but I'm unsure of
# about the scope of item so...
$HostsTab{$list[0]} = \@list;
}
}
}
}
close(CONFIG);
my $hostref = \%HostsTab;
return ($hostref);
}
#	#
# Get the version of our peer. Note that this is only well	# Get the version of our peer. Note that this is only well
# defined if the state machine has hit the idle state at least	# defined if the state machine has hit the idle state at least
Line 1225 sub read_hosts {	Line 1201 sub read_hosts {
#	#
sub PeerVersion {	sub PeerVersion {
my $self = shift;	my $self = shift;
	my ($version) = ($self->{LondVersion} =~ /Revision: 1\.(\d+)/);
return $self->{LondVersion};	return $version;
	}

	#
	# Manipulate the client data field
	#
	sub SetClientData {
	my ($self, $newData) = @_;
	$self->{ClientData} = $newData;
	}
	#
	# Get the current client data field.
	#
	sub GetClientData {
	my $self = shift;
	return $self->{ClientData};
	}

	#
	# Get the HostID of our peer
	#

	sub PeerLoncapaHim {
	my $self = shift;
	return $self->{LoncapaHim};
	}

	#
	# Get the Authentication mode
	#

	sub GetKeyMode {
	my $self = shift;
	return $self->{AuthenticationMode};
}	}

1;	1;
Line 1422 true if the current state requires a wri	Line 1431 true if the current state requires a wri

true if the current state requires timeout support.	true if the current state requires timeout support.

=item GetHostIterator:

Returns an iterator into the host file hash.

=cut	=cut

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

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