version 1.1, 2004/05/26 10:19:54
|
version 1.2, 2004/05/26 11:12:58
|
Line 0
|
Line 1
|
|
# |
|
# $Id$ |
|
# |
|
# 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; |
|
use IO::Socket::INET; |
|
use IO::Socket::SSL; |
|
|
|
|
|
#-------------------------------------------------------------------------- |
|
# |
|
# 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. |
|
} |
|
|