--- loncom/LondConnection.pm 2006/03/03 20:06:22 1.40 +++ loncom/LondConnection.pm 2017/02/28 05:42:06 1.54 @@ -1,7 +1,7 @@ # This module defines and implements a class that represents # a connection to a lond daemon. # -# $Id: LondConnection.pm,v 1.40 2006/03/03 20:06:22 albertel Exp $ +# $Id: LondConnection.pm,v 1.54 2017/02/28 05:42:06 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -40,12 +40,10 @@ use LONCAPA::lonlocal; use LONCAPA::lonssl; - - my $DebugLevel=0; -my %hostshash; my %perlvar; -my $LocalDns = ""; # Need not be defined for managers. +my %secureconf; +my %hosttypes; my $InsecureOk; # @@ -71,67 +69,20 @@ 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"); + $InsecureOk = $perlvar{loncAllowInsecure}; - $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"; - } + unless (lonssl::Read_Connect_Config(\%secureconf,\%perlvar) eq 'ok') { + Debug(1,"Failed to retrieve secureconf hash.\n"); } - $ConfigRead = 1; - - my $myLonCapaName = $perlvar{lonHostID}; - - if(defined $hostshash{$myLonCapaName}) { - my @ConfigLine = @{$hostshash{$myLonCapaName}}; - $LocalDns = $ConfigLine[3]; + unless (lonssl::Read_Host_Types(\%hosttypes,\%perlvar) eq 'ok') { + Debug(1,"Failed to retrieve hosttypes hash.\n"); } - $InsecureOk = $perlvar{loncAllowInsecure}; - - Debug(3, "ReadForeignConfig - LocalDNS = $LocalDns"); +} +sub ResetReadConfig { + $ConfigRead = 0; } sub Debug { @@ -213,13 +164,13 @@ host the remote lond is on. This host is =cut sub new { - my ($class, $DnsName, $Port) = @_; + my ($class, $DnsName, $Port, $lonid) = @_; if (!$ConfigRead) { ReadConfig(); $ConfigRead = 1; } - &Debug(4,$class."::new( ".$DnsName.",".$Port.")\n"); + &Debug(4,$class."::new( ".$DnsName.",".$Port.",".$lonid.")\n"); # The host must map to an entry in the hosts table: # We connect to the dns host that corresponds to that @@ -227,19 +178,12 @@ sub new { # negotion. In the objec these become the Host and # LoncapaHim fields of the object respectively. # - if (!exists $hostshash{$DnsName}) { - &Debug(8, "No Such host $DnsName"); - return undef; # No such host!!! - } - my @ConfigLine = @{$hostshash{$DnsName}}; - my $Hostname = $ConfigLine[0]; # 0'th item is the msu id 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 => "", @@ -256,7 +200,8 @@ sub new { LocalKeyFile => "", CipherKey => "", LondVersion => "Unknown", - Cipher => undef}; + Cipher => undef, + ClientData => undef}; bless($self, $class); unless ($self->{Socket} = IO::Socket::INET->new(PeerHost => $self->{Host}, PeerPort => $self->{Port}, @@ -267,6 +212,7 @@ sub new { return undef; # Inidicates the socket could not be made. } 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 # the ssl auth mode: @@ -281,7 +227,15 @@ sub new { # allowed...else give up right away. 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->{TransactionRequest} = "init\n"; } @@ -297,8 +251,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: @@ -306,19 +259,25 @@ sub new { my ($ca, $cert) = lonssl::CertificateFile; my $sslkeyfile = lonssl::KeyFile; - if((defined $ca) && (defined $cert) && (defined $sslkeyfile)) { - + my ($conntype,$gotconninfo); + if ((ref($secureconf{'connto'}) eq 'HASH') && + (exists($hosttypes{$lonid}))) { + $conntype = $secureconf{'connto'}{$hosttypes{$lonid}}; + if ($conntype ne '') { + $gotconninfo = 1; + } + } + if (($conntype ne 'no') && (defined($ca)) && (defined($cert)) && (defined($sslkeyfile))) { $self->{AuthenticationMode} = "ssl"; - $self->{TransactionRequest} = "init:ssl\n"; + $self->{TransactionRequest} = "init:ssl:$perlvar{'lonVersion'}\n"; + } elsif (($gotconninfo && $conntype ne 'req') || (!$gotconninfo && $InsecureOk)) { + # Allowed to do insecure: + $self->{AuthenticationMode} = "insecure"; + $self->{TransactionRequest} = "init::$perlvar{'lonVersion'}\n"; } else { - if($InsecureOk) { # Allowed to do insecure: - $self->{AuthenticationMode} = "insecure"; - $self->{TransactionRequest} = "init\n"; - } - else { # Not allowed to do insecure... - $socket->close; - return undef; - } + # Not allowed to do insecure... + $socket->close; + return undef; } } @@ -333,7 +292,6 @@ sub new { # # Set socket to nonblocking I/O. # - my $socket = $self->{Socket}; my $flags = fcntl($socket, F_GETFL,0); if(!$flags) { $socket->close; @@ -409,6 +367,11 @@ sub Readable { $self->Transition("Disconnected"); 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: &Debug(9,"Received from host: ".$data); @@ -570,7 +533,6 @@ sub Readable { $self->{InformWritable} = 1; $self->{InformReadable} = 0; $self->{Timeoutable} = 1; - $self->{TimeoutRemaining} = $self->{TimeoutValue}; $self->Transition("SendingRequest"); return 0; } else { @@ -632,41 +594,42 @@ sub Writable { ($errno == POSIX::EAGAIN) || ($errno == POSIX::EINTR) || ($errno == 0)) { + $self->{TimeoutRemaining} = $self->{TimeoutValue}; substr($self->{TransactionRequest}, 0, $nwritten) = ""; # rmv written part - if(length $self->{TransactionRequest} == 0) { - $self->{InformWritable} = 0; - $self->{InformReadable} = 1; - $self->{TransactionReply} = ''; - # - # Figure out the next state: - # - if($self->{State} eq "Connected") { - $self->Transition("Initialized"); - } elsif($self->{State} eq "ChallengeReceived") { - $self->Transition("ChallengeReplied"); - } elsif($self->{State} eq "RequestingVersion") { - $self->Transition("ReadingVersionString"); - } elsif ($self->{State} eq "SetHost") { - $self->Transition("HostSet"); - } elsif($self->{State} eq "RequestingKey") { - $self->Transition("ReceivingKey"); + if(length $self->{TransactionRequest} == 0) { + $self->{InformWritable} = 0; + $self->{InformReadable} = 1; + $self->{TransactionReply} = ''; + # + # Figure out the next state: + # + if($self->{State} eq "Connected") { + $self->Transition("Initialized"); + } elsif($self->{State} eq "ChallengeReceived") { + $self->Transition("ChallengeReplied"); + } elsif($self->{State} eq "RequestingVersion") { + $self->Transition("ReadingVersionString"); + } elsif ($self->{State} eq "SetHost") { + $self->Transition("HostSet"); + } elsif($self->{State} eq "RequestingKey") { + $self->Transition("ReceivingKey"); # $self->{InformWritable} = 0; # $self->{InformReadable} = 1; # $self->{TransactionReply} = ''; - } elsif ($self->{State} eq "SendingRequest") { - $self->Transition("ReceivingReply"); - $self->{TimeoutRemaining} = $self->{TimeoutValue}; - } elsif ($self->{State} eq "Disconnected") { - return -1; - } - return 0; - } - } else { # The write failed (e.g. partner disconnected). - $self->Transition("Disconnected"); - $socket->close(); - return -1; - } - + } elsif ($self->{State} eq "SendingRequest") { + $self->Transition("ReceivingReply"); + $self->{TimeoutRemaining} = $self->{TimeoutValue}; + } elsif ($self->{State} eq "Disconnected") { + return -1; + } + return 0; + } + } else { # The write failed (e.g. partner disconnected). + $self->Transition("Disconnected"); + $socket->close(); + return -1; + } + } =pod @@ -813,6 +776,7 @@ sub Shutdown { $socket->shutdown(2); } } + $self->{Timeoutable} = 0; # Shutdown sockets can't timeout. } =pod @@ -1118,7 +1082,16 @@ sub ExchangeKeysViaSSL { # sub CompleteInsecure { my $self = shift; - if($InsecureOk) { + $self->{LoncapaHim}; + my ($conntype,$gotconninfo); + if ((ref($secureconf{'connto'}) eq 'HASH') && + (exists($hosttypes{$self->{LoncapaHim}}))) { + $conntype = $secureconf{'connto'}{$hosttypes{$self->{LoncapaHim}}}; + if ($conntype ne '') { + $gotconninfo = 1; + } + } + if ((($gotconninfo) && ($conntype ne 'req')) || (!$gotconninfo && $InsecureOk)) { $self->{AuthenticationMode} = "insecure"; &Debug(8," Transition out of Initialized:insecure"); $self->{TransactionRequest} = $self->{TransactionReply}; @@ -1138,31 +1111,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 @@ -1174,7 +1122,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 @@ -1182,25 +1130,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) { @@ -1211,45 +1167,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[3]} = \@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 @@ -1262,6 +1179,21 @@ sub PeerVersion { 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}; +} + 1; =pod @@ -1455,8 +1387,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.