version 1.1, 2003/04/18 02:39:57
|
version 1.22, 2004/01/05 09:30:10
|
Line 1
|
Line 1
|
# |
|
# This module defines and implements a class that represents |
# This module defines and implements a class that represents |
# a connection to a lond daemon. |
# a connection to a lond daemon. |
|
# |
|
# $Id$ |
|
# |
|
# Copyright Michigan State University Board of Trustees |
|
# |
|
# This file is part of the LearningOnline Network with CAPA (LON-CAPA). |
|
# |
|
# LON-CAPA is free software; you can redistribute it and/or modify |
|
# it under the terms of the GNU General Public License as published by |
|
# the Free Software Foundation; either version 2 of the License, or |
|
# (at your option) any later version. |
|
# |
|
# LON-CAPA is distributed in the hope that it will be useful, |
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
# GNU General Public License for more details. |
|
# |
|
# You should have received a copy of the GNU General Public License |
|
# along with LON-CAPA; if not, write to the Free Software |
|
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
|
# |
|
# /home/httpd/html/adm/gpl.txt |
|
# |
|
# http://www.lon-capa.org/ |
|
# |
|
|
package LondConnection; |
package LondConnection; |
|
|
|
use strict; |
use IO::Socket; |
use IO::Socket; |
use IO::Socket::INET; |
use IO::Socket::INET; |
use IO::Handle; |
use IO::Handle; |
Line 10 use IO::File;
|
Line 36 use IO::File;
|
use Fcntl; |
use Fcntl; |
use POSIX; |
use POSIX; |
use Crypt::IDEA; |
use Crypt::IDEA; |
use LONCAPA::Configuration; |
|
use LONCAPA::HashIterator; |
|
|
|
my $DebugLevel=4; |
|
|
|
|
|
|
|
|
my $DebugLevel=0; |
|
my %hostshash; |
|
my %perlvar; |
|
|
|
# |
|
# Set debugging level |
|
# |
|
sub SetDebug { |
|
$DebugLevel = shift; |
|
} |
|
|
|
# |
|
# The config read is done in this way to support the read of |
|
# the non-default configuration file in the |
|
# event we are being used outside of loncapa. |
|
# |
|
|
|
my $ConfigRead = 0; |
|
|
# Read the configuration file for apache to get the perl |
# Read the configuration file for apache to get the perl |
# variable set. |
# variable set. |
|
|
my $perlvarref = LONCAPA::Configuration::read_conf('loncapa.conf'); |
sub ReadConfig { |
my %perlvar = %{$perlvarref}; |
my $perlvarref = read_conf('loncapa.conf'); |
my $hoststab = |
%perlvar = %{$perlvarref}; |
LONCAPA::Configuration::read_hosts( |
my $hoststab = read_hosts( |
"$perlvar{'lonTabDir'}/hosts.tab") || |
"$perlvar{lonTabDir}/hosts.tab") || |
die "Can't read host table!!"; |
die "Can't read host table!!"; |
my %hostshash = %{$hoststab}; |
%hostshash = %{$hoststab}; |
|
$ConfigRead = 1; |
|
|
|
} |
|
|
close(CONFIG); |
# |
|
# 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 = shift; |
|
my $Filename = shift; |
|
|
|
&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 "host $host => $hostshash{$host}\n"; |
|
} |
|
} |
|
$ConfigRead = 1; |
|
|
|
} |
|
|
sub Debug { |
sub Debug { |
my $level = shift; |
my $level = shift; |
Line 35 sub Debug {
|
Line 114 sub Debug {
|
print($message."\n"); |
print($message."\n"); |
} |
} |
} |
} |
=pod |
|
Dump the internal state of the object: For debugging purposes. |
=pod |
|
|
|
=head2 Dump |
|
|
|
Dump the internal state of the object: For debugging purposes, to stderr. |
|
|
=cut |
=cut |
|
|
sub Dump { |
sub Dump { |
my $self = shift; |
my $self = shift; |
print "Dumping LondConnectionObject:\n"; |
my $key; |
|
my $value; |
|
print STDERR "Dumping LondConnectionObject:\n"; |
while(($key, $value) = each %$self) { |
while(($key, $value) = each %$self) { |
print "$key -> $value\n"; |
print STDERR "$key -> $value\n"; |
} |
} |
print "-------------------------------\n"; |
print "-------------------------------\n"; |
} |
} |
|
|
=pod |
=pod |
Local function to do a state transition. If the state transition callback |
|
is defined it is called with two parameters: the self and the old state. |
Local function to do a state transition. If the state transition |
|
callback is defined it is called with two parameters: the self and the |
|
old state. |
|
|
=cut |
=cut |
|
|
sub Transition { |
sub Transition { |
my $self = shift; |
my $self = shift; |
my $newstate = shift; |
my $newstate = shift; |
Line 63 sub Transition {
|
Line 153 sub Transition {
|
} |
} |
} |
} |
|
|
|
|
|
|
=pod |
=pod |
Construct a new lond connection. |
|
Parameters (besides the class name) include: |
=head2 new |
=item hostname - host the remote lond is on. |
|
This host is a host in the hosts.tab file |
Construct a new lond connection. |
=item port - port number the remote lond is listening on. |
|
|
Parameters (besides the class name) include: |
|
|
|
=item hostname |
|
|
|
host the remote lond is on. This host is a host in the hosts.tab file |
|
|
|
=item port |
|
|
|
port number the remote lond is listening on. |
|
|
=cut |
=cut |
|
|
sub new { |
sub new { |
my $class = shift; # class name. |
my $class = shift; # class name. |
my $Hostname = shift; # Name of host to connect to. |
my $Hostname = shift; # Name of host to connect to. |
my $Port = shift; # Port to connect |
my $Port = shift; # Port to connect |
|
|
|
if (!$ConfigRead) { |
|
ReadConfig(); |
|
$ConfigRead = 1; |
|
} |
&Debug(4,$class."::new( ".$Hostname.",".$Port.")\n"); |
&Debug(4,$class."::new( ".$Hostname.",".$Port.")\n"); |
|
|
# The host must map to an entry in the hosts table: |
# The host must map to an entry in the hosts table: |
Line 83 sub new {
|
Line 191 sub new {
|
# LoncapaHim fields of the object respectively. |
# LoncapaHim fields of the object respectively. |
# |
# |
if (!exists $hostshash{$Hostname}) { |
if (!exists $hostshash{$Hostname}) { |
|
&Debug(8, "No Such host $Hostname"); |
return undef; # No such host!!! |
return undef; # No such host!!! |
} |
} |
my @ConfigLine = @{$hostshash{$Hostname}}; |
my @ConfigLine = @{$hostshash{$Hostname}}; |
Line 100 sub new {
|
Line 209 sub new {
|
TimeoutCallback => undef, |
TimeoutCallback => undef, |
TransitionCallback => undef, |
TransitionCallback => undef, |
Timeoutable => 0, |
Timeoutable => 0, |
TimeoutValue => 60, |
TimeoutValue => 30, |
TimeoutRemaining => 0, |
TimeoutRemaining => 0, |
CipherKey => "", |
CipherKey => "", |
Cipher => undef}; |
Cipher => 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)) { |
return undef; # Inidicates the socket could not be made. |
return undef; # Inidicates the socket could not be made. |
} |
} |
# |
# |
Line 116 sub new {
|
Line 226 sub new {
|
# |
# |
$self->Transition("Connected"); |
$self->Transition("Connected"); |
$self->{InformWritable} = 1; # When socket is writable we send init |
$self->{InformWritable} = 1; # When socket is writable we send init |
|
$self->{Timeoutable} = 1; # Timeout allowed during startup negotiation. |
$self->{TransactionRequest} = "init\n"; |
$self->{TransactionRequest} = "init\n"; |
|
|
# |
# |
# Set socket to nonblocking I/O. |
# Set socket to nonblocking I/O. |
# |
# |
my $socket = $self->{Socket}; |
my $socket = $self->{Socket}; |
$flags = fcntl($socket->fileno, F_GETFL,0); |
my $flags = fcntl($socket->fileno, F_GETFL,0); |
if($flags == -1) { |
if($flags == -1) { |
$socket->close; |
$socket->close; |
return undef; |
return undef; |
Line 136 sub new {
|
Line 247 sub new {
|
|
|
return $self; |
return $self; |
} |
} |
|
|
=pod |
=pod |
This member should be called when the Socket becomes readable. |
|
Until the read completes, action is state independet. Data are accepted |
=head2 Readable |
into the TransactionReply until a newline character is received. At that |
|
time actionis state dependent: |
This member should be called when the Socket becomes readable. Until |
=item Connected: in this case we received challenge, the state changes |
the read completes, action is state independet. Data are accepted into |
to ChallengeReceived, and we initiate a send with the challenge response. |
the TransactionReply until a newline character is received. At that |
=item ReceivingReply: In this case a reply has been received for a transaction, |
time actionis state dependent: |
the state goes to Idle and we disable write and read notification. |
|
=item ChallengeReeived: we just got what should be an ok\n and the |
=item Connected |
connection can now handle transactions. |
|
|
in this case we received challenge, the state changes to |
|
ChallengeReceived, and we initiate a send with the challenge response. |
|
|
|
=item ReceivingReply |
|
|
|
In this case a reply has been received for a transaction, the state |
|
goes to Idle and we disable write and read notification. |
|
|
|
=item ChallengeReeived |
|
|
|
we just got what should be an ok\n and the connection can now handle |
|
transactions. |
|
|
=cut |
=cut |
|
|
sub Readable { |
sub Readable { |
my $self = shift; |
my $self = shift; |
my $socket = $self->{Socket}; |
my $socket = $self->{Socket}; |
Line 156 sub Readable {
|
Line 281 sub Readable {
|
my $rv = $socket->recv($data, POSIX::BUFSIZ, 0); |
my $rv = $socket->recv($data, POSIX::BUFSIZ, 0); |
my $errno = $! + 0; # Force numeric context. |
my $errno = $! + 0; # Force numeric context. |
|
|
unless (defined($rv) && length($data)) { # Read failed, |
unless (defined($rv) && length $data) {# Read failed, |
if(($errno == POSIX::EWOULDBLOCK) || |
if(($errno == POSIX::EWOULDBLOCK) || |
($errno == POSIX::EAGAIN) || |
($errno == POSIX::EAGAIN) || |
($errno == POSIX::EINTR) || |
($errno == POSIX::EINTR)) { |
($errno == 0)) { |
|
return 0; |
return 0; |
} |
} |
|
|
Line 178 sub Readable {
|
Line 302 sub Readable {
|
if($self->{TransactionReply} =~ /(.*\n)/) { |
if($self->{TransactionReply} =~ /(.*\n)/) { |
&Debug(8,"Readable End of line detected"); |
&Debug(8,"Readable End of line detected"); |
if ($self->{State} eq "Initialized") { # We received the challenge: |
if ($self->{State} eq "Initialized") { # We received the challenge: |
if($self->{TransactionReply} eq "refused") { # Remote doesn't have |
if($self->{TransactionReply} eq "refused\n") { # Remote doesn't have |
|
|
$self->Transition("Disconnected"); # in host tables. |
$self->Transition("Disconnected"); # in host tables. |
$socket->close(); |
$socket->close(); |
Line 213 sub Readable {
|
Line 337 sub Readable {
|
$key=substr($key,0,32); |
$key=substr($key,0,32); |
my $cipherkey=pack("H32",$key); |
my $cipherkey=pack("H32",$key); |
$self->{Cipher} = new IDEA $cipherkey; |
$self->{Cipher} = new IDEA $cipherkey; |
if($self->{Cipher} == undef) { |
if($self->{Cipher} eq undef) { |
$self->Transition("Disconnected"); |
$self->Transition("Disconnected"); |
$socket->close(); |
$socket->close(); |
return -1; |
return -1; |
Line 256 sub Readable {
|
Line 380 sub Readable {
|
|
|
|
|
=pod |
=pod |
This member should be called when the Socket becomes writable. |
|
The action is state independent. An attempt is made to drain the contents of |
This member should be called when the Socket becomes writable. |
the TransactionRequest member. Once this is drained, we mark the object |
|
as waiting for readability. |
The action is state independent. An attempt is made to drain the |
|
contents of the TransactionRequest member. Once this is drained, we |
|
mark the object as waiting for readability. |
|
|
Returns 0 if successful, or -1 if not. |
Returns 0 if successful, or -1 if not. |
|
|
=cut |
=cut |
sub Writable { |
sub Writable { |
my $self = shift; # Get reference to the object. |
my $self = shift; # Get reference to the object. |
Line 276 sub Writable {
|
Line 402 sub Writable {
|
} |
} |
|
|
} |
} |
if (($rv >= 0) || |
if (($nwritten >= 0) || |
($errno == POSIX::EWOULDBLOCK) || |
($errno == POSIX::EWOULDBLOCK) || |
($errno == POSIX::EAGAIN) || |
($errno == POSIX::EAGAIN) || |
($errno == POSIX::EINTR) || |
($errno == POSIX::EINTR) || |
Line 314 sub Writable {
|
Line 440 sub Writable {
|
|
|
} |
} |
=pod |
=pod |
|
|
|
=head2 Tick |
|
|
Tick is called every time unit by the event framework. It |
Tick is called every time unit by the event framework. It |
1. decrements the remaining timeout. |
|
2. If the timeout is zero, calls TimedOut indicating that the |
=item 1 decrements the remaining timeout. |
current operation timed out. |
|
|
=item 2 If the timeout is zero, calls TimedOut indicating that the current operation timed out. |
|
|
=cut |
=cut |
|
|
Line 328 sub Tick {
|
Line 458 sub Tick {
|
$self->TimedOut(); |
$self->TimedOut(); |
} |
} |
} |
} |
|
|
=pod |
=pod |
TimedOut - called on a timeout. If the timeout callback is defined, |
|
it is called with $self as its parameters. |
|
|
|
=cut |
=head2 TimedOut |
|
|
|
called on a timeout. If the timeout callback is defined, it is called |
|
with $self as its parameters. |
|
|
|
=cut |
|
|
sub TimedOut { |
sub TimedOut { |
|
|
my $self = shift; |
my $self = shift; |
Line 342 sub TimedOut {
|
Line 477 sub TimedOut {
|
&$callback(@args); |
&$callback(@args); |
} |
} |
} |
} |
|
|
=pod |
=pod |
Called to initiate a transaction. A transaction can only be initiated |
|
when the object is idle... otherwise an error is returned. |
=head2 InitiateTransaction |
A transaction consists of a request to the server that will have a reply. |
|
This member sets the request data in the TransactionRequest member, |
Called to initiate a transaction. A transaction can only be initiated |
makes the state SendingRequest and sets the data to allow a timout, |
when the object is idle... otherwise an error is returned. A |
and to request writability notification. |
transaction consists of a request to the server that will have a |
|
reply. This member sets the request data in the TransactionRequest |
|
member, makes the state SendingRequest and sets the data to allow a |
|
timout, and to request writability notification. |
|
|
=cut |
=cut |
|
|
sub InitiateTransaction { |
sub InitiateTransaction { |
my $self = shift; |
my $self = shift; |
my $data = shift; |
my $data = shift; |
|
|
|
Debug(1, "initiating transaction: ".$data); |
if($self->{State} ne "Idle") { |
if($self->{State} ne "Idle") { |
|
Debug(0," .. but not idle here\n"); |
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: |
Line 376 sub InitiateTransaction {
|
Line 519 sub InitiateTransaction {
|
|
|
|
|
=pod |
=pod |
Sets a callback for state transitions. Returns a reference to any |
|
prior established callback, or undef if there was none: |
=head2 SetStateTransitionCallback |
|
|
|
Sets a callback for state transitions. Returns a reference to any |
|
prior established callback, or undef if there was none: |
|
|
=cut |
=cut |
|
|
sub SetStateTransitionCallback { |
sub SetStateTransitionCallback { |
my $self = shift; |
my $self = shift; |
my $oldCallback = $self->{TransitionCallback}; |
my $oldCallback = $self->{TransitionCallback}; |
$self->{TransitionCallback} = shift; |
$self->{TransitionCallback} = shift; |
return $oldCallback; |
return $oldCallback; |
} |
} |
|
|
=pod |
=pod |
Sets the timeout callback. Returns a reference to any prior established |
|
callback or undef if there was none. |
=head2 SetTimeoutCallback |
|
|
|
Sets the timeout callback. Returns a reference to any prior |
|
established callback or undef if there was none. |
|
|
=cut |
=cut |
|
|
sub SetTimeoutCallback { |
sub SetTimeoutCallback { |
my $self = shift; |
my $self = shift; |
my $callback = shift; |
my $callback = shift; |
Line 398 sub SetTimeoutCallback {
|
Line 552 sub SetTimeoutCallback {
|
} |
} |
|
|
=pod |
=pod |
GetState - selector for the object state. |
|
|
=head2 Shutdown: |
|
|
|
Shuts down the socket. |
|
|
=cut |
=cut |
|
|
|
sub Shutdown { |
|
my $self = shift; |
|
my $socket = $self->GetSocket(); |
|
Debug(5,"socket is -$socket-"); |
|
if ($socket) { |
|
# Ask lond to exit too. Non blocking so |
|
# there is no cost for failure. |
|
eval { |
|
$socket->send("exit\n", 0); |
|
$socket->shutdown(2); |
|
} |
|
} |
|
} |
|
|
|
=pod |
|
|
|
=head2 GetState |
|
|
|
selector for the object state. |
|
|
|
=cut |
|
|
sub GetState { |
sub GetState { |
my $self = shift; |
my $self = shift; |
return $self->{State}; |
return $self->{State}; |
} |
} |
|
|
=pod |
=pod |
GetSocket - selector for the object socket. |
|
|
=head2 GetSocket |
|
|
|
selector for the object socket. |
|
|
=cut |
=cut |
|
|
sub GetSocket { |
sub GetSocket { |
my $self = shift; |
my $self = shift; |
return $self->{Socket}; |
return $self->{Socket}; |
} |
} |
|
|
|
|
=pod |
=pod |
Return the state of the flag that indicates the object wants to be |
|
called when readable. |
=head2 WantReadable |
|
|
|
Return the state of the flag that indicates the object wants to be |
|
called when readable. |
|
|
=cut |
=cut |
|
|
sub WantReadable { |
sub WantReadable { |
my $self = shift; |
my $self = shift; |
|
|
return $self->{InformReadable}; |
return $self->{InformReadable}; |
} |
} |
|
|
=pod |
=pod |
Return the state of the flag that indicates the object wants write |
|
notification. |
=head2 WantWritable |
|
|
|
Return the state of the flag that indicates the object wants write |
|
notification. |
|
|
=cut |
=cut |
|
|
sub WantWritable { |
sub WantWritable { |
my $self = shift; |
my $self = shift; |
return $self->{InformWritable}; |
return $self->{InformWritable}; |
} |
} |
|
|
=pod |
=pod |
return the state of the flag that indicates the object wants to be informed |
|
of timeouts. |
=head2 WantTimeout |
|
|
|
return the state of the flag that indicates the object wants to be |
|
informed of timeouts. |
|
|
=cut |
=cut |
|
|
sub WantTimeout { |
sub WantTimeout { |
my $self = shift; |
my $self = shift; |
return $self->{Timeoutable}; |
return $self->{Timeoutable}; |
} |
} |
|
|
=pod |
=pod |
Returns the reply from the last transaction. |
|
|
=head2 GetReply |
|
|
|
Returns the reply from the last transaction. |
|
|
=cut |
=cut |
|
|
sub GetReply { |
sub GetReply { |
my $self = shift; |
my $self = shift; |
return $self->{TransactionReply}; |
return $self->{TransactionReply}; |
} |
} |
|
|
=pod |
=pod |
Returns the encrypted version of the command string. |
|
The command input string is of the form: |
=head2 Encrypt |
|
|
|
Returns the encrypted version of the command string. |
|
|
|
The command input string is of the form: |
|
|
encrypt:command |
encrypt:command |
The output string can be directly sent to lond as it's of the form: |
|
|
The output string can be directly sent to lond as it is of the form: |
|
|
enc:length:<encodedrequest> |
enc:length:<encodedrequest> |
' |
|
=cut |
=cut |
|
|
sub Encrypt { |
sub Encrypt { |
my $self = shift; # Reference to the object. |
my $self = shift; # Reference to the object. |
my $request = shift; # Text to send. |
my $request = shift; # Text to send. |
Line 485 sub Encrypt {
|
Line 704 sub Encrypt {
|
|
|
|
|
} |
} |
=pod |
|
Decrypt |
=pod |
Decrypt a response from the server. The response is in the form: |
|
enc:<length>:<encrypted data> |
=head2 Decrypt |
|
|
|
Decrypt a response from the server. The response is in the form: |
|
|
|
enc:<length>:<encrypted data> |
|
|
=cut |
=cut |
|
|
sub Decrypt { |
sub Decrypt { |
my $self = shift; # Recover reference to object |
my $self = shift; # Recover reference to object |
my $encrypted = shift; # This is the encrypted data. |
my $encrypted = shift; # This is the encrypted data. |
Line 502 sub Decrypt {
|
Line 727 sub Decrypt {
|
# Decode the data in 8 byte blocks. The string is encoded |
# Decode the data in 8 byte blocks. The string is encoded |
# as hex digits so there are two characters per byte: |
# as hex digits so there are two characters per byte: |
|
|
$decrpyted = ""; |
my $decrypted = ""; |
for(my $index = 0; $index < length($EncryptedString); |
for(my $index = 0; $index < length($EncryptedString); |
$index += 16) { |
$index += 16) { |
$decrypted .= $self->{Cipher}->decrypt( |
$decrypted .= $self->{Cipher}->decrypt( |
Line 521 sub Decrypt {
|
Line 746 sub Decrypt {
|
} |
} |
|
|
=pod |
=pod |
=head GetHostIterator |
|
|
=head2 GetHostIterator |
|
|
Returns a hash iterator to the host information. Each get from |
Returns a hash iterator to the host information. Each get from |
this iterator returns a reference to an array that contains |
this iterator returns a reference to an array that contains |
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 name. |
[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. |
[4] - IP address (result of e.g. nslooup [3]). |
[4] - IP address (result of e.g. nslookup [3]). |
[5] - Maximum connection count. |
[5] - Maximum connection count. |
[6] - Idle timeout for reducing connection count. |
[6] - Idle timeout for reducing connection count. |
[7] - Minimum connection count. |
[7] - Minimum connection count. |
|
|
|
|
=cut |
=cut |
|
|
sub GetHostIterator { |
sub GetHostIterator { |
|
|
return HashIterator->new(\%hostshash); |
return HashIterator->new(\%hostshash); |
} |
} |
|
|
|
########################################################### |
|
# |
|
# The following is an unashamed kludge that is here to |
|
# allow LondConnection to be used outside of the |
|
# loncapa environment (e.g. by lonManage). |
|
# |
|
# This is a textual inclusion of pieces of the |
|
# Configuration.pm module. |
|
# |
|
|
|
|
|
my $confdir='/etc/httpd/conf/'; |
|
|
|
# ------------------- Subroutine read_conf: read LON-CAPA server configuration. |
|
# This subroutine reads PerlSetVar values out of specified web server |
|
# configuration files. |
|
sub read_conf |
|
{ |
|
my (@conf_files)=@_; |
|
my %perlvar; |
|
foreach my $filename (@conf_files,'loncapa_apache.conf') |
|
{ |
|
if($DebugLevel > 3) { |
|
print("Going to read $confdir.$filename\n"); |
|
} |
|
open(CONFIG,'<'.$confdir.$filename) or |
|
die("Can't read $confdir$filename"); |
|
while (my $configline=<CONFIG>) |
|
{ |
|
if ($configline =~ /^[^\#]*PerlSetVar/) |
|
{ |
|
my ($unused,$varname,$varvalue)=split(/\s+/,$configline); |
|
chomp($varvalue); |
|
$perlvar{$varname}=$varvalue; |
|
} |
|
} |
|
close(CONFIG); |
|
} |
|
if($DebugLevel > 3) { |
|
print "Dumping perlvar:\n"; |
|
foreach my $var (keys %perlvar) { |
|
print "$var = $perlvar{$var}\n"; |
|
} |
|
} |
|
my $perlvarref=\%perlvar; |
|
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); |
|
} |
|
|
|
|
1; |
1; |
|
|
=pod |
=pod |
|
|
=head1 Theory |
=head1 Theory |
The lond object is a state machine. It lives through the following states: |
|
|
|
=item Connected: a TCP connection has been formed, but the passkey has not yet |
The lond object is a state machine. It lives through the following states: |
been negotiated. |
|
=item Initialized: "init" sent. |
=item Connected: |
=item ChallengeReceived: lond sent its challenge to us. |
|
=item ChallengeReplied: We replied to lond's challenge waiting for lond's ok. |
a TCP connection has been formed, but the passkey has not yet been |
=item RequestingKey: We are requesting an encryption key. |
negotiated. |
=item ReceivingKey: We are receiving an encryption key. |
|
=item Idle: Connection was negotiated but no requests are active. |
=item Initialized: |
=item SendingRequest: A request is being sent to the peer. |
|
=item ReceivingReply: Waiting for an entire reply from the peer. |
"init" sent. |
=item Disconnected: For whatever reason, the connection was dropped. |
|
|
=item ChallengeReceived: |
When we need to be writing data, we have a writable |
|
event. When we need to be reading data, a readable event established. |
lond sent its challenge to us. |
Events dispatch through the class functions Readable and Writable, and the |
|
watcher contains a reference to the associated object to allow object context |
=item ChallengeReplied: |
to be reached. |
|
|
We replied to lond's challenge waiting for lond's ok. |
|
|
|
=item RequestingKey: |
|
|
|
We are requesting an encryption key. |
|
|
|
=item ReceivingKey: |
|
|
|
We are receiving an encryption key. |
|
|
|
=item Idle: |
|
|
|
Connection was negotiated but no requests are active. |
|
|
|
=item SendingRequest: |
|
|
|
A request is being sent to the peer. |
|
|
|
=item ReceivingReply: |
|
|
|
Waiting for an entire reply from the peer. |
|
|
|
=item Disconnected: |
|
|
|
For whatever reason, the connection was dropped. |
|
|
|
When we need to be writing data, we have a writable event. When we |
|
need to be reading data, a readable event established. Events |
|
dispatch through the class functions Readable and Writable, and the |
|
watcher contains a reference to the associated object to allow object |
|
context to be reached. |
|
|
=head2 Member data. |
=head2 Member data. |
Host - Host socket is connected to. |
|
Port - The port the remote lond is listening on. |
|
Socket - Socket open on the connection. |
|
State - The current state. |
|
TransactionRequest - The request being transmitted. |
|
TransactionReply - The reply being received from the transaction. |
|
InformReadable - True if we want to be called when socket is readable. |
|
InformWritable - True if we want to be informed if the socket is writable. |
|
Timeoutable - True if the current operation is allowed to timeout. |
|
TimeoutValue - Number of seconds in the timeout. |
|
TimeoutRemaining - Number of seconds left in the timeout. |
|
CipherKey - The key that was negotiated with the peer. |
|
Cipher - The cipher obtained via the key. |
|
|
|
|
=item Host |
|
|
|
Host socket is connected to. |
|
|
|
=item Port |
|
|
|
The port the remote lond is listening on. |
|
|
|
=item Socket |
|
|
|
Socket open on the connection. |
|
|
|
=item State |
|
|
|
The current state. |
|
|
|
=item TransactionRequest |
|
|
|
The request being transmitted. |
|
|
|
=item TransactionReply |
|
|
|
The reply being received from the transaction. |
|
|
|
=item InformReadable |
|
|
|
True if we want to be called when socket is readable. |
|
|
|
=item InformWritable |
|
|
|
True if we want to be informed if the socket is writable. |
|
|
|
=item Timeoutable |
|
|
|
True if the current operation is allowed to timeout. |
|
|
|
=item TimeoutValue |
|
|
|
Number of seconds in the timeout. |
|
|
|
=item TimeoutRemaining |
|
|
|
Number of seconds left in the timeout. |
|
|
|
=item CipherKey |
|
|
|
The key that was negotiated with the peer. |
|
|
|
=item Cipher |
|
|
|
The cipher obtained via the key. |
|
|
|
|
=head2 The following are callback like members: |
=head2 The following are callback like members: |
=item Tick: Called in response to a timer tick. Used to managed timeouts etc. |
|
=item Readable: Called when the socket becomes readable. |
=item Tick: |
=item Writable: Called when the socket becomes writable. |
|
=item TimedOut: Called when a timed operation timed out. |
Called in response to a timer tick. Used to managed timeouts etc. |
|
|
|
=item Readable: |
|
|
|
Called when the socket becomes readable. |
|
|
|
=item Writable: |
|
|
|
Called when the socket becomes writable. |
|
|
|
=item TimedOut: |
|
|
|
Called when a timed operation timed out. |
|
|
|
|
=head2 The following are operational member functions. |
=head2 The following are operational member functions. |
=item InitiateTransaction: Called to initiate a new transaction |
|
=item SetStateTransitionCallback: Called to establish a function that is called |
=item InitiateTransaction: |
whenever the object goes through a state transition. This is used by |
|
The client to manage the work flow for the object. |
Called to initiate a new transaction |
=item SetTimeoutCallback -Set a function to be called when a transaction times |
|
out. The function will be called with the object as its sole parameter. |
=item SetStateTransitionCallback: |
=item Encrypt - Encrypts a block of text according to the cipher negotiated |
|
with the peer (assumes the text is a command). |
Called to establish a function that is called whenever the object goes |
=item Decrypt - Decrypts a block of text according to the cipher negotiated |
through a state transition. This is used by The client to manage the |
with the peer (assumes the block was a reply. |
work flow for the object. |
|
|
|
=item SetTimeoutCallback: |
|
|
|
Set a function to be called when a transaction times out. The |
|
function will be called with the object as its sole parameter. |
|
|
|
=item Encrypt: |
|
|
|
Encrypts a block of text according to the cipher negotiated with the |
|
peer (assumes the text is a command). |
|
|
|
=item Decrypt: |
|
|
|
Decrypts a block of text according to the cipher negotiated with the |
|
peer (assumes the block was a reply. |
|
|
|
=item Shutdown: |
|
|
|
Shuts off the socket. |
|
|
=head2 The following are selector member functions: |
=head2 The following are selector member functions: |
|
|
=item GetState: Returns the current state |
=item GetState: |
=item GetSocket: Gets the socekt open on the connection to lond. |
|
=item WantReadable: true if the current state requires a readable event. |
Returns the current state |
=item WantWritable: true if the current state requires a writable event. |
|
=item WantTimeout: true if the current state requires timeout support. |
=item GetSocket: |
=item GetHostIterator: Returns an iterator into the host file hash. |
|
|
Gets the socekt open on the connection to lond. |
|
|
|
=item WantReadable: |
|
|
|
true if the current state requires a readable event. |
|
|
|
=item WantWritable: |
|
|
|
true if the current state requires a writable event. |
|
|
|
=item WantTimeout: |
|
|
|
true if the current state requires timeout support. |
|
|
|
=item GetHostIterator: |
|
|
|
Returns an iterator into the host file hash. |
|
|
=cut |
=cut |