Annotation of loncom/lonssl.pm, revision 1.7

1.2       foxr        1: #
1.7     ! foxr        2: # $Id: lonssl.pm,v 1.6 2004/05/28 09:37:03 foxr Exp $
1.2       foxr        3: #
                      4: # Copyright Michigan State University Board of Trustees
                      5: #
                      6: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      7: #
                      8: # LON-CAPA is free software; you can redistribute it and/or modify
                      9: # it under the terms of the GNU General Public License as published by
                     10: # the Free Software Foundation; either version 2 of the License, or
                     11: # (at your option) any later version.
                     12: #
                     13: # LON-CAPA is distributed in the hope that it will be useful,
                     14: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     15: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     16: # GNU General Public License for more details.
                     17: #
                     18: # You should have received a copy of the GNU General Public License
                     19: # along with LON-CAPA; if not, write to the Free Software
                     20: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     21: #
                     22: # /home/httpd/html/adm/gpl.txt
                     23: #
                     24: # http://www.lon-capa.org/
                     25: #
1.6       foxr       26: package lonssl;
1.2       foxr       27: #  lonssl.pm
                     28: #    This file contains common functions used by lond and lonc when 
                     29: #    negotiating the exchange of the session encryption key via an 
                     30: #    SSL tunnel.
                     31: #     See the POD sections and function documentation for more information.
                     32: #
                     33: 
                     34: use strict;
1.4       foxr       35: 
1.6       foxr       36: # CPAN/Standard  modules:
1.4       foxr       37: 
1.2       foxr       38: use IO::Socket::INET;
                     39: use IO::Socket::SSL;
                     40: 
1.4       foxr       41: #  Loncapa modules:
                     42: 
                     43: use LONCAPA::Configuration;
                     44: 
                     45: #  Global storage:
                     46: 
1.5       foxr       47: my $perlvar;			#  this refers to the apache perlsetvar 
                     48:                                 # variable hash.
1.4       foxr       49: 
                     50: my $pathsep = "/";		# We're on unix after all.
                     51: 
                     52: 
                     53: # Initialization code:
                     54: 
                     55: $perlvar = LONCAPA::Configuration::read_conf('loncapa.conf');
                     56: 
                     57: 
1.2       foxr       58: 
                     59: #--------------------------------------------------------------------------
                     60: #
                     61: # Name	PromoteClientSocket
                     62: # Description	Given an ordinary IO::Socket::INET Creates an SSL socket 
                     63: #               for a client that is connected to the same server.
                     64: # Parameters	Name	Type	           Description
                     65: #               Socket	IO::Socket::INET   Original ordinary socket.
                     66: #               CACert	string	           Full path name to the certificate 
                     67: #                                          authority certificate file.
                     68: #                MyCert	string	           Full path name to the certificate 
                     69: #                                          issued to this host.
                     70: #                KeyFile string    	   Full pathname to the host's private 
                     71: #                                          key file for the certificate.
                     72: # Returns
                     73: #	-	Reference to an SSL socket on success
                     74: #       -	undef on failure.  Reason for failure can be interrogated from 
                     75: #               IO::Socket::SSL
                     76: 
                     77: sub PromoteClientSocket {
1.6       foxr       78:     my ($PlaintextSocket,
                     79: 	$CACert,
                     80: 	$MyCert,
1.7     ! foxr       81: 	$KeyFile)          = @_;
1.6       foxr       82:     
                     83:     
1.3       albertel   84:     # To create the ssl socket we need to duplicate the existing
                     85:     # socket.  Otherwise closing the ssl socket will close the plaintext socket
                     86:     # too:
1.6       foxr       87:     
1.3       albertel   88:     open (DUPLICATE, "+>$PlaintextSocket");
1.6       foxr       89:     
1.3       albertel   90:     my $client = IO::Socket::SSL->new_from_fd(fileno(DUPLICATE),
                     91: 					      SSL_user_cert => 1,
                     92: 					      SSL_key_file  => $KeyFile,
                     93: 					      SSL_cert_file => $MyCert,
                     94: 					      SSL_ca_fie    => $$CACert);
1.6       foxr       95:     
1.3       albertel   96:     return $client;		# Undef if the client negotiation fails.
1.2       foxr       97: }
                     98: 
                     99: #----------------------------------------------------------------------
                    100: # Name	PromoteServerSocket
                    101: # Description	Given an ordinary IO::Socket::INET Creates an SSL socket 
                    102: #               for a server that is connected to the same client.l
                    103: # Parameters	Name	Type	           Description
                    104: #               Socket	IO::Socket::INET   Original ordinary socket.
                    105: #               CACert	string	           Full path name to the certificate 
                    106: #                                          authority certificate file.
                    107: #                MyCert	string	           Full path name to the certificate 
                    108: #                                          issued to this host.
                    109: #                KeyFile string    	   Full pathname to the host's private 
                    110: #                                          key file for the certificate.
                    111: # Returns
                    112: #	-	Reference to an SSL socket on success
                    113: #       -	undef on failure.  Reason for failure can be interrogated from 
                    114: #               IO::Socket::SSL
