--- loncom/lonssl.pm 2004/05/26 21:45:46 1.3 +++ loncom/lonssl.pm 2004/05/27 10:03:58 1.4 @@ -1,5 +1,5 @@ # -# $Id: lonssl.pm,v 1.3 2004/05/26 21:45:46 albertel Exp $ +# $Id: lonssl.pm,v 1.4 2004/05/27 10:03:58 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -32,9 +32,29 @@ # use strict; + +# CPAN modules: + use IO::Socket::INET; use IO::Socket::SSL; +# Loncapa modules: + +use LONCAPA::Configuration; + +# Global storage: + +my $perlvar; # When configRead is true 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'); + + #-------------------------------------------------------------------------- # @@ -127,8 +147,99 @@ sub PromoteServerSocket { # sub Close { my $Socket = shift; - + $Socket->close(SSL_no_shutdown =>1); # Otherwise the parent socket # 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;