version 1.3, 2004/05/26 21:45:46
|
version 1.5, 2004/05/27 10:26:19
|
Line 32
|
Line 32
|
# |
# |
|
|
use strict; |
use strict; |
|
|
|
# CPAN modules: |
|
|
use IO::Socket::INET; |
use IO::Socket::INET; |
use IO::Socket::SSL; |
use IO::Socket::SSL; |
|
|
|
# Loncapa modules: |
|
|
|
use LONCAPA::Configuration; |
|
|
|
# Global storage: |
|
|
|
my $perlvar; # this refers to the apache perlsetvar |
|
# variable hash. |
|
|
|
my $pathsep = "/"; # We're on unix after all. |
|
|
|
|
|
# Initialization code: |
|
|
|
$perlvar = LONCAPA::Configuration::read_conf('loncapa.conf'); |
|
|
|
|
|
|
#-------------------------------------------------------------------------- |
#-------------------------------------------------------------------------- |
# |
# |
Line 127 sub PromoteServerSocket {
|
Line 147 sub PromoteServerSocket {
|
# |
# |
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. |
} |
} |
|
#--------------------------------------------------------------------------- |
|
# |
|
# Name GetPeerCertificate |
|
# Description Inquires about the certificate of the peer of a connection. |
|
# Parameters Name Type Description |
|
# SSLSocket IO::Socket::SSL SSL tunnel socket open on |
|
# the peer. |
|
# Returns |
|
# A two element list. The first element of the list is the name of |
|
# the certificate authority. The second element of the list is the name |
|
# of the owner of the certificate. |
|
sub GetPeerCertificate { |
|
my $SSLSocket = shift; |
|
|
|
my $CertOwner = $SSLSocket->peer_certificate("owner"); |
|
my $CertCA = $SSLSocket->peer_certificate("authority"); |
|
|
|
return \($CertCA, $CertOwner); |
|
} |
|
#---------------------------------------------------------------------------- |
|
# |
|
# Name CertificateFile |
|
# Description Locate the certificate files for this host. |
|
# Returns |
|
# Returns a two element array. The first element contains the name of |
|
# the certificate file for this host. The second element contains the name |
|
# of the certificate file for the CA that granted the certificate. If |
|
# either file cannot be located, returns undef. |
|
# |
|
sub CertificateFile { |
|
|
|
# I need some perl variables from the configuration file for this: |
|
|
|
my $CertificateDir = $perlvar->{lonCertificateDirectory}; |
|
my $CaFilename = $perlvar->{lonnetCertificateAuthority}; |
|
my $CertFilename = $perlvar->{lonnetCertificate}; |
|
|
|
# Ensure the existence of these variables: |
|
|
|
if((!$CertificateDir) || (!$CaFilename) || (!$CertFilename)) { |
|
return undef; |
|
} |
|
|
|
# Build the actual filenames and check for their existence and |
|
# readability. |
|
|
|
my $CaFilename = $CertificateDir.$pathsep.$CaFilename; |
|
my $CertFilename = $CertificateDir.$pathsep.$CertFilename; |
|
|
|
if((! -r $CaFilename) || (! -r $CertFilename)) { |
|
return undef; |
|
} |
|
|
|
# Everything works fine!! |
|
|
|
return \($CaFilename, $CertFilename); |
|
|
|
} |
|
#------------------------------------------------------------------------ |
|
# |
|
# Name KeyFile |
|
# Description |
|
# Returns the name of the private key file of the current host. |
|
# Returns |
|
# Returns the name of the key file or undef if the file cannot |
|
# be found. |
|
# |
|
sub KeyFile { |
|
|
|
# I need some perl variables from the configuration file for this: |
|
|
|
my $CertificateDir = $perlvar->{lonCertificateDirectory}; |
|
my $KeyFilename = $perlvar->{lonnetPrivateKey}; |
|
|
|
# Ensure the variables exist: |
|
|
|
if((!$CertificateDir) || (!$KeyFilename)) { |
|
return undef; |
|
} |
|
|
|
# Build the actual filename and ensure that it not only exists but |
|
# is also readable: |
|
|
|
my $KeyFilename = $CertificateDir.$pathsep.$KeyFilename; |
|
if(! (-r $KeyFilename)) { |
|
return undef; |
|
} |
|
|
|
return $KeyFilename; |
|
} |
|
|
|
1; |