Annotation of loncom/lonssl.pm, revision 1.4

1.2       foxr        1: #
1.4     ! foxr        2: # $Id: lonssl.pm,v 1.3 2004/05/26 21:45:46 albertel 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: #
                     26: 
                     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: 
        !            36: # CPAN modules:
        !            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: 
        !            47: my $perlvar;			# When configRead is true this refers to
        !            48:                                 # the apache perlsetvar variable hash.
        !            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.3       albertel   78:     my $PlaintextSocket    = shift;
                     79:     my $CACert             = shift;
                     80:     my $MyCert             = shift;
                     81:     my $KeyFile            = shift;
                     82: 
                     83:     # To create the ssl socket we need to duplicate the existing
                     84:     # socket.  Otherwise closing the ssl socket will close the plaintext socket
                     85:     # too:
                     86: 
                     87:     open (DUPLICATE, "+>$PlaintextSocket");
                     88: 
                     89:     my $client = IO::Socket::SSL->new_from_fd(fileno(DUPLICATE),
                     90: 					      SSL_user_cert => 1,
                     91: 					      SSL_key_file  => $KeyFile,
                     92: 					      SSL_cert_file => $MyCert,
                     93: 					      SSL_ca_fie    => $$CACert);
1.2       foxr       94: 
1.3       albertel   95:     return $client;		# Undef if the client negotiation fails.
1.2       foxr       96: }
                     97: 
                     98: #----------------------------------------------------------------------
                     99: # Name	PromoteServerSocket
                    100: # Description	Given an ordinary IO::Socket::INET Creates an SSL socket 
                    101: #               for a server that is connected to the same client.l
                    102: # Parameters	Name	Type	           Description
                    103: #               Socket	IO::Socket::INET   Original ordinary socket.
                    104: #               CACert	string	           Full path name to the certificate 
                    105: #                                          authority certificate file.
                    106: #                MyCert	string	           Full path name to the certificate 
                    107: #                                          issued to this host.
                    108: #                KeyFile string    	   Full pathname to the host's private 
                    109: #                                          key file for the certificate.
                    110: # Returns
                    111: #	-	Reference to an SSL socket on success
                    112: #       -	undef on failure.  Reason for failure can be interrogated from 
                    113: #               IO::Socket::SSL