1.3       albertel  115: sub PromoteServerSocket {
1.6       foxr      116:     my ($PlaintextSocket,
                    117: 	$CACert,
                    118: 	$MyCert,
1.7     ! foxr      119: 	$KeyFile)          = @_;
1.6       foxr      120: 
1.3       albertel  121: 
                    122: 
                    123:     # To create the ssl socket we need to duplicate the existing
                    124:     # socket.  Otherwise closing the ssl socket will close the plaintext socket
                    125:     # too:
                    126: 
                    127:     open (DUPLICATE, "+>$PlaintextSocket");
                    128: 
                    129:     my $client = IO::Socket::SSL->new_from_fd(fileno(DUPLICATE),
                    130: 					      SSL_server    => 1, # Server role.
                    131: 					      SSL_user_cert => 1,
                    132: 					      SSL_key_file  => $KeyFile,
                    133: 					      SSL_cert_file => $MyCert,
                    134: 					      SSL_ca_fie    => $$CACert);
                    135:     return $client;
1.2       foxr      136: }
                    137: 
                    138: #-------------------------------------------------------------------------
                    139: #
                    140: # Name: Close
                    141: # Description: Properly closes an ssl client or ssl server socket in
                    142: #              a way that keeps the parent socket open.
                    143: # Parameters:  Name      Type            Description
                    144: #              Socket   IO::Socket::SSL  SSL Socket gotten from either
                    145: #                                        PromoteClientSocket or 
                    146: #                                        PromoteServerSocket
                    147: # Returns:
                    148: #   NONE
                    149: #
                    150: sub Close {
1.3       albertel  151:     my $Socket = shift;
1.4       foxr      152:     
1.3       albertel  153:     $Socket->close(SSL_no_shutdown =>1); # Otherwise the parent socket 
                    154:                                          # gets torn down.
1.2       foxr      155: }
1.4       foxr      156: #---------------------------------------------------------------------------
                    157: #
                    158: # Name   	GetPeerCertificate
                    159: # Description	Inquires about the certificate of the peer of a connection.
                    160: # Parameters	Name	        Type	          Description
                    161: #               SSLSocket	IO::Socket::SSL	  SSL tunnel socket open on 
                    162: #                                                 the peer.
                    163: # Returns
                    164: #	A two element list.  The first element of the list is the name of 
                    165: #       the certificate authority.  The second element of the list is the name 
                    166: #       of the owner of the certificate.
                    167: sub GetPeerCertificate {
1.6       foxr      168:     my $SSLSocket = shift;
                    169:     
                    170:     my $CertOwner = $SSLSocket->peer_certificate("owner");
                    171:     my $CertCA    = $SSLSocket->peer_certificate("authority");
                    172:     
                    173:     return \($CertCA, $CertOwner);
1.4       foxr      174: }
                    175: #----------------------------------------------------------------------------
                    176: #
                    177: # Name  	CertificateFile
                    178: # Description	Locate the certificate files for this host.
                    179: # Returns
                    180: #	Returns a two element array.  The first element contains the name of
                    181: #  the certificate file for this host.  The second element contains the name
                    182: #  of the  certificate file for the CA that granted the certificate.  If 
                    183: #  either file cannot be located, returns undef.
                    184: #
                    185: sub CertificateFile {
                    186: 
1.6       foxr      187:     # I need some perl variables from the configuration file for this:
                    188:     
                    189:     my $CertificateDir  = $perlvar->{lonCertificateDirectory};
                    190:     my $CaFilename      = $perlvar->{lonnetCertificateAuthority};
                    191:     my $CertFilename    = $perlvar->{lonnetCertificate};
                    192:     
                    193:     #  Ensure the existence of these variables:
                    194:     
                    195:     if((!$CertificateDir)  || (!$CaFilename) || (!$CertFilename)) {
                    196: 	return undef;
                    197:     }
                    198:     
                    199:     #   Build the actual filenames and check for their existence and
                    200:     #   readability.
                    201:     
                    202:     my $CaFilename   = $CertificateDir.$pathsep.$CaFilename;
                    203:     my $CertFilename = $CertificateDir.$pathsep.$CertFilename;
                    204:     
                    205:     if((! -r $CaFilename) || (! -r $CertFilename)) {
                    206: 	return undef;
                    207:     }
                    208:     
                    209:     # Everything works fine!!
                    210:     
                    211:     return \($CaFilename, $CertFilename);
1.4       foxr      212: 
                    213: }
                    214: #------------------------------------------------------------------------
                    215: #
                    216: # Name	        KeyFile
                    217: # Description
                    218: #      Returns the name of the private key file of the current host.
                    219: # Returns
                    220: #      Returns the name of the key file or undef if the file cannot 
                    221: #      be found.
                    222: #
                    223: sub KeyFile {
                    224: 
1.6       foxr      225:     # I need some perl variables from the configuration file for this:
                    226:     
                    227:     my $CertificateDir   = $perlvar->{lonCertificateDirectory};
                    228:     my $KeyFilename      = $perlvar->{lonnetPrivateKey};
                    229:     
                    230:     # Ensure the variables exist:
                    231:     
                    232:     if((!$CertificateDir) || (!$KeyFilename)) {
                    233: 	return undef;
                    234:     }
                    235:     
                    236:     # Build the actual filename and ensure that it not only exists but
                    237:     # is also readable:
                    238:     
                    239:     my $KeyFilename    = $CertificateDir.$pathsep.$KeyFilename;
                    240:     if(! (-r $KeyFilename)) {
                    241: 	return undef;
                    242:     }
                    243:     
                    244:     return $KeyFilename;
1.4       foxr      245: }
1.2       foxr      246: 
1.4       foxr      247: 1;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>