version 1.2, 2004/05/26 11:12:58
|
version 1.3, 2004/05/26 21:45:46
|
Line 55 use IO::Socket::SSL;
|
Line 55 use IO::Socket::SSL;
|
# IO::Socket::SSL |
# IO::Socket::SSL |
|
|
sub PromoteClientSocket { |
sub PromoteClientSocket { |
my $PlaintextSocket = shift; |
my $PlaintextSocket = shift; |
my $CACert = shift; |
my $CACert = shift; |
my $MyCert = shift; |
my $MyCert = shift; |
my $KeyFile = shift; |
my $KeyFile = shift; |
|
|
# To create the ssl socket we need to duplicate the existing |
# To create the ssl socket we need to duplicate the existing |
# socket. Otherwise closing the ssl socket will close the plaintext socket |
# socket. Otherwise closing the ssl socket will close the plaintext socket |
# too: |
# too: |
|
|
open (DUPLICATE, "+>$PlaintextSocket"); |
open (DUPLICATE, "+>$PlaintextSocket"); |
|
|
my $client = IO::Socket::SSL->new_from_fd(fileno(DUPLICATE), |
my $client = IO::Socket::SSL->new_from_fd(fileno(DUPLICATE), |
SSL_user_cert => 1, |
SSL_user_cert => 1, |
SSL_key_file => $KeyFile, |
SSL_key_file => $KeyFile, |
SSL_cert_file => $MyCert, |
SSL_cert_file => $MyCert, |
SSL_ca_fie => $$CACert); |
SSL_ca_fie => $$CACert); |
|
|
return $client; # Undef if the client negotiation fails. |
return $client; # Undef if the client negotiation fails. |
} |
} |
|
|
#---------------------------------------------------------------------- |
#---------------------------------------------------------------------- |
Line 91 sub PromoteClientSocket {
|
Line 91 sub PromoteClientSocket {
|
# - Reference to an SSL socket on success |
# - Reference to an SSL socket on success |
# - undef on failure. Reason for failure can be interrogated from |
# - undef on failure. Reason for failure can be interrogated from |
# IO::Socket::SSL |
# IO::Socket::SSL |
sub PromoteServerSocket |
sub PromoteServerSocket { |
{ |
my $PlaintextSocket = shift; |
my $PlaintextSocket = shift; |
my $CACert = shift; |
my $CACert = shift; |
my $MyCert = shift; |
my $MyCert = shift; |
my $KeyFile = shift; |
my $KeyFile = shift; |
|
|
|
|
# To create the ssl socket we need to duplicate the existing |
# To create the ssl socket we need to duplicate the existing |
# socket. Otherwise closing the ssl socket will close the plaintext socket |
# socket. Otherwise closing the ssl socket will close the plaintext socket |
# too: |
# too: |
|
|
open (DUPLICATE, "+>$PlaintextSocket"); |
open (DUPLICATE, "+>$PlaintextSocket"); |
|
|
my $client = IO::Socket::SSL->new_from_fd(fileno(DUPLICATE), |
my $client = IO::Socket::SSL->new_from_fd(fileno(DUPLICATE), |
SSL_server => 1, # Server role. |
SSL_server => 1, # Server role. |
SSL_user_cert => 1, |
SSL_user_cert => 1, |
SSL_key_file => $KeyFile, |
SSL_key_file => $KeyFile, |
SSL_cert_file => $MyCert, |
SSL_cert_file => $MyCert, |
SSL_ca_fie => $$CACert); |
SSL_ca_fie => $$CACert); |
return $client; |
return $client; |
|
} |
} |
|
|
#------------------------------------------------------------------------- |
#------------------------------------------------------------------------- |
Line 127 sub PromoteServerSocket
|
Line 126 sub PromoteServerSocket
|
# NONE |
# NONE |
# |
# |
sub Close { |
sub Close { |
my $Socket = shift; |
my $Socket = shift; |
|
|
$Socket->close(SSL_no_shutdown =>1); # Otherwise the parent socket |
$Socket->close(SSL_no_shutdown =>1); # Otherwise the parent socket |
# gets torn down. |
# gets torn down. |
} |
} |
|
|