1.3       albertel  114: sub PromoteServerSocket {
                    115:     my $PlaintextSocket    = shift;
                    116:     my $CACert             = shift;
                    117:     my $MyCert             = shift;
                    118:     my $KeyFile            = shift;
                    119: 
                    120: 
                    121:     # To create the ssl socket we need to duplicate the existing
                    122:     # socket.  Otherwise closing the ssl socket will close the plaintext socket
                    123:     # too:
                    124: 
                    125:     open (DUPLICATE, "+>$PlaintextSocket");
                    126: 
                    127:     my $client = IO::Socket::SSL->new_from_fd(fileno(DUPLICATE),
                    128: 					      SSL_server    => 1, # Server role.
                    129: 					      SSL_user_cert => 1,
                    130: 					      SSL_key_file  => $KeyFile,
                    131: 					      SSL_cert_file => $MyCert,
                    132: 					      SSL_ca_fie    => $$CACert);
                    133:     return $client;
1.2       foxr      134: }
                    135: 
                    136: #-------------------------------------------------------------------------
                    137: #
                    138: # Name: Close
                    139: # Description: Properly closes an ssl client or ssl server socket in
                    140: #              a way that keeps the parent socket open.
                    141: # Parameters:  Name      Type            Description
                    142: #              Socket   IO::Socket::SSL  SSL Socket gotten from either
                    143: #                                        PromoteClientSocket or 
                    144: #                                        PromoteServerSocket
                    145: # Returns:
                    146: #   NONE
                    147: #
                    148: sub Close {
1.3       albertel  149:     my $Socket = shift;
1.4     ! foxr      150:     
1.3       albertel  151:     $Socket->close(SSL_no_shutdown =>1); # Otherwise the parent socket 
                    152:                                          # gets torn down.
1.2       foxr      153: }
1.4     ! foxr      154: #---------------------------------------------------------------------------
        !           155: #
        !           156: # Name   	GetPeerCertificate
        !           157: # Description	Inquires about the certificate of the peer of a connection.
        !           158: # Parameters	Name	        Type	          Description
        !           159: #               SSLSocket	IO::Socket::SSL	  SSL tunnel socket open on 
        !           160: #                                                 the peer.
        !           161: # Returns
        !           162: #	A two element list.  The first element of the list is the name of 
        !           163: #       the certificate authority.  The second element of the list is the name 
        !           164: #       of the owner of the certificate.
        !           165: sub GetPeerCertificate {
        !           166:   my $SSLSocket = shift;
        !           167:   
        !           168:   my $CertOwner = $SSLSocket->peer_certificate("owner");
        !           169:   my $CertCA    = $SSLSocket->peer_certificate("authority");
        !           170:   
        !           171:   return \($CertCA, $CertOwner);
        !           172: }
        !           173: #----------------------------------------------------------------------------
        !           174: #
        !           175: # Name  	CertificateFile
        !           176: # Description	Locate the certificate files for this host.
        !           177: # Returns
        !           178: #	Returns a two element array.  The first element contains the name of
        !           179: #  the certificate file for this host.  The second element contains the name
        !           180: #  of the  certificate file for the CA that granted the certificate.  If 
        !           181: #  either file cannot be located, returns undef.
        !           182: #
        !           183: sub CertificateFile {
        !           184: 
        !           185:   # I need some perl variables from the configuration file for this:
        !           186: 
        !           187:   my $CertificateDir  = $perlvar->{lonCertificateDirectory};
        !           188:   my $CaFilename      = $perlvar->{lonnetCertificateAuthority};
        !           189:   my $CertFilename    = $perlvar->{lonnetCertificate};
        !           190: 
        !           191:   #  Ensure the existence of these variables:
        !           192: 
        !           193:   if((!$CertificateDir)  || (!$CaFilename) || (!$CertFilename)) {
        !           194:     return undef;
        !           195:   }
        !           196: 
        !           197:   #   Build the actual filenames and check for their existence and
        !           198:   #   readability.
        !           199: 
        !           200:   my $CaFilename   = $CertificateDir.$pathsep.$CaFilename;
        !           201:   my $CertFilename = $CertificateDir.$pathsep.$CertFilename;
        !           202: 
        !           203:   if((! -r $CaFilename) || (! -r $CertFilename)) {
        !           204:     return undef;
        !           205:   }
        !           206: 
        !           207:   # Everything works fine!!
        !           208: 
        !           209:   return \($CaFilename, $CertFilename);
        !           210: 
        !           211: }
        !           212: #------------------------------------------------------------------------
        !           213: #
        !           214: # Name	        KeyFile
        !           215: # Description
        !           216: #      Returns the name of the private key file of the current host.
        !           217: # Returns
        !           218: #      Returns the name of the key file or undef if the file cannot 
        !           219: #      be found.
        !           220: #
        !           221: sub KeyFile {
        !           222: 
        !           223:   # I need some perl variables from the configuration file for this:
        !           224: 
        !           225:   my $CertificateDir   = $perlvar->{lonCertificateDirectory};
        !           226:   my $KeyFilename      = $perlvar->{lonnetPrivateKey};
        !           227: 
        !           228:   # Ensure the variables exist:
        !           229: 
        !           230:   if((!$CertificateDir) || (!$KeyFilename)) {
        !           231:     return undef;
        !           232:   }
        !           233: 
        !           234:   # Build the actual filename and ensure that it not only exists but
        !           235:   # is also readable:
        !           236: 
        !           237:   my $KeyFilename    = $CertificateDir.$pathsep.$KeyFilename;
        !           238:   if(! (-r $KeyFilename)) {
        !           239:     return undef;
        !           240:   }
        !           241: 
        !           242:   return $KeyFilename;
        !           243: }
1.2       foxr      244: 
1.4     ! foxr      245: 1;

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