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

Diff for /loncom/LondConnection.pm between versions 1.30 and 1.34

version 1.30, 2004/06/01 10:05:16 version 1.34, 2004/09/14 11:46:29
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 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 {
Line 112  sub Debug { Line 139  sub Debug {
     my ($level, $message) = @_;      my ($level, $message) = @_;
   
     if ($level < $DebugLevel) {      if ($level < $DebugLevel) {
  print($message."\n");   print STDERR ($message."\n");
     }      }
 }  }
   
Line 126  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;
       
       if ($level <= $DebugLevel) {
    return;
       }
   
     my $key;      my $key;
     my $value;      my $value;
     print STDERR "Dumping LondConnectionObject:\n";      print STDERR "Dumping LondConnectionObject:\n";
Line 203  sub new { Line 236  sub new {
                      LoncapaHim         => $Hostname,                       LoncapaHim         => $Hostname,
                      Port               => $Port,                       Port               => $Port,
                      State              => "Initialized",                       State              => "Initialized",
        AuthenticationMode => "",
                      TransactionRequest => "",                       TransactionRequest => "",
                      TransactionReply   => "",                       TransactionReply   => "",
                      InformReadable     => 0,                       InformReadable     => 0,
Line 212  sub new { Line 246  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 223  sub new { Line 258  sub new {
        Timeout  => 3)) {         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 {
    #  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 281  sub Readable { Line 376  sub Readable {
     my $socket  = $self->{Socket};      my $socket  = $self->{Socket};
     my $data    = '';      my $data    = '';
     my $rv;      my $rv;
       my $ConnectionMode = $self->{AuthenticationMode};
   
     if ($socket) {      if ($socket) {
  eval {   eval {
     $rv = $socket->recv($data, POSIX::BUFSIZ, 0);      $rv = $socket->recv($data, POSIX::BUFSIZ, 0);
Line 311  sub Readable { Line 408  sub Readable {
     $self->{TransactionReply} .= $data;      $self->{TransactionReply} .= $data;
     if($self->{TransactionReply} =~ m/\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:
  $socket->close();      #     AuthenticationMode == local:
  return -1;      #       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";
       }
   
   
     &Debug(8," Transition out of Initialized");  
     $self->{TransactionRequest} = $self->{TransactionReply};  
     $self->{InformWritable}     = 1;  
     $self->{InformReadable}     = 0;  
     $self->Transition("ChallengeReceived");  
     $self->{TimeoutRemaining}   = $self->{TimeoutValue};  
     return 0;  
  }  elsif ($self->{State} eq "ChallengeReplied") {   }  elsif ($self->{State} eq "ChallengeReplied") {
     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("RequestingVersion");      $self->ToVersionRequest();
     $self->{InformReadable}   = 0;  
     $self->{InformWritable}   = 1;  
     $self->{TransactionRequest} = "version\n";  
     return 0;      return 0;
   
  } elsif ($self->{State} eq "ReadingVersionString") {   } elsif ($self->{State} eq "ReadingVersionString") {
     $self->{LondVersion}       = chomp($self->{TransactionReply});      $self->{LondVersion}       = chomp($self->{TransactionReply});
     $self->Transition("SetHost");      $self->Transition("SetHost");
Line 351  sub Readable { Line 514  sub Readable {
  $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 384  sub Readable { Line 552  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 785  sub Decrypt { Line 950  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 838  sub read_conf Line 1154  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 854  sub read_conf Line 1170  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 986  Socket open on the connection. Line 1302  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.30  
changed lines
  Added in v.1.34

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>