--- loncom/lonssl.pm 2004/05/26 10:19:54 1.1
+++ loncom/lonssl.pm 2004/05/28 09:37:03 1.6
@@ -0,0 +1,248 @@
+#
+# $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;