[BACK]Return to LondConnection.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/LondConnection.pm between versions 1.11 and 1.32

version 1.11, 2003/09/30 10:46:57 version 1.32, 2004/06/17 10:15:46
Line 25 Line 25
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
   
 package LondConnection;  package LondConnection;
   
 use strict;  use strict;
Line 35  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::lonlocal;
 use LONCAPA::HashIterator;  use LONCAPA::lonssl;
   
   
   
   
 my $DebugLevel=0;  my $DebugLevel=0;
   my %hostshash;
   my %perlvar;
   my $LocalDns = ""; # Need not be defined for managers.
   my $InsecureOk;
   
   #
   #  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.  #   variables set.
   
   sub ReadConfig {
       Debug(8, "ReadConfig called");
   
       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) = @_;
   
 my $perlvarref = LONCAPA::Configuration::read_conf('loncapa.conf');      &Debug(4, "ReadForeignConfig $MyHost $Filename\n");
 my %perlvar    = %{$perlvarref};  
 my $hoststab   =       $perlvar{lonHostID} = $MyHost; # Rmember my host.
     LONCAPA::Configuration::read_hosts(      my $hosttab = read_hosts($Filename) ||
             "$perlvar{'lonTabDir'}/hosts.tab") ||    die "Can't read hosts table!!";
     die "Can't read host table!!";      %hostshash = %{$hosttab};
 my %hostshash  = %{$hoststab};      if($DebugLevel > 3) {
    foreach my $host (keys %hostshash) {
       print STDERR "host $host => $hostshash{$host}\n";
    }
       }
       $ConfigRead = 1;
   
 close(CONFIG);      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 {  sub Debug {
     my $level   = shift;  
     my $message = shift;      my ($level, $message) = @_;
   
     if ($level < $DebugLevel) {      if ($level < $DebugLevel) {
  print($message."\n");   print STDERR ($message."\n");
     }      }
 }  }
   
