File:  [LON-CAPA] / loncom / lonssl.pm
Revision 1.4: download - view: text, annotated - select for diffs
Thu May 27 10:03:58 2004 UTC (19 years, 10 months ago) by foxr
Branches: MAIN
CVS tags: HEAD
Got a good compile out of it.

#
# $Id: lonssl.pm,v 1.4 2004/05/27 10:03:58 foxr Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#

#  lonssl.pm
#    This file contains common functions used by lond and lonc when 
#    negotiating the exchange of the session encryption key via an 
#    SSL tunnel.
#     See the POD sections and function documentation for more information.
#

use strict;

# CPAN modules:

use IO::Socket::INET;
use IO::Socket::SSL;

#  Loncapa modules:

use LONCAPA::Configuration;

#  Global storage:

my $perlvar;			# When configRead is true this refers to
                                # the apache perlsetvar variable hash.

my $pathsep = "/";		# We're on unix after all.


# Initialization code:

$perlvar = LONCAPA::Configuration::read_conf('loncapa.conf');



#--------------------------------------------------------------------------
#
# Name	PromoteClientSocket
# Description	Given an ordinary IO::Socket::INET Creates an SSL socket 
#               for a client that is connected to the same server.
# Parameters	Name	Type	           Description
#               Socket	IO::Socket::INET   Original ordinary socket.
#               CACert	string	           Full path name to the certificate 
#                                          authority certificate file.
#                MyCert	string	           Full path name to the certificate 
#                                          issued to this host.
#                KeyFile string    	   Full pathname to the host's private 
#                                          key file for the certificate.
# Returns
#	-	Reference to an SSL socket on success
#       -	undef on failure.  Reason for failure can be interrogated from 
#               IO::Socket::SSL

sub PromoteClientSocket {
    my $PlaintextSocket    = shift;
    my $CACert             = shift;
    my $MyCert             = shift;
    my $KeyFile            = shift;

    # To create the ssl socket we need to duplicate the existing
    # socket.  Otherwise closing the ssl socket will close the plaintext socket
    # too:

    open (DUPLICATE, "+>$PlaintextSocket");

    my $client = IO::Socket::SSL->new_from_fd(fileno(DUPLICATE),
					      SSL_user_cert => 1,
					      SSL_key_file  => $KeyFile,
					      SSL_cert_file => $MyCert,
					      SSL_ca_fie    => $$CACert);

    return $client;		# Undef if the client negotiation fails.
}

#----------------------------------------------------------------------
# Name	PromoteServerSocket
# Description	Given an ordinary IO::Socket::INET Creates an SSL socket 
#               for a server that is connected to the same client.l
# Parameters	Name	Type	           Description
#               Socket	IO::Socket::INET   Original ordinary socket.
#               CACert	string	           Full path name to the certificate 
#                                          authority certificate file.
#                MyCert	string	           Full path name to the certificate 
#                                          issued to this host.
#                KeyFile string    	   Full pathname to the host's private 
#                                          key file for the certificate.
# Returns
#	-	Reference to an SSL socket on success
#       -	undef on failure.  Reason for failure can be interrogated from 
#               IO::Socket::SSL
sub PromoteServerSocket {
    my $PlaintextSocket    = shift;
    my $CACert             = shift;
    my $MyCert             = shift;
    my $KeyFile            = shift;


    # To create the ssl socket we need to duplicate the existing
    # socket.  Otherwise closing the ssl socket will close the plaintext socket
    # too:

    open (DUPLICATE, "+>$PlaintextSocket");

    my $client = IO::Socket::SSL->new_from_fd(fileno(DUPLICATE),
					      SSL_server    => 1, # Server role.
					      SSL_user_cert => 1,
					      SSL_key_file  => $KeyFile,
					      SSL_cert_file => $MyCert,
					      SSL_ca_fie    => $$CACert);
    return $client;
}

#-------------------------------------------------------------------------
#
# Name: Close
# Description: Properly closes an ssl client or ssl server socket in
#              a way that keeps the parent socket open.
# Parameters:  Name      Type            Description
#              Socket   IO::Socket::SSL  SSL Socket gotten from either
#                                        PromoteClientSocket or 
#                                        PromoteServerSocket
# Returns:
#   NONE
#
sub Close {
    my $Socket = shift;
    
    $Socket->close(SSL_no_shutdown =>1); # Otherwise the parent socket 
                                         # 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)) {
    return undef;
  }

  #   Build the actual filenames and check for their existence and
  #   readability.

  my $CaFilename   = $CertificateDir.$pathsep.$CaFilename;
  my $CertFilename = $CertificateDir.$pathsep.$CertFilename;

  if((! -r $CaFilename) || (! -r $CertFilename)) {
    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)) {
    return undef;
  }

  # Build the actual filename and ensure that it not only exists but
  # is also readable:

  my $KeyFilename    = $CertificateDir.$pathsep.$KeyFilename;
  if(! (-r $KeyFilename)) {
    return undef;
  }

  return $KeyFilename;
}

1;

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