#
# $Id: lonssl.pm,v 1.5 2004/05/27 10:26:19 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; # 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;
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.