[BACK]Return to lonssl.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom
File:  [LON-CAPA] / loncom / lonssl.pm
Revision 1.10: download - view: text, annotated - select for diffs
Fri Aug 25 17:49:15 2006 UTC (17 years, 9 months ago) by albertel
Branches: MAIN
CVS tags: version_2_9_X, version_2_9_99_0, version_2_9_1, version_2_9_0, version_2_8_X, version_2_8_99_1, version_2_8_99_0, version_2_8_2, version_2_8_1, version_2_8_0, version_2_7_X, version_2_7_99_1, version_2_7_99_0, version_2_7_1, version_2_7_0, version_2_6_X, version_2_6_99_1, version_2_6_99_0, version_2_6_3, version_2_6_2, version_2_6_1, version_2_6_0, version_2_5_X, version_2_5_99_1, version_2_5_99_0, version_2_5_2, version_2_5_1, version_2_5_0, version_2_4_X, version_2_4_99_0, version_2_4_2, version_2_4_1, version_2_4_0, version_2_3_X, version_2_3_99_0, version_2_3_2, version_2_3_1, version_2_3_0, version_2_2_X, version_2_2_99_1, version_2_2_99_0, version_2_2_2, version_2_2_1, version_2_11_0_RC3, version_2_11_0_RC2, version_2_11_0_RC1, version_2_11_0, version_2_10_X, version_2_10_1, version_2_10_0_RC2, version_2_10_0_RC1, version_2_10_0, loncapaMITrelate_1, language_hyphenation_merge, language_hyphenation, bz6209-base, bz6209, bz5969, bz2851, PRINT_INCOMPLETE_base, PRINT_INCOMPLETE, HEAD, GCI_3, GCI_2, GCI_1, BZ5971-printing-apage, BZ5434-fox, BZ4492-merge, BZ4492-feature_horizontal_radioresponse, BZ4492-feature_Support_horizontal_radioresponse, BZ4492-Support_horizontal_radioresponse
- more bad syntax bug#4975

#
# $Id: lonssl.pm,v 1.10 2006/08/25 17:49:15 albertel 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 IO::Socket::INET;
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;
}

#--------------------------------------------------------------------------
#
# 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
# Side effects:  socket is left in blocking mode!!
#

sub PromoteClientSocket {
    my ($PlaintextSocket,
	$CACert,
	$MyCert,
	$KeyFile)          = @_;
    
    
    Debug("Client promotion using key: $KeyFile, Cert: $MyCert, CA: $CACert\n");

    # To create the ssl socket we need to duplicate the existing
    # socket.  Otherwise closing the ssl socket will close the plaintext socket
    # 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
    # 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($dupfno,
					      SSL_user_cert => 1,
					      SSL_key_file  => $KeyFile,
					      SSL_cert_file => $MyCert,
					      SSL_ca_fie    => $CACert);
    
    if(!$client) {
	$lasterror = IO::Socket::SSL::errstr();
	return undef;
    }
    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
# Side Effects:
#       Socket is left in blocking mode!!!
#
sub PromoteServerSocket {
    my ($PlaintextSocket,
	$CACert,
	$MyCert,
	$KeyFile)          = @_;



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

    Debug("Server promotion: Key = $KeyFile, Cert $MyCert CA $CACert\n");
 
    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_user_cert => 1,
					      SSL_key_file  => $KeyFile,
					      SSL_cert_file => $MyCert,
					      SSL_ca_fie    => $CACert);
    if(!$client) {
	$lasterror = IO::Socket::SSL::errstr();
	return undef;
    }
    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)) {
	$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;
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.