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

Diff for /loncom/lonssl.pm between versions 1.3 and 1.11

version 1.3, 2004/05/26 21:45:46 version 1.11, 2014/11/06 02:22:11
Line 23 Line 23
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
   package lonssl;
 #  lonssl.pm  #  lonssl.pm
 #    This file contains common functions used by lond and lonc when   #    This file contains common functions used by lond and lonc when 
 #    negotiating the exchange of the session encryption key via an   #    negotiating the exchange of the session encryption key via an 
Line 32 Line 32
 #  #
   
 use strict;  use strict;
   
   # CPAN/Standard  modules:
   
 use IO::Socket::INET;  use IO::Socket::INET;
 use IO::Socket::SSL;  use IO::Socket::SSL;
   
   use Fcntl;
   use POSIX;
   
   #  Loncapa modules:
   
   use LONCAPA::Configuration;
   
   #  Global storage:
   
   my $perlvar; #  this refers to the apache perlsetvar 
                                   # variable hash.
   
   my $pathsep = "/"; # We're on unix after all.
   
   my $DEBUG = 0; # Set to non zero to enable debug output.
   
   
   # Initialization code:
   
   $perlvar = LONCAPA::Configuration::read_conf('loncapa.conf');
   
   
   my $lasterror="";
   
   
   
   sub LastError {
       return $lasterror;
   }
   
   sub Debug {
       my $msg  = shift;
       if ($DEBUG) {
    print STDERR $msg;
       }
   }
   
   #-------------------------------------------------------------------------
   # Name SetFdBlocking - 
   #      Turn blocking mode on on the file handle.  This is required for
   #      SSL key negotiation.
   #
   # Parameters:
   #      Handle   - Reference to the handle to modify.
   # Returns:
   #      prior flag settings.
   #
   sub SetFdBlocking {
       Debug("SetFdBlocking called \n");
       my $Handle = shift;
   
   
   
       my $flags  = fcntl($Handle, F_GETFL, 0);
       if(!$flags) {
    Debug("SetBLocking fcntl get faild $!\n");
       }
       my $newflags  = $flags & (~ O_NONBLOCK); # Turn off O_NONBLOCK...
       if(!fcntl($Handle, F_SETFL, $newflags)) {
    Debug("Can't set non block mode  $!\n");
       }
       return $flags;
   }
   
 #--------------------------------------------------------------------------  #--------------------------------------------------------------------------
 #  #