Line 65  sub Debug { Line 147  sub Debug {
   
 =head2 Dump  =head2 Dump
   
 Dump the internal state of the object: For debugging purposes.  Dump the internal state of the object: For debugging purposes, to stderr.
   
 =cut  =cut
   
 sub Dump {  sub Dump {
     my $self   = shift;      my $self   = shift;
       my $level  = shift;
       
       if ($level <= $DebugLevel) {
    return;
       }
   
     my $key;      my $key;
     my $value;      my $value;
     print "Dumping LondConnectionObject:\n";      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 STDERR "-------------------------------\n";
 }  }
   
 =pod  =pod
Line 89  old state. Line 177  old state.
 =cut  =cut
   
 sub Transition {  sub Transition {
     my $self     = shift;  
     my $newstate = shift;      my ($self, $newstate) = @_;
   
     my $oldstate = $self->{State};      my $oldstate = $self->{State};
     $self->{State} = $newstate;      $self->{State} = $newstate;
     $self->{TimeoutRemaining} = $self->{TimeoutValue};      $self->{TimeoutRemaining} = $self->{TimeoutValue};
Line 100  sub Transition { Line 189  sub Transition {
 }  }
   
   
   
 =pod  =pod
   
 =head2 new  =head2 new
Line 119  host the remote lond is on. This host is Line 209  host the remote lond is on. This host is
 =cut  =cut
   
 sub new {  sub new {
     my $class    = shift; # class name.  
     my $Hostname = shift; # Name of host to connect to.      my ($class, $Hostname, $Port) = @_;
     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 131  sub new { Line 225  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 138  sub new { Line 233  sub new {
     Debug(5, "Connecting to ".$DnsName);      Debug(5, "Connecting to ".$DnsName);
     # Now create the object...      # Now create the object...
     my $self     = { Host               => $DnsName,      my $self     = { Host               => $DnsName,
      LoncapaHim         => $Hostname,                       LoncapaHim         => $Hostname,
              Port               => $Port,                       Port               => $Port,
              State              => "Initialized",                       State              => "Initialized",
              TransactionRequest => "",       AuthenticationMode => "",
              TransactionReply   => "",                       TransactionRequest => "",
              InformReadable     => 0,                       TransactionReply   => "",
              InformWritable     => 0,                       InformReadable     => 0,
      TimeoutCallback    => undef,                       InformWritable     => 0,
      TransitionCallback => undef,                       TimeoutCallback    => undef,
              Timeoutable        => 0,                       TransitionCallback => undef,
              TimeoutValue       => 30,                       Timeoutable        => 0,
      TimeoutRemaining   => 0,                       TimeoutValue       => 30,
      CipherKey          => "",                       TimeoutRemaining   => 0,
      Cipher             => undef};       LocalKeyFile       => "",
                        CipherKey          => "",
                        LondVersion        => "Unknown",
                        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  => 5)) {         Timeout  => 3)) {
  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.
       #  If we are local, we'll first try local auth mode, otherwise, we'll try the 
       #  ssl auth mode:
   
       Debug(8, "Connecting to $DnsName I am $LocalDns");
       my $key;
       my $keyfile;
       if ($DnsName eq $LocalDns) {
    $self->{AuthenticationMode} = "local";
    ($key, $keyfile)         = lonlocal::CreateKeyFile();
    Debug(8, "Local key: $key, stored in $keyfile");
      
    #  If I can't make the key file fall back to insecure if 
    #  allowed...else give up right away.
   
    if(!(defined $key) || !(defined $keyfile)) {
       if($InsecureOk) {
    $self->{AuthenticationMode} = "insecure";
    $self->{TransactionRequest} = "init\n";
       } 
       else {
    $socket->close;
    return undef;
       }
    }
    $self->{TransactionRequest} = "init:local:$keyfile\n";
    Debug(9, "Init string is init:local:$keyfile");
    if(!$self->CreateCipher($key)) { # Nothing's going our way...
       $socket->close;
       return undef;
    }
   
       } 
       else {
    $self->{AuthenticationMode} = "ssl";
    $self->{TransactionRequest} = "init:ssl\n";
       }
   
     #      #
     # We're connected.  Set the state, and the events we'll accept:      # We're connected.  Set the state, and the events we'll accept:
     #      #
     $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->{Timeoutable}        = 1;    # Timeout allowed during startup negotiation. 
     $self->{TransactionRequest} = "init\n";  
           
     #      #
     # Set socket to nonblocking I/O.      # Set socket to nonblocking I/O.
     #      #
     my $socket = $self->{Socket};      my $socket = $self->{Socket};
     my $flags    = fcntl($socket->fileno, F_GETFL,0);      my $flags    = fcntl($socket, F_GETFL,0);
     if($flags == -1) {      if(!$flags) {
  $socket->close;   $socket->close;
  return undef;   return undef;
     }      }
     if(fcntl($socket, F_SETFL, $flags | O_NONBLOCK) == -1) {      if(!fcntl($socket, F_SETFL, $flags | O_NONBLOCK)) {
  $socket->close;   $socket->close;
  return undef;   return undef;
     }      }
   
     # return the object :      # return the object :
   
       Debug(9, "Initial object state: ");
       $self->Dump(9);
   
     return $self;      return $self;
 }  }
   
Line 217  sub Readable { Line 356  sub Readable {
     my $self    = shift;      my $self    = shift;
     my $socket  = $self->{Socket};      my $socket  = $self->{Socket};
     my $data    = '';      my $data    = '';
     my $rv      = $socket->recv($data, POSIX::BUFSIZ,  0);      my $rv;
       my $ConnectionMode = $self->{AuthenticationMode};
   
       if ($socket) {
    eval {
       $rv = $socket->recv($data, POSIX::BUFSIZ, 0);
    }
       } else {
    $self->Transition("Disconnected");
    return -1;
       }
     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,
Line 238  sub Readable { Line 387  sub Readable {
   
     &Debug(9,"Received from host: ".$data);      &Debug(9,"Received from host: ".$data);
     $self->{TransactionReply} .= $data;      $self->{TransactionReply} .= $data;
     if($self->{TransactionReply} =~ /(.*\n)/) {      if($self->{TransactionReply} =~ m/\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\n") { # Remote doesn't have      #   Our init was replied to. What happens next depends both on
       #  the actual init we sent (AuthenticationMode member data)
  $self->Transition("Disconnected"); # in host tables.      #  and the response:
       #     AuthenticationMode == local:
       #       Response ok:   The key has been exchanged and
       #                      the key file destroyed. We can jump
       #                      into setting the host and requesting the
       #                      Later we'll also bypass key exchange.
       #       Response digits: 
       #                      Old style lond. Delete the keyfile.
       #                      If allowed fall back to insecure mode.
       #                      else close connection and fail.
       #       Response other:
       #                      Failed local auth 
       #                      Close connection and fail.
       #
       #    AuthenticationMode == ssl:
       #        Response ok:ssl
       #        Response digits:
       #        Response other:
       #    Authentication mode == insecure
       #        Response digits
       #        Response other:
       
       my $Response = $self->{TransactionReply};
       if($ConnectionMode eq "local") {
    if($Response =~ /^ok:local/) { #  Good local auth.
       $self->ToVersionRequest();
       return 0;
    }
    elsif ($Response =~/^[0-9]+/) { # Old style lond.
       return $self->CompleteInsecure();
   
    }
    else {                # Complete flop
       &Debug(3, "init:local : unrecognized reply");
       $self->Transition("Disconnected");
       $socket->close;
       return -1;
    }
       }
       elsif ($ConnectionMode eq "ssl") {
    if($Response =~ /^ok:ssl/) {     # Good ssl...
       if($self->ExchangeKeysViaSSL()) { # Success skip to vsn stuff
    # Need to reset to non blocking:
   
    my $flags = fcntl($socket, F_GETFL, 0);
    fcntl($socket, F_SETFL, $flags | O_NONBLOCK);
    $self->ToVersionRequest();
    return 0;
       }
       else {         # Failed in ssl exchange.
    &Debug(3,"init:ssl failed key negotiation!");
    $self->Transition("Disconnected");
    $socket->close;
    return -1;
       }
    } 
    elsif ($Response =~ /^[0-9]+/) { # Old style lond.
       return $self->CompleteInsecure();
    }
    else {                 # Complete flop
    }
       }
       elsif ($ConnectionMode eq "insecure") {
    if($self->{TransactionReply} eq "refused\n") { # Remote doesn't have
       
       $self->Transition("Disconnected"); # in host tables.
       $socket->close();
       return -1;
   
    }
    return $self->CompleteInsecure();
       }
       else {
    &Debug(1,"Authentication mode incorrect");
    die "BUG!!! LondConnection::Readable invalid authmode";
       }
   
   
    }  elsif ($self->{State} eq "ChallengeReplied") {
       if($self->{TransactionReply} ne "ok\n") {
    $self->Transition("Disconnected");
  $socket->close();   $socket->close();
  return -1;   return -1;
     }      }
       $self->ToVersionRequest();
       return 0;
   
     &Debug(8," Transition out of Initialized");   } elsif ($self->{State} eq "ReadingVersionString") {
     $self->{TransactionRequest} = $self->{TransactionReply};      $self->{LondVersion}       = chomp($self->{TransactionReply});
     $self->{InformWritable}     = 1;      $self->Transition("SetHost");
     $self->{InformReadable}     = 0;      $self->{InformReadable}    = 0;
     $self->Transition("ChallengeReceived");      $self->{InformWritable}    = 1;
     $self->{TimeoutRemaining}   = $self->{TimeoutValue};      my $peer = $self->{LoncapaHim};
       $self->{TransactionRequest}= "sethost:$peer\n";
     return 0;      return 0;
  } elsif ($self->{State} eq "ChallengeReplied") { # should be ok.   } elsif ($self->{State} eq "HostSet") { # should be ok.
     if($self->{TransactionReply} != "ok\n") {      if($self->{TransactionReply} ne "ok\n") {
  $self->Transition("Disconnected");   $self->Transition("Disconnected");
  $socket->close();   $socket->close();
  return -1;   return -1;
     }      }
     $self->Transition("RequestingKey");      #  If the auth mode is insecure we must still
     $self->{InformReadable}  = 0;      #  exchange session keys. Otherwise,
     $self->{InformWritable}  = 1;      #  we can just transition to idle.
     $self->{TransactionRequest} = "ekey\n";  
     return 0;      if($ConnectionMode eq "insecure") {
    $self->Transition("RequestingKey");
    $self->{InformReadable}  = 0;
    $self->{InformWritable}  = 1;
    $self->{TransactionRequest} = "ekey\n";
    return 0;
       }
       else {
    $self->ToIdle();
    return 0;
       }
  } elsif ($self->{State}  eq "ReceivingKey") {   } elsif ($self->{State}  eq "ReceivingKey") {
     my $buildkey = $self->{TransactionReply};      my $buildkey = $self->{TransactionReply};
     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/;
     $key=~tr/Q-Z/0-9/;      $key=~tr/Q-Z/0-9/;
     $key=$key.$buildkey.$key.$buildkey.$key.$buildkey;      $key =$key.$buildkey.$key.$buildkey.$key.$buildkey;
     $key=substr($key,0,32);      $key               = substr($key,0,32);
     my $cipherkey=pack("H32",$key);      if(!$self->CreateCipher($key)) {
     $self->{Cipher} = new IDEA $cipherkey;  
     if($self->{Cipher} == undef) {  
  $self->Transition("Disconnected");   $self->Transition("Disconnected");
  $socket->close();   $socket->close();
  return -1;   return -1;
     } else {      } else {
  $self->Transition("Idle");   $self->ToIdle();
  $self->{InformWritable}  =  0;  
  $self->{InformReadable}  =  0;  
  $self->{Timeoutable}     = 0;  
  return 0;   return 0;
     }      }
  } elsif ($self->{State}  eq "ReceivingReply") {   } elsif ($self->{State}  eq "ReceivingReply") {
Line 299  sub Readable { Line 538  sub Readable {
   
     # finish the transaction      # finish the transaction
   
     $self->{InformWritable}     = 0;      $self->ToIdle();
     $self->{InformReadable}     = 0;  
     $self->{Timeoutable}        = 0;  
     $self->Transition("Idle");  
     return 0;      return 0;
  } elsif ($self->{State} eq "Disconnected") { # No connection.   } elsif ($self->{State} eq "Disconnected") { # No connection.
     return -1;      return -1;
Line 332  Returns  0 if successful, or -1 if not. Line 568  Returns  0 if successful, or -1 if not.
 sub Writable {  sub Writable {
     my $self     = shift; # Get reference to the object.      my $self     = shift; # Get reference to the object.
     my $socket   = $self->{Socket};      my $socket   = $self->{Socket};
     my $nwritten = $socket->send($self->{TransactionRequest}, 0);      my $nwritten;
       if ($socket) {
    eval {
       $nwritten = $socket->send($self->{TransactionRequest}, 0);
    }
       } else {
    # For whatever reason, there's no longer a socket left.
   
   
    $self->Transition("Disconnected");
    return -1;
       }
     my $errno    = $! + 0;      my $errno    = $! + 0;
     unless (defined $nwritten) {      unless (defined $nwritten) {
  if($errno != POSIX::EINTR) {   if($errno != POSIX::EINTR) {
Line 347  sub Writable { Line 594  sub Writable {
  ($errno == POSIX::EINTR)          ||   ($errno == POSIX::EINTR)          ||
  ($errno ==  0)) {   ($errno ==  0)) {
  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 "RequestingKey") {           } elsif($self->{State} eq "RequestingVersion") {
  $self->Transition("ReceivingKey");              $self->Transition("ReadingVersionString");
  $self->{InformWritable} = 0;           } elsif ($self->{State} eq "SetHost") {
  $self->{InformReadable} = 1;              $self->Transition("HostSet");
  $self->{TransactionReply} = '';           } elsif($self->{State} eq "RequestingKey") {
     } elsif ($self->{State} eq "SendingRequest") {              $self->Transition("ReceivingKey");
  $self->Transition("ReceivingReply");  #            $self->{InformWritable} = 0;
  $self->{TimeoutRemaining} = $self->{TimeoutValue};  #            $self->{InformReadable} = 1;
     } elsif ($self->{State} eq "Disconnected") {  #            $self->{TransactionReply} = '';
  return -1;           } elsif ($self->{State} eq "SendingRequest") {
     }              $self->Transition("ReceivingReply");
     return 0;              $self->{TimeoutRemaining} = $self->{TimeoutValue};
  }           } elsif ($self->{State} eq "Disconnected") {
     } else { # The write failed (e.g. partner disconnected).              return -1;
  $self->Transition("Disconnected");           }
  $socket->close();           return 0;
  return -1;        }
     }     } else { # The write failed (e.g. partner disconnected).
         $self->Transition("Disconnected");
         $socket->close();
         return -1;
      }
   
 }  }
 =pod  =pod
Line 431  timout, and to request writability notif Line 682  timout, and to request writability notif
 =cut  =cut
   
 sub InitiateTransaction {  sub InitiateTransaction {
     my $self   = shift;  
     my $data   = shift;      my ($self, $data) = @_;
   
     Debug(1, "initiating transaction: ".$data);      Debug(1, "initiating transaction: ".$data);
     if($self->{State} ne "Idle") {      if($self->{State} ne "Idle") {
Line 483  established callback or undef if there w Line 734  established callback or undef if there w
 =cut  =cut
   
 sub SetTimeoutCallback {  sub SetTimeoutCallback {
     my $self                 = shift;  
     my $callback             = shift;      my ($self, $callback) = @_;
   
     my $oldCallback          = $self->{TimeoutCallback};      my $oldCallback          = $self->{TimeoutCallback};
     $self->{TimeoutCallback} = $callback;      $self->{TimeoutCallback} = $callback;
     return $oldCallback;      return $oldCallback;
Line 501  Shuts down the socket. Line 753  Shuts down the socket.
 sub Shutdown {  sub Shutdown {
     my $self = shift;      my $self = shift;
     my $socket = $self->GetSocket();      my $socket = $self->GetSocket();
     $socket->shutdown(2);      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  =pod
Line 604  The output string can be directly sent t Line 864  The output string can be directly sent t
 =cut  =cut
   
 sub Encrypt {  sub Encrypt {
     my $self    = shift; # Reference to the object.      
     my $request = shift;        # Text to send.      my ($self, $request) = @_;
   
         
     # Split the encrypt: off the request and figure out it's length.      # Split the encrypt: off the request and figure out it's length.
Line 647  Decrypt a response from the server.  The Line 907  Decrypt a response from the server.  The
 =cut  =cut
   
 sub Decrypt {  sub Decrypt {
     my $self      = shift; # Recover reference to object  
     my $encrypted = shift; # This is the encrypted data.      my ($self, $encrypted) = @_;
   
     #  Bust up the response into length, and encryptedstring:      #  Bust up the response into length, and encryptedstring:
   
Line 675  sub Decrypt { Line 935  sub Decrypt {
     return $decrypted;      return $decrypted;
   
 }  }
   # ToIdle
   #     Called to transition to idle... done enough it's worth subbing
   #     off to ensure it's always done right!!
   #
   sub ToIdle {
       my $self   = shift;
   
       $self->Transition("Idle");
       $self->{InformWritiable} = 0;
       $self->{InformReadable}  = 0;
       $self->{Timeoutable}     = 0;
   }
   
   #  ToVersionRequest
   #    Called to transition to "RequestVersion"  also done a few times
   #    so worth subbing out.
   #
   sub ToVersionRequest {
       my $self   = shift;
       
       $self->Transition("RequestingVersion");
       $self->{InformReadable}   = 0;
       $self->{InformWritable}   = 1;
       $self->{TransactionRequest} = "version\n";
       
   }
   #
   #  CreateCipher
   #    Given a cipher key stores the key in the object context,
   #    creates the cipher object, (stores that in object context),
   #    This is done a couple of places, so it's worth factoring it out.
   #
   # Parameters:
   #    (self)
   #    key - The Cipher key.
   #
   # Returns:
   #    0   - Failure to create IDEA cipher.
   #    1   - Success.
   #
   sub CreateCipher {
       my ($self, $key)   = @_; # According to coding std.
   
       $self->{CipherKey} = $key; # Save the text key...
       my $packedkey = pack ("H32", $key);
       my $cipher            = new IDEA $packedkey;
       if($cipher) {
    $self->{Cipher} = $cipher;
    Debug("Cipher created  dumping socket: ");
    $self->Dump(9);
    return 1;
       }
       else {
    return 0;
       }
   }
   # ExchangeKeysViaSSL
   #     Called to do cipher key exchange via SSL.
   #     The socket is promoted to an SSL socket. If that's successful,
   #     we read out cipher key through the socket and create an IDEA
   #     cipher object.
   # Parameters:
   #    (self)
   # Returns:
   #      true    - Success.
   #      false   - Failure.
   #
   # Assumptions:
   #  1.   The ssl session setup has timeout logic built in so we don't
   #     have to worry about DOS attacks at that stage.
   #  2.   If the ssl session gets set up we are talking to a legitimate
   #     lond so again we don't have to worry about DOS attacks.
   #  All this allows us just to call 
   sub ExchangeKeysViaSSL {
       my $self   = shift;
       my $socket = $self->{Socket};
   
       #  Get our signed certificate, the certificate authority's 
       #  certificate and our private key file.  All of these
       #  are needed to create the ssl connection.
   
       my ($SSLCACertificate,
    $SSLCertificate) = lonssl::CertificateFile();
       my $SSLKey             = lonssl::KeyFile();
   
       #  Promote our connection to ssl and read the key from lond.
   
       my $SSLSocket = lonssl::PromoteClientSocket($socket,
    $SSLCACertificate,
    $SSLCertificate,
    $SSLKey);
       if(defined $SSLSocket) {
    my $key  = <$SSLSocket>;
    lonssl::Close($SSLSocket);
    if($key) {
       chomp($key); # \n is not part of the key.
       return $self->CreateCipher($key);
    } 
    else {
       Debug(3, "Failed to read ssl key");
       return 0;
    }
       }
       else {
    # Failed!!
    Debug(3, "Failed to negotiate SSL connection!");
    return 0;
       }
       # should not get here
       return 0;
   
   }
   
   
   
   #
   #  CompleteInsecure:
   #      This function is called to initiate the completion of
   #      insecure challenge response negotiation.
   #      To do this, we copy the challenge string to the transaction
   #      request, flip to writability and state transition to 
   #      ChallengeReceived..
   #      All this is only possible if InsecureOk is true.
   # Parameters:
   #      (self)    - This object's context hash.
   #  Return:
   #      0   - Ok to transition.
   #     -1   - Not ok to transition (InsecureOk not ok).
   #
   sub CompleteInsecure {
       my $self = shift;
       if($InsecureOk) {
    $self->{AuthenticationMode} = "insecure";
    &Debug(8," Transition out of Initialized:insecure");
    $self->{TransactionRequest} = $self->{TransactionReply};
    $self->{InformWritable}     = 1;
    $self->{InformReadable}     = 0;
    $self->Transition("ChallengeReceived");
    $self->{TimeoutRemaining}   = $self->{TimeoutValue};
    return 0;
   
   
       }
       else {
    &Debug(3, "Insecure key negotiation disabled!");
    my $socket = $self->{Socket};
    $socket->close;
    return -1;
       }
   }
   
 =pod  =pod
   
Line 701  sub GetHostIterator { Line 1111  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 STDERR ("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 STDERR "Dumping perlvar:\n";
    foreach my $var (keys %perlvar) {
       print STDERR "$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);
   }
   #
   #   Get the version of our peer.  Note that this is only well
   #   defined if the state machine has hit the idle state at least
   #   once (well actually if it has transitioned out of 
   #   ReadingVersionString   The member data LondVersion is returned.
   #
   sub PeerVersion {
      my $self = shift;
      
      return $self->{LondVersion};
   }
   
 1;  1;
   
 =pod  =pod
Line 774  Socket open on the connection. Line 1282  Socket open on the connection.
   
 The current state.  The current state.
   
   =item AuthenticationMode
   
   How authentication is being done. This can be any of:
   
       o local - Authenticate via a key exchanged in a file.
       o ssl   - Authenticate via a key exchaned through a temporary ssl tunnel.
       o insecure - Exchange keys in an insecure manner.
   
   insecure is only allowed if the configuration parameter loncAllowInsecure 
   is nonzero.
   
 =item TransactionRequest  =item TransactionRequest
   
 The request being transmitted.  The request being transmitted.
Removed from v.1.11  
changed lines
  Added in v.1.32

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
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.