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

Diff for /loncom/LondConnection.pm between versions 1.24 and 1.37

version 1.24, 2004/02/09 10:57:37 version 1.37, 2005/05/27 21:49:18
Line 36  use IO::File; Line 36  use IO::File;
 use Fcntl;  use Fcntl;
 use POSIX;  use POSIX;
 use Crypt::IDEA;  use Crypt::IDEA;
   use LONCAPA::lonlocal;
   use LONCAPA::lonssl;
   
   
   
Line 44  use Crypt::IDEA; Line 45  use Crypt::IDEA;
 my $DebugLevel=0;  my $DebugLevel=0;
 my %hostshash;  my %hostshash;
 my %perlvar;  my %perlvar;
   my $LocalDns = ""; # Need not be defined for managers.
   my $InsecureOk;
   
 #  #
 #  Set debugging level  #  Set debugging level
Line 61  sub SetDebug { Line 64  sub SetDebug {
 my $ConfigRead = 0;  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 {  sub ReadConfig {
       Debug(8, "ReadConfig called");
   
     my $perlvarref = read_conf('loncapa.conf');      my $perlvarref = read_conf('loncapa.conf');
     %perlvar    = %{$perlvarref};      %perlvar    = %{$perlvarref};
     my $hoststab   = read_hosts(      my $hoststab   = read_hosts(
Line 72  sub ReadConfig { Line 77  sub ReadConfig {
     %hostshash  = %{$hoststab};      %hostshash  = %{$hoststab};
     $ConfigRead = 1;      $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");
 }  }
   
 #  #
Line 89  sub ReadConfig { Line 106  sub ReadConfig {
 #                 to build up the hosts table.  #                 to build up the hosts table.
 #  #
 sub ReadForeignConfig {  sub ReadForeignConfig {
     my $MyHost   = shift;  
     my $Filename = shift;      my ($MyHost, $Filename) = @_;
   
     &Debug(4, "ReadForeignConfig $MyHost $Filename\n");      &Debug(4, "ReadForeignConfig $MyHost $Filename\n");
   
Line 100  sub ReadForeignConfig { Line 117  sub ReadForeignConfig {
     %hostshash = %{$hosttab};      %hostshash = %{$hosttab};
     if($DebugLevel > 3) {      if($DebugLevel > 3) {
  foreach my $host (keys %hostshash) {   foreach my $host (keys %hostshash) {
     print "host $host => $hostshash{$host}\n";      print STDERR "host $host => $hostshash{$host}\n";
  }   }
     }      }
     $ConfigRead = 1;      $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 {  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 125  Dump the internal state of the object: F Line 153  Dump the internal state of the object: F
   
 sub Dump {  sub Dump {
     my $self   = shift;      my $self   = shift;
       my $level  = shift;
       my $now    = time;
       my $local  = localtime($now);
       
       if ($level >= $DebugLevel) {
    return;
       }
   
       
     my $key;      my $key;
     my $value;      my $value;
     print STDERR "Dumping LondConnectionObject:\n";      print STDERR "[ $local ] Dumping LondConnectionObject:\n";
       print STDERR join(':',caller(1))."\n";
     while(($key, $value) = each %$self) {      while(($key, $value) = each %$self) {
  print STDERR "$key -> $value\n";   print STDERR "$key -> $value\n";
     }      }
Line 143  old state. Line 181  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 174  host the remote lond is on. This host is Line 213  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) {      if (!$ConfigRead) {
  ReadConfig();   ReadConfig();
Line 197  sub new { Line 235  sub new {
     my @ConfigLine = @{$hostshash{$Hostname}};      my @ConfigLine = @{$hostshash{$Hostname}};
     my $DnsName    = $ConfigLine[3]; # 4'th item is dns of host.      my $DnsName    = $ConfigLine[3]; # 4'th item is dns of host.
     Debug(5, "Connecting to ".$DnsName);      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");
     # 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",
        AuthenticationMode => "",
                      TransactionRequest => "",                       TransactionRequest => "",
                      TransactionReply   => "",                       TransactionReply   => "",
                      InformReadable     => 0,                       InformReadable     => 0,
Line 211  sub new { Line 253  sub new {
                      Timeoutable        => 0,                       Timeoutable        => 0,
                      TimeoutValue       => 30,                       TimeoutValue       => 30,
                      TimeoutRemaining   => 0,                       TimeoutRemaining   => 0,
        LocalKeyFile       => "",
                      CipherKey          => "",                       CipherKey          => "",
                      LondVersion        => "Unknown",                       LondVersion        => "Unknown",
                      Cipher             => undef};                       Cipher             => undef};
Line 220  sub new { Line 263  sub new {
        Type     => SOCK_STREAM,         Type     => SOCK_STREAM,
        Proto    => "tcp",         Proto    => "tcp",
        Timeout  => 3)) {         Timeout  => 3)) {
    Debug(8, "Error? \n$@ \n$!");
  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:
   
       my $key;
       my $keyfile;
       if ($DnsName eq '127.0.0.1') {
    $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 {
    #  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:
   
    my ($ca, $cert) = lonssl::CertificateFile;
    my $sslkeyfile  = lonssl::KeyFile;
   
    if((defined $ca)  && (defined $cert) && (defined $sslkeyfile)) {
   
       $self->{AuthenticationMode} = "ssl";
       $self->{TransactionRequest} = "init:ssl\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;
       }
    }
       }
   
     #      #
     # 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 279  sub Readable { Line 382  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 300  sub Readable { Line 413  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") {  
       if($self->{TransactionReply} ne "ok\n") {  
          $self->Transition("Disconnected");  
          $socket->close();  
          return -1;  
       }  
       $self->Transition("RequestingVersion");  
       $self->{InformReadable}   = 0;  
       $self->{InformWritable}   = 1;  
       $self->{TransactionRequest} = "version\n";  
       return 0;  
    } elsif ($self->{State} eq "ReadingVersionString") {  
       $self->{LondVersion}       = chomp($self->{TransactionReply});  
       $self->Transition("SetHost");  
       $self->{InformReadable}    = 0;  
       $self->{InformWritable}    = 1;  
       my $peer = $self->{LoncapaHim};  
       $self->{TransactionRequest}= "sethost:$peer\n";  
       return 0;  
  } elsif ($self->{State} eq "HostSet") { # should be ok.   } elsif ($self->{State} eq "HostSet") { # should be ok.
       if($self->{TransactionReply} ne "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} eq 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 375  sub Readable { Line 559  sub Readable {
     my $answer = $self->{TransactionReply};      my $answer = $self->{TransactionReply};
     if($answer =~ /^enc\:/) {      if($answer =~ /^enc\:/) {
  $answer = $self->Decrypt($answer);   $answer = $self->Decrypt($answer);
  $self->{TransactionReply} = $answer;   $self->{TransactionReply} = "$answer\n";
     }      }
   
     # 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 413  Returns  0 if successful, or -1 if not. Line 594  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 516  timout, and to request writability notif Line 708  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 568  established callback or undef if there w Line 760  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 697  The output string can be directly sent t Line 890  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 740  Decrypt a response from the server.  The Line 933  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 764  sub Decrypt { Line 957  sub Decrypt {
     #  $length tells us the actual length of the decrypted string:      #  $length tells us the actual length of the decrypted string:
   
     $decrypted = substr($decrypted, 0, $length);      $decrypted = substr($decrypted, 0, $length);
       Debug(9, "Decrypted $EncryptedString to $decrypted");
   
     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 817  sub read_conf Line 1161  sub read_conf
     foreach my $filename (@conf_files,'loncapa_apache.conf')      foreach my $filename (@conf_files,'loncapa_apache.conf')
       {        {
   if($DebugLevel > 3) {    if($DebugLevel > 3) {
       print("Going to read $confdir.$filename\n");        print STDERR ("Going to read $confdir.$filename\n");
   }    }
  open(CONFIG,'<'.$confdir.$filename) or   open(CONFIG,'<'.$confdir.$filename) or
     die("Can't read $confdir$filename");      die("Can't read $confdir$filename");
Line 833  sub read_conf Line 1177  sub read_conf
  close(CONFIG);   close(CONFIG);
       }        }
     if($DebugLevel > 3) {      if($DebugLevel > 3) {
  print "Dumping perlvar:\n";   print STDERR "Dumping perlvar:\n";
  foreach my $var (keys %perlvar) {   foreach my $var (keys %perlvar) {
     print "$var = $perlvar{$var}\n";      print STDERR "$var = $perlvar{$var}\n";
  }   }
     }      }
     my $perlvarref=\%perlvar;      my $perlvarref=\%perlvar;
Line 845  sub read_conf Line 1189  sub read_conf
 #---------------------- Subroutine read_hosts: Read a LON-CAPA hosts.tab  #---------------------- Subroutine read_hosts: Read a LON-CAPA hosts.tab
 # formatted configuration file.  # formatted configuration file.
 #  #
 my $RequiredCount = 5; # Required item count in hosts.tab.  my $RequiredCount = 4; # Required item count in hosts.tab.
 my $DefaultMaxCon = 5; # Default value for maximum connections.  my $DefaultMaxCon = 5; # Default value for maximum connections.
 my $DefaultIdle   = 1000;       # Default connection idle time in seconds.  my $DefaultIdle   = 1000;       # Default connection idle time in seconds.
 my $DefaultMinCon = 0;          # Default value for minimum connections.  my $DefaultMinCon = 0;          # Default value for minimum connections.
Line 854  sub read_hosts { Line 1198  sub read_hosts {
     my $Filename = shift;      my $Filename = shift;
     my %HostsTab;      my %HostsTab;
           
    open(CONFIG,'<'.$Filename) or die("Can't read $Filename");      open(CONFIG,'<'.$Filename) or die("Can't read $Filename");
     while (my $line = <CONFIG>) {      while (my $line = <CONFIG>) {
  if (!($line =~ /^\s*\#/)) {   if ($line !~ /^\s*\#/) {
       $line=~s/\s*$//;
     my @items = split(/:/, $line);      my @items = split(/:/, $line);
     if(scalar @items >= $RequiredCount) {      if(scalar @items >= $RequiredCount) {
  if (scalar @items == $RequiredCount) { # Only required items:   if (scalar @items == $RequiredCount) { # Only required items:
Line 965  Socket open on the connection. Line 1310  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.24  
changed lines
  Added in v.1.37

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.