--- loncom/LondConnection.pm 2005/05/27 21:49:18 1.37 +++ loncom/LondConnection.pm 2007/03/28 20:28:29 1.44 @@ -1,7 +1,7 @@ # This module defines and implements a class that represents # a connection to a lond daemon. # -# $Id: LondConnection.pm,v 1.37 2005/05/27 21:49:18 albertel Exp $ +# $Id: LondConnection.pm,v 1.44 2007/03/28 20:28:29 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -43,9 +43,7 @@ use LONCAPA::lonssl; my $DebugLevel=0; -my %hostshash; my %perlvar; -my $LocalDns = ""; # Need not be defined for managers. my $InsecureOk; # @@ -71,67 +69,9 @@ sub ReadConfig { my $perlvarref = read_conf('loncapa.conf'); %perlvar = %{$perlvarref}; - my $hoststab = read_hosts( - "$perlvar{lonTabDir}/hosts.tab") || - die "Can't read host table!!"; - %hostshash = %{$hoststab}; $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"); -} - -# -# 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. - my $hosttab = read_hosts($Filename) || - 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; - - my $myLonCapaName = $perlvar{lonHostID}; - - if(defined $hostshash{$myLonCapaName}) { - my @ConfigLine = @{$hostshash{$myLonCapaName}}; - $LocalDns = $ConfigLine[3]; - } - $InsecureOk = $perlvar{loncAllowInsecure}; - - Debug(3, "ReadForeignConfig - LocalDNS = $LocalDns"); - } sub Debug { @@ -213,14 +153,13 @@ host the remote lond is on. This host is =cut sub new { - - my ($class, $Hostname, $Port) = @_; + my ($class, $DnsName, $Port, $lonid) = @_; if (!$ConfigRead) { ReadConfig(); $ConfigRead = 1; } - &Debug(4,$class."::new( ".$Hostname.",".$Port.")\n"); + &Debug(4,$class."::new( ".$DnsName.",".$Port.")\n"); # The host must map to an entry in the hosts table: # We connect to the dns host that corresponds to that @@ -228,30 +167,24 @@ sub new { # negotion. In the objec these become the Host and # LoncapaHim fields of the object respectively. # - if (!exists $hostshash{$Hostname}) { - &Debug(8, "No Such host $Hostname"); - return undef; # No such host!!! - } - my @ConfigLine = @{$hostshash{$Hostname}}; - my $DnsName = $ConfigLine[3]; # 4'th item is dns of host. - Debug(5, "Connecting to ".$DnsName); # if it is me use loopback for connection - if ($DnsName eq $LocalDns) { $DnsName="127.0.0.1"; } - Debug(8, "Connecting to $DnsName I am $LocalDns"); + if ($DnsName eq &main::my_hostname()) { $DnsName="127.0.0.1"; } + Debug(9, "Connecting to $DnsName"); # Now create the object... my $self = { Host => $DnsName, - LoncapaHim => $Hostname, + LoncapaHim => $lonid, Port => $Port, State => "Initialized", AuthenticationMode => "", TransactionRequest => "", TransactionReply => "", + NextRequest => "", InformReadable => 0, InformWritable => 0, TimeoutCallback => undef, TransitionCallback => undef, Timeoutable => 0, - TimeoutValue => 30, + TimeoutValue => 3, TimeoutRemaining => 0, LocalKeyFile => "", CipherKey => "", @@ -297,8 +230,7 @@ sub new { return undef; } - } - else { + } else { # 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 # allowed: @@ -333,7 +265,6 @@ sub new { # # Set socket to nonblocking I/O. # - my $socket = $self->{Socket}; my $flags = fcntl($socket, F_GETFL,0); if(!$flags) { $socket->close; @@ -508,7 +439,8 @@ sub Readable { return 0; } elsif ($self->{State} eq "ReadingVersionString") { - $self->{LondVersion} = chomp($self->{TransactionReply}); + chomp($self->{TransactionReply}); + $self->{LondVersion} = $self->{TransactionReply}; $self->Transition("SetHost"); $self->{InformReadable} = 0; $self->{InformWritable} = 1; @@ -561,11 +493,23 @@ sub Readable { $answer = $self->Decrypt($answer); $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->{TimeoutRemaining} = $self->{TimeoutValue}; + $self->Transition("SendingRequest"); + return 0; + } else { # finish the transaction - $self->ToIdle(); - return 0; + $self->ToIdle(); + return 0; + } } elsif ($self->{State} eq "Disconnected") { # No connection. return -1; } else { # Internal error: Invalid state. @@ -717,14 +661,26 @@ sub InitiateTransaction { return -1; # Error indicator. } # if the transaction is to be encrypted encrypt the data: + (my $sethost, my $server,$data)=split(/:/,$data,3); if($data =~ /^encrypt\:/) { $data = $self->Encrypt($data); } # Setup the trasaction - - $self->{TransactionRequest} = $data; + # currently no version of lond supports inlining the sethost + 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->{InformWritable} = 1; $self->{InformReadable} = 0; @@ -1113,31 +1069,6 @@ 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 @@ -1149,7 +1080,7 @@ sub GetHostIterator { # -my $confdir='/etc/httpd/conf/'; +my @confdirs=('/etc/httpd/conf/','/etc/apache2/'); # ------------------- Subroutine read_conf: read LON-CAPA server configuration. # This subroutine reads PerlSetVar values out of specified web server @@ -1157,25 +1088,33 @@ my $confdir='/etc/httpd/conf/'; sub read_conf { my (@conf_files)=@_; - my %perlvar; - foreach my $filename (@conf_files,'loncapa_apache.conf') - { - if($DebugLevel > 3) { - print STDERR ("Going to read $confdir.$filename\n"); - } - open(CONFIG,'<'.$confdir.$filename) or - die("Can't read $confdir$filename"); - while (my $configline=) - { - if ($configline =~ /^[^\#]*PerlSetVar/) - { - my ($unused,$varname,$varvalue)=split(/\s+/,$configline); + my (%perlvar,%configdirs); + foreach my $filename (@conf_files,'loncapa_apache.conf') { + my $configdir = ''; + $configdirs{$filename} = [@confdirs]; + while ($configdir eq '' && @{$configdirs{$filename}} > 0) { + my $testdir = shift(@{$configdirs{$filename}}); + if (-e $testdir.$filename) { + $configdir = $testdir; + } + } + if ($configdir eq '') { + die("Couldn't find a directory containing $filename"); + } + 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=) { + if ($configline =~ /^[^\#]*PerlSetVar/) { + my ($unused,$varname,$varvalue)=split(/\s+/,$configline); chomp($varvalue); $perlvar{$varname}=$varvalue; - } - } + } + } close(CONFIG); - } + } if($DebugLevel > 3) { print STDERR "Dumping perlvar:\n"; foreach my $var (keys %perlvar) { @@ -1186,45 +1125,6 @@ sub read_conf return $perlvarref; } -#---------------------- Subroutine read_hosts: Read a LON-CAPA hosts.tab -# formatted configuration file. -# -my $RequiredCount = 4; # 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 = ) { - if ($line !~ /^\s*\#/) { - $line=~s/\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 # defined if the state machine has hit the idle state at least @@ -1233,8 +1133,8 @@ sub read_hosts { # sub PeerVersion { my $self = shift; - - return $self->{LondVersion}; + my ($version) = ($self->{LondVersion} =~ /Revision: 1\.(\d+)/); + return $version; } 1; @@ -1430,8 +1330,4 @@ true if the current state requires a wri true if the current state requires timeout support. -=item GetHostIterator: - -Returns an iterator into the host file hash. - =cut 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.