version 1.5, 2004/05/27 10:26:19
|
version 1.6, 2004/05/28 09:37:03
|
Line 23
|
Line 23
|
# |
# |
# http://www.lon-capa.org/ |
# http://www.lon-capa.org/ |
# |
# |
|
package lonssl; |
# lonssl.pm |
# lonssl.pm |
# This file contains common functions used by lond and lonc when |
# This file contains common functions used by lond and lonc when |
# negotiating the exchange of the session encryption key via an |
# negotiating the exchange of the session encryption key via an |
Line 33
|
Line 33
|
|
|
use strict; |
use strict; |
|
|
# CPAN modules: |
# CPAN/Standard modules: |
|
|
|
use English; |
use IO::Socket::INET; |
use IO::Socket::INET; |
use IO::Socket::SSL; |
use IO::Socket::SSL; |
|
|
Line 75 $perlvar = LONCAPA::Configuration::read_
|
Line 76 $perlvar = LONCAPA::Configuration::read_
|
# IO::Socket::SSL |
# IO::Socket::SSL |
|
|
sub PromoteClientSocket { |
sub PromoteClientSocket { |
my $PlaintextSocket = shift; |
my ($PlaintextSocket, |
my $CACert = shift; |
$CACert, |
my $MyCert = shift; |
$MyCert, |
my $KeyFile = shift; |
$KeyFile) = @ARG; |
|
|
|
|
# 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 112 sub PromoteClientSocket {
|
Line 114 sub PromoteClientSocket {
|
# - 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, |
my $CACert = shift; |
$CACert, |
my $MyCert = shift; |
$MyCert, |
my $KeyFile = shift; |
$KeyFile) = @ARG; |
|
|
|
|
|
|
# To create the ssl socket we need to duplicate the existing |
# To create the ssl socket we need to duplicate the existing |
Line 163 sub Close {
|
Line 166 sub Close {
|
# the certificate authority. The second element of the list is the name |
# the certificate authority. The second element of the list is the name |
# of the owner of the certificate. |
# of the owner of the certificate. |
sub GetPeerCertificate { |
sub GetPeerCertificate { |
my $SSLSocket = shift; |
my $SSLSocket = shift; |
|
|
my $CertOwner = $SSLSocket->peer_certificate("owner"); |
my $CertOwner = $SSLSocket->peer_certificate("owner"); |
my $CertCA = $SSLSocket->peer_certificate("authority"); |
my $CertCA = $SSLSocket->peer_certificate("authority"); |
|
|
return \($CertCA, $CertOwner); |
return \($CertCA, $CertOwner); |
} |
} |
#---------------------------------------------------------------------------- |
#---------------------------------------------------------------------------- |
# |
# |
Line 182 sub GetPeerCertificate {
|
Line 185 sub GetPeerCertificate {
|
# |
# |
sub CertificateFile { |
sub CertificateFile { |
|
|
# I need some perl variables from the configuration file for this: |
# I need some perl variables from the configuration file for this: |
|
|
my $CertificateDir = $perlvar->{lonCertificateDirectory}; |
my $CertificateDir = $perlvar->{lonCertificateDirectory}; |
my $CaFilename = $perlvar->{lonnetCertificateAuthority}; |
my $CaFilename = $perlvar->{lonnetCertificateAuthority}; |
my $CertFilename = $perlvar->{lonnetCertificate}; |
my $CertFilename = $perlvar->{lonnetCertificate}; |
|
|
# Ensure the existence of these variables: |
# Ensure the existence of these variables: |
|
|
if((!$CertificateDir) || (!$CaFilename) || (!$CertFilename)) { |
if((!$CertificateDir) || (!$CaFilename) || (!$CertFilename)) { |
return undef; |
return undef; |
} |
} |
|
|
# Build the actual filenames and check for their existence and |
# Build the actual filenames and check for their existence and |
# readability. |
# readability. |
|
|
my $CaFilename = $CertificateDir.$pathsep.$CaFilename; |
my $CaFilename = $CertificateDir.$pathsep.$CaFilename; |
my $CertFilename = $CertificateDir.$pathsep.$CertFilename; |
my $CertFilename = $CertificateDir.$pathsep.$CertFilename; |
|
|
if((! -r $CaFilename) || (! -r $CertFilename)) { |
if((! -r $CaFilename) || (! -r $CertFilename)) { |
return undef; |
return undef; |
} |
} |
|
|
# Everything works fine!! |
# Everything works fine!! |
|
|
return \($CaFilename, $CertFilename); |
return \($CaFilename, $CertFilename); |
|
|
} |
} |
#------------------------------------------------------------------------ |
#------------------------------------------------------------------------ |
Line 220 sub CertificateFile {
|
Line 223 sub CertificateFile {
|
# |
# |
sub KeyFile { |
sub KeyFile { |
|
|
# I need some perl variables from the configuration file for this: |
# I need some perl variables from the configuration file for this: |
|
|
my $CertificateDir = $perlvar->{lonCertificateDirectory}; |
my $CertificateDir = $perlvar->{lonCertificateDirectory}; |
my $KeyFilename = $perlvar->{lonnetPrivateKey}; |
my $KeyFilename = $perlvar->{lonnetPrivateKey}; |
|
|
# Ensure the variables exist: |
# Ensure the variables exist: |
|
|
if((!$CertificateDir) || (!$KeyFilename)) { |
if((!$CertificateDir) || (!$KeyFilename)) { |
return undef; |
return undef; |
} |
} |
|
|
# Build the actual filename and ensure that it not only exists but |
# Build the actual filename and ensure that it not only exists but |
# is also readable: |
# is also readable: |
|
|
my $KeyFilename = $CertificateDir.$pathsep.$KeyFilename; |
my $KeyFilename = $CertificateDir.$pathsep.$KeyFilename; |
if(! (-r $KeyFilename)) { |
if(! (-r $KeyFilename)) { |
return undef; |
return undef; |
} |
} |
|
|
return $KeyFilename; |
return $KeyFilename; |
} |
} |
|
|
1; |
1; |