version 1.39, 2006/01/27 20:37:12
|
version 1.43, 2006/09/15 20:49:24
|
Line 297 sub new {
|
Line 297 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: |
Line 333 sub new {
|
Line 332 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 738 sub InitiateTransaction {
|
Line 736 sub InitiateTransaction {
|
|
|
# Setup the trasaction |
# Setup the trasaction |
# currently no version of lond supports inlining the sethost |
# currently no version of lond supports inlining the sethost |
if ($self->PeerVersion() <= 10000000) { |
if ($self->PeerVersion() <= 321) { |
if ($server ne $self->{LoncapaHim}) { |
if ($server ne $self->{LoncapaHim}) { |
$self->{NextRequest} = $data; |
$self->{NextRequest} = $data; |
$self->{TransactionRequest} = "$sethost:$server\n"; |
$self->{TransactionRequest} = "$sethost:$server\n"; |
Line 747 sub InitiateTransaction {
|
Line 745 sub InitiateTransaction {
|
$self->{TransactionRequest} = $data; |
$self->{TransactionRequest} = $data; |
} |
} |
} else { |
} else { |
|
$self->{LoncapaHim} = $server; |
$self->{TransactionRequest} = "$sethost:$server:$data"; |
$self->{TransactionRequest} = "$sethost:$server:$data"; |
} |
} |
$self->{TransactionReply} = ""; |
$self->{TransactionReply} = ""; |
Line 1146 this iterator returns a reference to an
|
Line 1145 this iterator returns a reference to an
|
information read from the hosts configuration file. Array elements |
information read from the hosts configuration file. Array elements |
are used as follows: |
are used as follows: |
|
|
[0] - LonCapa host name. |
[0] - LonCapa host id. |
[1] - LonCapa domain name. |
[1] - LonCapa domain name. |
[2] - Loncapa role (e.g. library or access). |
[2] - Loncapa role (e.g. library or access). |
[3] - DNS name server hostname. |
[3] - DNS name server hostname. |
Line 1173 sub GetHostIterator {
|
Line 1172 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 1181 my $confdir='/etc/httpd/conf/';
|
Line 1180 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 1257 sub read_hosts {
|
Line 1264 sub read_hosts {
|
# |
# |
sub PeerVersion { |
sub PeerVersion { |
my $self = shift; |
my $self = shift; |
my ($version) = ($self->{LondVersion} =~ /Revision 1\.(\d+)/); |
my ($version) = ($self->{LondVersion} =~ /Revision: 1\.(\d+)/); |
return $self->{LondVersion}; |
return $version; |
} |
} |
|
|
1; |
1; |