Return to lonssl.pm CVS log

Up to [LON-CAPA] / loncom

- Accept arguments according to loncapa coding standard
- Retabinate.

#
# $Id: lonssl.pm,v 1.6 2004/05/28 09:37:03 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/
#
package lonssl;
#  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/Standard  modules:

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

#  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.


# 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,
	$CACert,
	$MyCert,
	$KeyFile)          = @ARG;
    
    
    # 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,
	$CACert,
	$MyCert,
	$KeyFile)          = @ARG;



    # 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;