--- loncom/lonssl.pm	2004/05/26 10:19:54	1.1
+++ loncom/lonssl.pm	2004/05/26 11:12:58	1.2
@@ -0,0 +1,135 @@
+#
+# $Id: lonssl.pm,v 1.2 2004/05/26 11:12:58 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;
+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.
+}
+