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.62

version 1.34, 2004/09/14 11:46:29	version 1.62, 2018/12/14 02:05:38
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 206 host the remote lond is on. This host is	Line 165 host the remote lond is on. This host is

port number the remote lond is listening on.	port number the remote lond is listening on.

	=item lonid

	lonid of the remote lond is listening on.

	=item deflonid

	default lonhostID of the remote lond is listening on.

=cut	=cut

sub new {	sub new {
	my ($class, $DnsName, $Port, $lonid, $deflonid, $loncaparev) = @_;
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.",".$deflonid.",".$loncaparev.")\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 205 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,
	LoncapaDefid => $deflonid,
	LoncapaRev => $loncaparev,
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 230 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 257 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 281 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});
	my ($loncaparev) = ($perlvar{'lonVersion'} =~ /^[\'\"]?([\w.\-]+)[\'\"]?$/);

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:$loncaparev\n";
	} elsif ($self->{InsecureOK}) {
	# Allowed to do insecure:
	$self->{AuthenticationMode} = "insecure";
	$self->{TransactionRequest} = "init::$loncaparev\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 317 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 392 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 449 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 510 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 531 sub Readable {	Line 541 sub Readable {
}	}
} elsif ($self->{State} eq "ReceivingKey") {	} elsif ($self->{State} eq "ReceivingKey") {
my $buildkey = $self->{TransactionReply};	my $buildkey = $self->{TransactionReply};
	chomp($buildkey);
my $key = $self->{LoncapaHim}.$perlvar{'lonHostID'};	my $key = $self->{LoncapaHim}.$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/;
Line 554 sub Readable {	Line 565 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 634 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 733 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 816 sub Shutdown {
$socket->shutdown(2);	$socket->shutdown(2);
}	}
}	}
	$self->{Timeoutable} = 0; # Shutdown sockets can't timeout.
}	}

=pod	=pod
Line 1031 sub CreateCipher {	Line 1067 sub CreateCipher {
sub ExchangeKeysViaSSL {	sub ExchangeKeysViaSSL {
my $self = shift;	my $self = shift;
my $socket = $self->{Socket};	my $socket = $self->{Socket};
	my $peer = $self->{LoncapaHim};
	my $peerdef = $self->{LoncapaDefid};
	my $loncaparev = $self->{LoncapaRev};

# 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 1078 sub ExchangeKeysViaSSL {
my ($SSLCACertificate,	my ($SSLCACertificate,
$SSLCertificate) = lonssl::CertificateFile();	$SSLCertificate) = lonssl::CertificateFile();
my $SSLKey = lonssl::KeyFile();	my $SSLKey = lonssl::KeyFile();
	my $CRLFile;
	unless ($crlchecked{$peerdef}) {
	$CRLFile = lonssl::CRLFile();
	$crlchecked{$peerdef} = 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,
	$peerdef,
	$CRLFile,
	$loncaparev);
if(defined $SSLSocket) {	if(defined $SSLSocket) {
my $key = <$SSLSocket>;	my $key = <$SSLSocket>;
lonssl::Close($SSLSocket);	lonssl::Close($SSLSocket);
Line 1061 sub ExchangeKeysViaSSL {	Line 1108 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 1133 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 1153 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 1164 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 1172 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 1209 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 1217 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 1447 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.62