[LON-CAPA-cvs] cvs: loncom / lonssl.pm

[foxr]

foxr		Thu May 27 06:03:58 2004 EDT

  Modified files:              
    /loncom	lonssl.pm 
  Log:
  Got a good compile out of it.
  
  
Index: loncom/lonssl.pm
diff -u loncom/lonssl.pm:1.3 loncom/lonssl.pm:1.4
--- loncom/lonssl.pm:1.3	Wed May 26 17:45:46 2004
+++ loncom/lonssl.pm	Thu May 27 06:03:58 2004
@@ -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 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;