1: #
2: # $Id: lonssl.pm,v 1.2 2004/05/26 11:12:58 foxr Exp $
3: #
4: # Copyright Michigan State University Board of Trustees
5: #
6: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
7: #
8: # LON-CAPA is free software; you can redistribute it and/or modify
9: # it under the terms of the GNU General Public License as published by
10: # the Free Software Foundation; either version 2 of the License, or
11: # (at your option) any later version.
12: #
13: # LON-CAPA is distributed in the hope that it will be useful,
14: # but WITHOUT ANY WARRANTY; without even the implied warranty of
15: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16: # GNU General Public License for more details.
17: #
18: # You should have received a copy of the GNU General Public License
19: # along with LON-CAPA; if not, write to the Free Software
20: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21: #
22: # /home/httpd/html/adm/gpl.txt
23: #
24: # http://www.lon-capa.org/
25: #
26:
27: # lonssl.pm
28: # This file contains common functions used by lond and lonc when
29: # negotiating the exchange of the session encryption key via an
30: # SSL tunnel.
31: # See the POD sections and function documentation for more information.
32: #
33:
34: use strict;
35: use IO::Socket::INET;
36: use IO::Socket::SSL;
37:
38:
39: #--------------------------------------------------------------------------
40: #
41: # Name PromoteClientSocket
42: # Description Given an ordinary IO::Socket::INET Creates an SSL socket
43: # for a client that is connected to the same server.
44: # Parameters Name Type Description
45: # Socket IO::Socket::INET Original ordinary socket.
46: # CACert string Full path name to the certificate
47: # authority certificate file.
48: # MyCert string Full path name to the certificate
49: # issued to this host.
50: # KeyFile string Full pathname to the host's private
51: # key file for the certificate.
52: # Returns
53: # - Reference to an SSL socket on success
54: # - undef on failure. Reason for failure can be interrogated from
55: # IO::Socket::SSL
56:
57: sub PromoteClientSocket {
58: my $PlaintextSocket = shift;
59: my $CACert = shift;
60: my $MyCert = shift;
61: my $KeyFile = shift;
62:
63: # To create the ssl socket we need to duplicate the existing
64: # socket. Otherwise closing the ssl socket will close the plaintext socket
65: # too:
66:
67: open (DUPLICATE, "+>$PlaintextSocket");
68:
69: my $client = IO::Socket::SSL->new_from_fd(fileno(DUPLICATE),
70: SSL_user_cert => 1,
71: SSL_key_file => $KeyFile,
72: SSL_cert_file => $MyCert,
73: SSL_ca_fie => $$CACert);
74:
75: return $client; # Undef if the client negotiation fails.
76: }
77:
78: #----------------------------------------------------------------------
79: # Name PromoteServerSocket
80: # Description Given an ordinary IO::Socket::INET Creates an SSL socket
81: # for a server that is connected to the same client.l
82: # Parameters Name Type Description
83: # Socket IO::Socket::INET Original ordinary socket.
84: # CACert string Full path name to the certificate
85: # authority certificate file.
86: # MyCert string Full path name to the certificate
87: # issued to this host.
88: # KeyFile string Full pathname to the host's private
89: # key file for the certificate.
90: # Returns
91: # - Reference to an SSL socket on success
92: # - undef on failure. Reason for failure can be interrogated from
93: # IO::Socket::SSL
94: sub PromoteServerSocket
95: {
96: my $PlaintextSocket = shift;
97: my $CACert = shift;
98: my $MyCert = shift;
99: my $KeyFile = shift;
100:
101:
102: # To create the ssl socket we need to duplicate the existing
103: # socket. Otherwise closing the ssl socket will close the plaintext socket
104: # too:
105:
106: open (DUPLICATE, "+>$PlaintextSocket");
107:
108: my $client = IO::Socket::SSL->new_from_fd(fileno(DUPLICATE),
109: SSL_server => 1, # Server role.
110: SSL_user_cert => 1,
111: SSL_key_file => $KeyFile,
112: SSL_cert_file => $MyCert,
113: SSL_ca_fie => $$CACert);
114: return $client;
115: }
116:
117: #-------------------------------------------------------------------------
118: #
119: # Name: Close
120: # Description: Properly closes an ssl client or ssl server socket in
121: # a way that keeps the parent socket open.
122: # Parameters: Name Type Description
123: # Socket IO::Socket::SSL SSL Socket gotten from either
124: # PromoteClientSocket or
125: # PromoteServerSocket
126: # Returns:
127: # NONE
128: #
129: sub Close {
130: my $Socket = shift;
131:
132: $Socket->close(SSL_no_shutdown =>1); # Otherwise the parent socket
133: # gets torn down.
134: }
135:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>