Diff for /loncom/lonssl.pm between versions 1.16 and 1.17

version 1.16, 2018/07/29 03:03:36 version 1.17, 2018/08/07 17:12:08
Line 116  sub SetFdBlocking { Line 116  sub SetFdBlocking {
 #                                          issued to this host.  #                                          issued to this host.
 #                KeyFile string       Full pathname to the host's private   #                KeyFile string       Full pathname to the host's private 
 #                                          key file for the certificate.  #                                          key file for the certificate.
 #               peer    string             lonHostID of remote LON-CAPA server   #               peer    string             lonHostID of remote LON-CAPA server
   #               CRLFile                    Full path name to the certificate
   #                                          revocation list file for the cluster
   #                                          to which server belongs (optional)
   
 # Returns  # Returns
 # - Reference to an SSL socket on success  # - Reference to an SSL socket on success
 #       - undef on failure.  Reason for failure can be interrogated from   #       - undef on failure.  Reason for failure can be interrogated from 
Line 129  sub PromoteClientSocket { Line 133  sub PromoteClientSocket {
  $CACert,   $CACert,
  $MyCert,   $MyCert,
  $KeyFile,   $KeyFile,
         $peer)          = @_;          $peer,
           $CRLFile)          = @_;
           
           
     Debug("Client promotion using key: $KeyFile, Cert: $MyCert, CA: $CACert, Remote Host: $peer\n");      Debug("Client promotion using key: $KeyFile, Cert: $MyCert, CA: $CACert, CRL: $CRLFile, Remote Host: $peer\n");
   
     # To create the ssl socket we need to duplicate the existing      # To create the ssl socket we need to duplicate the existing
     # socket.  Otherwise closing the ssl socket will close the plaintext socket      # socket.  Otherwise closing the ssl socket will close the plaintext socket
Line 150  sub PromoteClientSocket { Line 155  sub PromoteClientSocket {
     # Starting with rev. 1.95, the default became SSL_VERIFY_PEER which      # Starting with rev. 1.95, the default became SSL_VERIFY_PEER which
     # prevents an SSL connection to lond unless SSL_verifycn_name is set      # prevents an SSL connection to lond unless SSL_verifycn_name is set
     # to the lonHostID of the remote host, (and the remote certificate has      # to the lonHostID of the remote host, (and the remote certificate has
     # the remote lonHostID as CN, and has been signed by the LON-CAPA CA.       # the remote lonHostID as CN, and has been signed by the LON-CAPA CA.
     # Set SSL_verify_mode to Net::SSLeay::VERIFY_PEER() instead of to      # Set SSL_verify_mode to Net::SSLeay::VERIFY_PEER() instead of to
     # SSL_VERIFY_PEER for compatibility with IO::Socket::SSL rev. 1.01      # SSL_VERIFY_PEER for compatibility with IO::Socket::SSL rev. 1.01
     # used by CentOS/RHEL/Scientific Linux 5).      # used by CentOS/RHEL/Scientific Linux 5).
           
     my $client = IO::Socket::SSL->new_from_fd($dupfno,      my %sslargs = (SSL_use_cert      => 1,
       SSL_use_cert => 1,                     SSL_key_file      => $KeyFile,
       SSL_key_file  => $KeyFile,                     SSL_cert_file     => $MyCert,
       SSL_cert_file => $MyCert,                     SSL_ca_file       => $CACert,
       SSL_ca_file   => $CACert,                     SSL_verifycn_name => $peer,
       SSL_verifycn_name => $peer,                     SSL_verify_mode   => Net::SSLeay::VERIFY_PEER());
       SSL_verify_mode => Net::SSLeay::VERIFY_PEER());      if (($CRLFile ne '') && (-e $CRLFile)) {
               $sslargs{SSL_check_crl} = 1;
           $sslargs{SSL_crl_file} = $CRLFile;
       }
       my $client = IO::Socket::SSL->new_from_fd($dupfno,%sslargs);
     if(!$client) {      if(!$client) {
  $lasterror = IO::Socket::SSL::errstr();          if ($IO::Socket::SSL::SSL_ERROR == -1) {
       $lasterror = -1;
           }
  return undef;   return undef;
     }      }
     return $client; # Undef if the client negotiation fails.      return $client; # Undef if the client negotiation fails.
Line 182  sub PromoteClientSocket { Line 192  sub PromoteClientSocket {
 #                                          issued to this host.  #                                          issued to this host.
 #                KeyFile string       Full pathname to the host's private   #                KeyFile string       Full pathname to the host's private 
 #                                          key file for the certificate.  #                                          key file for the certificate.
 #                peer   string             lonHostID of remote LON-CAPA client  #               peer   string              lonHostID of remote LON-CAPA client
   #               CRLFile                    Full path name to the certificate
   #                                          revocation list file for the cluster
   #                                          to which server belongs (optional)
 # Returns  # Returns
 # - Reference to an SSL socket on success  # - Reference to an SSL socket on success
 #       - undef on failure.  Reason for failure can be interrogated from   #       - undef on failure.  Reason for failure can be interrogated from 
Line 195  sub PromoteServerSocket { Line 208  sub PromoteServerSocket {
  $CACert,   $CACert,
  $MyCert,   $MyCert,
  $KeyFile,   $KeyFile,
         $peer)          = @_;          $peer,
           $CRLFile)          = @_;
   
   
   
Line 211  sub PromoteServerSocket { Line 225  sub PromoteServerSocket {
  Debug("dup failed: $!\n");   Debug("dup failed: $!\n");
     }      }
     Debug(" Fileno = $dupfno\n");      Debug(" Fileno = $dupfno\n");
     my $client = IO::Socket::SSL->new_from_fd($dupfno,      my %sslargs = (SSL_server        => 1, # Server role.
       SSL_server    => 1, # Server role.                     SSL_use_cert      => 1,
       SSL_use_cert  => 1,                     SSL_key_file      => $KeyFile,
       SSL_key_file  => $KeyFile,                     SSL_cert_file     => $MyCert,
       SSL_cert_file => $MyCert,                     SSL_ca_file       => $CACert,
       SSL_ca_file   => $CACert,                     SSL_verifycn_name => $peer,
       SSL_verifycn_name => $peer,                     SSL_verify_mode   => Net::SSLeay::VERIFY_PEER()); 
       SSL_verify_mode => Net::SSLeay::VERIFY_PEER());      if (($CRLFile ne '') && (-e $CRLFile)) {
           $sslargs{SSL_check_crl} = 1;
           $sslargs{SSL_crl_file} = $CRLFile; 
       }
       my $client = IO::Socket::SSL->new_from_fd($dupfno,%sslargs);
     if(!$client) {      if(!$client) {
  $lasterror = IO::Socket::SSL::errstr();          if ($IO::Socket::SSL::SSL_ERROR == -1) {
               $lasterror = -1;
           }
  return undef;   return undef;
     }      }
     return $client;      return $client;
Line 342  sub KeyFile { Line 362  sub KeyFile {
     return $KeyFilename;      return $KeyFilename;
 }  }
   
   sub CRLFile {
   
       # I need some perl variables from the configuration file for this:
   
       my $CertificateDir   = $perlvar->{lonCertificateDirectory};
       my $CRLFilename      = $perlvar->{lonnetCertRevocationList};
   
       # Ensure the variables exist:
   
       if((!$CertificateDir) || (!$CRLFilename)) {
           $lasterror = "Missing parameter dir: $CertificateDir "
                       ."CRL file: $CRLFilename";
           return undef;
       }
   
       # Build the actual filename and ensure that it not only exists but
       # is also readable:
   
       $CRLFilename    = $CertificateDir.$pathsep.$CRLFilename;
       if(! (-r $CRLFilename)) {
           $lasterror = "Unreadable key file $CRLFilename";
           return undef;
       }
   
       return $CRLFilename;
   }
   
   sub BadCertDir {
       my $SocketDir = $perlvar->{lonSockDir};
       if (-d "$SocketDir/nosslverify/") {
           return "$SocketDir/nosslverify"
       }
   }
   
   sub has_badcert_file {
       my ($client) = @_;
       my $SocketDir = $perlvar->{lonSockDir};
       if (-e "$SocketDir/nosslverify/$client") {
           return 1;
       }
       return;
   }
   
 sub Read_Connect_Config {  sub Read_Connect_Config {
     my ($secureconf,$perlvarref) = @_;      my ($secureconf,$checkedcrl,$perlvarref) = @_;
     return unless (ref($secureconf) eq 'HASH');      return unless ((ref($secureconf) eq 'HASH') && (ref($checkedcrl) eq 'HASH'));
   
     unless (ref($perlvarref) eq 'HASH') {      unless (ref($perlvarref) eq 'HASH') {
         $perlvarref = $perlvar;          $perlvarref = $perlvar;
     }      }
       
       # Clear hash of clients for which Certificate Revocation List checked 
       foreach my $key (keys(%{$checkedcrl})) {
           delete($checkedcrl->{$key});
       }
     # Clean out the old table first.      # Clean out the old table first.
     foreach my $key (keys(%{$secureconf})) {      foreach my $key (keys(%{$secureconf})) {
         delete($secureconf->{$key});          delete($secureconf->{$key});

Removed from v.1.16  
changed lines
  Added in v.1.17


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.