Line 53  use IO::Socket::SSL; Line 119  use IO::Socket::SSL;
 # - 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 
 #               IO::Socket::SSL  #               IO::Socket::SSL
   # Side effects:  socket is left in blocking mode!!
   #
   
 sub PromoteClientSocket {  sub PromoteClientSocket {
     my $PlaintextSocket    = shift;      my ($PlaintextSocket,
     my $CACert             = shift;   $CACert,
     my $MyCert             = shift;   $MyCert,
     my $KeyFile            = shift;   $KeyFile)          = @_;
       
       
       Debug("Client promotion using key: $KeyFile, Cert: $MyCert, CA: $CACert\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
     # too:      # too.  We also must flip into blocking mode for the duration of the
       # ssl negotiation phase.. the caller will have to flip to non block if
     open (DUPLICATE, "+>$PlaintextSocket");      # that's what they want
   
       my $oldflags = SetFdBlocking($PlaintextSocket);
       my $dupfno   = fcntl($PlaintextSocket, F_DUPFD, 0);
       Debug("Client promotion got dup = $dupfno\n");
   
     my $client = IO::Socket::SSL->new_from_fd(fileno(DUPLICATE),      
       my $client = IO::Socket::SSL->new_from_fd($dupfno,
       SSL_user_cert => 1,        SSL_user_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);
       
       if(!$client) {
    $lasterror = IO::Socket::SSL::errstr();
    return undef;
       }
     return $client; # Undef if the client negotiation fails.      return $client; # Undef if the client negotiation fails.
 }  }
   
Line 91  sub PromoteClientSocket { Line 171  sub PromoteClientSocket {
 # - 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 
 #               IO::Socket::SSL  #               IO::Socket::SSL
   # Side Effects:
   #       Socket is left in blocking mode!!!
   #
 sub PromoteServerSocket {  sub PromoteServerSocket {
     my $PlaintextSocket    = shift;      my ($PlaintextSocket,
     my $CACert             = shift;   $CACert,
     my $MyCert             = shift;   $MyCert,
     my $KeyFile            = shift;   $KeyFile)          = @_;
   
   
   
     # 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
     # too:      # too:
   
     open (DUPLICATE, "+>$PlaintextSocket");      Debug("Server promotion: Key = $KeyFile, Cert $MyCert CA $CACert\n");
    
     my $client = IO::Socket::SSL->new_from_fd(fileno(DUPLICATE),      my $oldflags = SetFdBlocking($PlaintextSocket);
       my $dupfno   = fcntl($PlaintextSocket, F_DUPFD, 0);
       if (!$dupfno) {
    Debug("dup failed: $!\n");
       }
       Debug(" Fileno = $dupfno\n");
       my $client = IO::Socket::SSL->new_from_fd($dupfno,
       SSL_server    => 1, # Server role.        SSL_server    => 1, # Server role.
       SSL_user_cert => 1,        SSL_user_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);
       if(!$client) {
    $lasterror = IO::Socket::SSL::errstr();
    return undef;
       }
     return $client;      return $client;
 }  }
   
Line 127  sub PromoteServerSocket { Line 221  sub PromoteServerSocket {
 #  #
 sub Close {  sub Close {
     my $Socket = shift;      my $Socket = shift;
       
     $Socket->close(SSL_no_shutdown =>1); # Otherwise the parent socket       $Socket->close(SSL_no_shutdown =>1); # Otherwise the parent socket 
                                          # gets torn down.                                           # gets torn down.
 }  }
   #---------------------------------------------------------------------------
   #
   # Name   GetPeerCertificate
   # Description Inquires about the certificate of the peer of a connection.
   # Parameters Name        Type          Description
   #               SSLSocket IO::Socket::SSL  SSL tunnel socket open on 
   #                                                 the peer.
   # Returns
   # A two element list.  The first element of the list is the name of 
   #       the certificate authority.  The second element of the list is the name 
   #       of the owner of the certificate.
   sub GetPeerCertificate {
       my $SSLSocket = shift;
       
       my $CertOwner = $SSLSocket->peer_certificate("owner");
       my $CertCA    = $SSLSocket->peer_certificate("authority");
       
       return ($CertCA, $CertOwner);
   }
   #----------------------------------------------------------------------------
   #
   # Name   CertificateFile
   # Description Locate the certificate files for this host.
   # Returns
   # Returns a two element array.  The first element contains the name of
   #  the certificate file for this host.  The second element contains the name
   #  of the  certificate file for the CA that granted the certificate.  If 
   #  either file cannot be located, returns undef.
   #
   sub CertificateFile {
   
       # I need some perl variables from the configuration file for this:
       
       my $CertificateDir  = $perlvar->{lonCertificateDirectory};
       my $CaFilename      = $perlvar->{lonnetCertificateAuthority};
       my $CertFilename    = $perlvar->{lonnetCertificate};
       
       #  Ensure the existence of these variables:
       
       if((!$CertificateDir)  || (!$CaFilename) || (!$CertFilename)) {
    $lasterror = "Missing info: dir: $CertificateDir CA: $CaFilename "
               ."Cert: $CertFilename";
    return undef;
       }
       
       #   Build the actual filenames and check for their existence and
       #   readability.
       
       $CaFilename   = $CertificateDir.$pathsep.$CaFilename;
       $CertFilename = $CertificateDir.$pathsep.$CertFilename;
       
       if((! -r $CaFilename) || (! -r $CertFilename)) {
    $lasterror = "CA file $CaFilename or Cert File: $CertFilename "
               ."not readable";
    return undef;
       }
       
       # Everything works fine!!
       
       return ($CaFilename, $CertFilename);
   
   }
   #------------------------------------------------------------------------
   #
   # Name        KeyFile
   # Description
   #      Returns the name of the private key file of the current host.
   # Returns
   #      Returns the name of the key file or undef if the file cannot 
   #      be found.
   #
   sub KeyFile {
   
       # I need some perl variables from the configuration file for this:
       
       my $CertificateDir   = $perlvar->{lonCertificateDirectory};
       my $KeyFilename      = $perlvar->{lonnetPrivateKey};
       
       # Ensure the variables exist:
       
       if((!$CertificateDir) || (!$KeyFilename)) {
    $lasterror = "Missing parameter dir: $CertificateDir "
               ."key: $KeyFilename";
    return undef;
       }
       
       # Build the actual filename and ensure that it not only exists but
       # is also readable:
       
       $KeyFilename    = $CertificateDir.$pathsep.$KeyFilename;
       if(! (-r $KeyFilename)) {
    $lasterror = "Unreadable key file $KeyFilename";
    return undef;
       }
       
       return $KeyFilename;
   }
   
   1;
Removed from v.1.3  
changed lines
  Added in v.1.11

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.