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

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

version 1.9, 2004/06/17 10:15:46 version 1.16, 2018/07/29 03:03:36
Line 37  use strict; Line 37  use strict;
   
 use IO::Socket::INET;  use IO::Socket::INET;
 use IO::Socket::SSL;  use IO::Socket::SSL;
   use Net::SSLeay;
   
 use Fcntl;  use Fcntl;
 use POSIX;  use POSIX;
Line 115  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 
 # 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 126  sub PromoteClientSocket { Line 128  sub PromoteClientSocket {
     my ($PlaintextSocket,      my ($PlaintextSocket,
  $CACert,   $CACert,
  $MyCert,   $MyCert,
  $KeyFile)          = @_;   $KeyFile,
           $peer)          = @_;
           
           
     Debug("Client promotion using key: $KeyFile, Cert: $MyCert, CA: $CACert\n");      Debug("Client promotion using key: $KeyFile, Cert: $MyCert, CA: $CACert, 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 141  sub PromoteClientSocket { Line 144  sub PromoteClientSocket {
     my $dupfno   = fcntl($PlaintextSocket, F_DUPFD, 0);      my $dupfno   = fcntl($PlaintextSocket, F_DUPFD, 0);
     Debug("Client promotion got dup = $dupfno\n");      Debug("Client promotion got dup = $dupfno\n");
   
       # Starting with IO::Socket::SSL rev. 1.79, carp warns that a verify 
       # mode of SSL_VERIFY_NONE should be explicitly set for client, if 
       # verification is not to be used, and SSL_verify_mode is not set.
       # Starting with rev. 1.95, the default became SSL_VERIFY_PEER which
       # prevents an SSL connection to lond unless SSL_verifycn_name is set
       # 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. 
       # Set SSL_verify_mode to Net::SSLeay::VERIFY_PEER() instead of to
       # SSL_VERIFY_PEER for compatibility with IO::Socket::SSL rev. 1.01
       # used by CentOS/RHEL/Scientific Linux 5).
           
     my $client = IO::Socket::SSL->new_from_fd($dupfno,      my $client = IO::Socket::SSL->new_from_fd($dupfno,
       SSL_user_cert => 1,        SSL_use_cert => 1,
       SSL_key_file  => $KeyFile,        SSL_key_file  => $KeyFile,
       SSL_cert_file => $MyCert,        SSL_cert_file => $MyCert,
       SSL_ca_fie    => $CACert);        SSL_ca_file   => $CACert,
         SSL_verifycn_name => $peer,
         SSL_verify_mode => Net::SSLeay::VERIFY_PEER());
           
     if(!$client) {      if(!$client) {
  $lasterror = IO::Socket::SSL::errstr();   $lasterror = IO::Socket::SSL::errstr();
Line 158  sub PromoteClientSocket { Line 173  sub PromoteClientSocket {
 #----------------------------------------------------------------------  #----------------------------------------------------------------------
 # Name PromoteServerSocket  # Name PromoteServerSocket
 # Description Given an ordinary IO::Socket::INET Creates an SSL socket   # Description Given an ordinary IO::Socket::INET Creates an SSL socket 
 #               for a server that is connected to the same client.l  #               for a server that is connected to the same client.
 # Parameters Name Type           Description  # Parameters Name Type           Description
 #               Socket IO::Socket::INET   Original ordinary socket.  #               Socket IO::Socket::INET   Original ordinary socket.
 #               CACert string           Full path name to the certificate   #               CACert string           Full path name to the certificate 
Line 167  sub PromoteClientSocket { Line 182  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
 # 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 178  sub PromoteServerSocket { Line 194  sub PromoteServerSocket {
     my ($PlaintextSocket,      my ($PlaintextSocket,
  $CACert,   $CACert,
  $MyCert,   $MyCert,
  $KeyFile)          = @_;   $KeyFile,
           $peer)          = @_;
   
   
   
Line 196  sub PromoteServerSocket { Line 213  sub PromoteServerSocket {
     Debug(" Fileno = $dupfno\n");      Debug(" Fileno = $dupfno\n");
     my $client = IO::Socket::SSL->new_from_fd($dupfno,      my $client = IO::Socket::SSL->new_from_fd($dupfno,
       SSL_server    => 1, # Server role.        SSL_server    => 1, # Server role.
       SSL_user_cert => 1,        SSL_use_cert  => 1,
       SSL_key_file  => $KeyFile,        SSL_key_file  => $KeyFile,
       SSL_cert_file => $MyCert,        SSL_cert_file => $MyCert,
       SSL_ca_fie    => $CACert);        SSL_ca_file   => $CACert,
         SSL_verifycn_name => $peer,
         SSL_verify_mode => Net::SSLeay::VERIFY_PEER());
     if(!$client) {      if(!$client) {
  $lasterror = IO::Socket::SSL::errstr();   $lasterror = IO::Socket::SSL::errstr();
  return undef;   return undef;
Line 273  sub CertificateFile { Line 292  sub CertificateFile {
     #   Build the actual filenames and check for their existence and      #   Build the actual filenames and check for their existence and
     #   readability.      #   readability.
           
     my $CaFilename   = $CertificateDir.$pathsep.$CaFilename;      $CaFilename   = $CertificateDir.$pathsep.$CaFilename;
     my $CertFilename = $CertificateDir.$pathsep.$CertFilename;      $CertFilename = $CertificateDir.$pathsep.$CertFilename;
           
     if((! -r $CaFilename) || (! -r $CertFilename)) {      if((! -r $CaFilename) || (! -r $CertFilename)) {
  $lasterror = "CA file $CaFilename or Cert File: $CertFilename "   $lasterror = "CA file $CaFilename or Cert File: $CertFilename "
Line 314  sub KeyFile { Line 333  sub KeyFile {
     # Build the actual filename and ensure that it not only exists but      # Build the actual filename and ensure that it not only exists but
     # is also readable:      # is also readable:
           
     my $KeyFilename    = $CertificateDir.$pathsep.$KeyFilename;      $KeyFilename    = $CertificateDir.$pathsep.$KeyFilename;
     if(! (-r $KeyFilename)) {      if(! (-r $KeyFilename)) {
  $lasterror = "Unreadable key file $KeyFilename";   $lasterror = "Unreadable key file $KeyFilename";
  return undef;   return undef;
Line 323  sub KeyFile { Line 342  sub KeyFile {
     return $KeyFilename;      return $KeyFilename;
 }  }
   
   sub Read_Connect_Config {
       my ($secureconf,$perlvarref) = @_;
       return unless (ref($secureconf) eq 'HASH');
   
       unless (ref($perlvarref) eq 'HASH') {
           $perlvarref = $perlvar;
       }
       
       # Clean out the old table first.
       foreach my $key (keys(%{$secureconf})) {
           delete($secureconf->{$key});
       }
   
       my $result;
       my $tablename = $perlvarref->{'lonTabDir'}."/connectionrules.tab";
       if (open(my $fh,"<$tablename")) {
           while (my $line = <$fh>) {
               chomp($line);
               my ($name,$value) = split(/=/,$line);
               if ($value =~ /^(?:no|yes|req)$/) {
                   if ($name =~ /^conn(to|from)_(dom|intdom|other)$/) {
                       $secureconf->{'conn'.$1}{$2} = $value;
                   }
               }
           }
           close($fh);
           return 'ok';
       }
       return;
   }
   
   sub Read_Host_Types {
       my ($hosttypes,$perlvarref) = @_;
       return unless (ref($hosttypes) eq 'HASH');
   
       unless (ref($perlvarref) eq 'HASH') {
           $perlvarref = $perlvar;
       }
      
       # Clean out the old table first.
       foreach my $key (keys(%{$hosttypes})) {
           delete($hosttypes->{$key});
       }
   
       my $result;
       my $tablename = $perlvarref->{'lonTabDir'}."/hosttypes.tab";
       if (open(my $fh,"<$tablename")) {
           while (my $line = <$fh>) {
               chomp($line);
               my ($name,$value) = split(/:/,$line);
               if (($name ne '') && ($value =~ /^(dom|intdom|other)$/)) { 
                   $hosttypes->{$name} = $value;
               }
           }
           close($fh);
           return 'ok';
       }
       return;
   }
   
 1;  1;
Removed from v.1.9  
changed lines
  Added in v.1.16

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.