Annotation of loncom/lonssl.pm, revision 1.9

1.2       foxr        1: #
1.9     ! foxr        2: # $Id: lonssl.pm,v 1.8 2004/06/17 09:27:38 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.8       foxr       41: use Fcntl;
                     42: use POSIX;
                     43: 
1.4       foxr       44: #  Loncapa modules:
                     45: 
                     46: use LONCAPA::Configuration;
                     47: 
                     48: #  Global storage:
                     49: 
1.5       foxr       50: my $perlvar;			#  this refers to the apache perlsetvar 
                     51:                                 # variable hash.
1.4       foxr       52: 
                     53: my $pathsep = "/";		# We're on unix after all.
                     54: 
1.9     ! foxr       55: my $DEBUG = 0;			# Set to non zero to enable debug output.
        !            56: 
1.4       foxr       57: 
                     58: # Initialization code:
                     59: 
                     60: $perlvar = LONCAPA::Configuration::read_conf('loncapa.conf');
                     61: 
                     62: 
1.8       foxr       63: my $lasterror="";
                     64: 
                     65: 
1.9     ! foxr       66: 
1.8       foxr       67: sub LastError {
                     68:     return $lasterror;
                     69: }
                     70: 
1.9     ! foxr       71: sub Debug {
        !            72:     my $msg  = shift;
        !            73:     if ($DEBUG) {
        !            74: 	print STDERR $msg;
        !            75:     }
        !            76: }
        !            77: 
1.8       foxr       78: #-------------------------------------------------------------------------
                     79: # Name SetFdBlocking - 
                     80: #      Turn blocking mode on on the file handle.  This is required for
                     81: #      SSL key negotiation.
                     82: #
                     83: # Parameters:
                     84: #      Handle   - Reference to the handle to modify.
                     85: # Returns:
                     86: #      prior flag settings.
                     87: #
                     88: sub SetFdBlocking {
1.9     ! foxr       89:     Debug("SetFdBlocking called \n");
1.8       foxr       90:     my $Handle = shift;
                     91: 
                     92: 
                     93: 
                     94:     my $flags  = fcntl($Handle, F_GETFL, 0);
                     95:     if(!$flags) {
1.9     ! foxr       96: 	Debug("SetBLocking fcntl get faild $!\n");
1.8       foxr       97:     }
                     98:     my $newflags  = $flags & (~ O_NONBLOCK); # Turn off O_NONBLOCK...
                     99:     if(!fcntl($Handle, F_SETFL, $newflags)) {
1.9     ! foxr      100: 	Debug("Can't set non block mode  $!\n");
1.8       foxr      101:     }
                    102:     return $flags;
                    103: }
1.2       foxr      104: 
                    105: #--------------------------------------------------------------------------
                    106: #
                    107: # Name	PromoteClientSocket
                    108: # Description	Given an ordinary IO::Socket::INET Creates an SSL socket 
                    109: #               for a client that is connected to the same server.
                    110: # Parameters	Name	Type	           Description
                    111: #               Socket	IO::Socket::INET   Original ordinary socket.
                    112: #               CACert	string	           Full path name to the certificate 
                    113: #                                          authority certificate file.
                    114: #                MyCert	string	           Full path name to the certificate 
                    115: #                                          issued to this host.
                    116: #                KeyFile string    	   Full pathname to the host's private 
                    117: #                                          key file for the certificate.
                    118: # Returns
                    119: #	-	Reference to an SSL socket on success
                    120: #       -	undef on failure.  Reason for failure can be interrogated from 
                    121: #               IO::Socket::SSL
1.8       foxr      122: # Side effects:  socket is left in blocking mode!!
                    123: #
1.2       foxr      124: 
                    125: sub PromoteClientSocket {
1.6       foxr      126:     my ($PlaintextSocket,
                    127: 	$CACert,
                    128: 	$MyCert,
1.7       foxr      129: 	$KeyFile)          = @_;
1.6       foxr      130:     
                    131:     
1.9     ! foxr      132:     Debug("Client promotion using key: $KeyFile, Cert: $MyCert, CA: $CACert\n");
1.8       foxr      133: 
1.3       albertel  134:     # To create the ssl socket we need to duplicate the existing
                    135:     # socket.  Otherwise closing the ssl socket will close the plaintext socket
1.8       foxr      136:     # too.  We also must flip into blocking mode for the duration of the
                    137:     # ssl negotiation phase.. the caller will have to flip to non block if
                    138:     # that's what they want
                    139: 
                    140:     my $oldflags = SetFdBlocking($PlaintextSocket);
                    141:     my $dupfno   = fcntl($PlaintextSocket, F_DUPFD, 0);
1.9     ! foxr      142:     Debug("Client promotion got dup = $dupfno\n");
1.8       foxr      143: 
1.6       foxr      144:     
1.8       foxr      145:     my $client = IO::Socket::SSL->new_from_fd($dupfno,
1.3       albertel  146: 					      SSL_user_cert => 1,
                    147: 					      SSL_key_file  => $KeyFile,
                    148: 					      SSL_cert_file => $MyCert,
1.8       foxr      149: 					      SSL_ca_fie    => $CACert);
1.6       foxr      150:     
1.8       foxr      151:     if(!$client) {
                    152: 	$lasterror = IO::Socket::SSL::errstr();
                    153: 	return undef;
                    154:     }
1.3       albertel  155:     return $client;		# Undef if the client negotiation fails.
1.2       foxr      156: }
                    157: 
                    158: #----------------------------------------------------------------------
                    159: # Name	PromoteServerSocket
                    160: # Description	Given an ordinary IO::Socket::INET Creates an SSL socket 
                    161: #               for a server that is connected to the same client.l
                    162: # Parameters	Name	Type	           Description
                    163: #               Socket	IO::Socket::INET   Original ordinary socket.
                    164: #               CACert	string	           Full path name to the certificate 
                    165: #                                          authority certificate file.
                    166: #                MyCert	string	           Full path name to the certificate 
                    167: #                                          issued to this host.
                    168: #                KeyFile string    	   Full pathname to the host's private 
                    169: #                                          key file for the certificate.
                    170: # Returns
                    171: #	-	Reference to an SSL socket on success
                    172: #       -	undef on failure.  Reason for failure can be interrogated from 
                    173: #               IO::Socket::SSL
1.8       foxr      174: # Side Effects:
                    175: #       Socket is left in blocking mode!!!
                    176: #
1.3       albertel  177: sub PromoteServerSocket {
1.6       foxr      178:     my ($PlaintextSocket,
                    179: 	$CACert,
                    180: 	$MyCert,
1.7       foxr      181: 	$KeyFile)          = @_;
1.6       foxr      182: 
1.3       albertel  183: 
                    184: 
                    185:     # To create the ssl socket we need to duplicate the existing
                    186:     # socket.  Otherwise closing the ssl socket will close the plaintext socket
                    187:     # too:
                    188: 
1.9     ! foxr      189:     Debug("Server promotion: Key = $KeyFile, Cert $MyCert CA $CACert\n");
1.8       foxr      190:  
                    191:     my $oldflags = SetFdBlocking($PlaintextSocket);
                    192:     my $dupfno   = fcntl($PlaintextSocket, F_DUPFD, 0);
                    193:     if (!$dupfno) {
1.9     ! foxr      194: 	Debug("dup failed: $!\n");
1.8       foxr      195:     }
1.9     ! foxr      196:     Debug(" Fileno = $dupfno\n");
1.8       foxr      197:     my $client = IO::Socket::SSL->new_from_fd($dupfno,
1.3       albertel  198: 					      SSL_server    => 1, # Server role.
                    199: 					      SSL_user_cert => 1,
                    200: 					      SSL_key_file  => $KeyFile,
                    201: 					      SSL_cert_file => $MyCert,
1.8       foxr      202: 					      SSL_ca_fie    => $CACert);
                    203:     if(!$client) {
                    204: 	$lasterror = IO::Socket::SSL::errstr();
                    205: 	return undef;
                    206:     }
1.3       albertel  207:     return $client;
1.2       foxr      208: }
                    209: 
                    210: #-------------------------------------------------------------------------
                    211: #
                    212: # Name: Close
                    213: # Description: Properly closes an ssl client or ssl server socket in
                    214: #              a way that keeps the parent socket open.
                    215: # Parameters:  Name      Type            Description
                    216: #              Socket   IO::Socket::SSL  SSL Socket gotten from either
                    217: #                                        PromoteClientSocket or 
                    218: #                                        PromoteServerSocket
                    219: # Returns:
                    220: #   NONE
                    221: #
                    222: sub Close {
1.3       albertel  223:     my $Socket = shift;
1.4       foxr      224:     
1.3       albertel  225:     $Socket->close(SSL_no_shutdown =>1); # Otherwise the parent socket 
                    226:                                          # gets torn down.
1.2       foxr      227: }
1.4       foxr      228: #---------------------------------------------------------------------------
                    229: #
                    230: # Name   	GetPeerCertificate
                    231: # Description	Inquires about the certificate of the peer of a connection.
                    232: # Parameters	Name	        Type	          Description
                    233: #               SSLSocket	IO::Socket::SSL	  SSL tunnel socket open on 
                    234: #                                                 the peer.
                    235: # Returns
                    236: #	A two element list.  The first element of the list is the name of 
                    237: #       the certificate authority.  The second element of the list is the name 
                    238: #       of the owner of the certificate.
                    239: sub GetPeerCertificate {
1.6       foxr      240:     my $SSLSocket = shift;
                    241:     
                    242:     my $CertOwner = $SSLSocket->peer_certificate("owner");
                    243:     my $CertCA    = $SSLSocket->peer_certificate("authority");
                    244:     
1.8       foxr      245:     return ($CertCA, $CertOwner);
1.4       foxr      246: }
                    247: #----------------------------------------------------------------------------
                    248: #
                    249: # Name  	CertificateFile
                    250: # Description	Locate the certificate files for this host.
                    251: # Returns
                    252: #	Returns a two element array.  The first element contains the name of
                    253: #  the certificate file for this host.  The second element contains the name
                    254: #  of the  certificate file for the CA that granted the certificate.  If 
                    255: #  either file cannot be located, returns undef.
                    256: #
                    257: sub CertificateFile {
                    258: 
1.6       foxr      259:     # I need some perl variables from the configuration file for this:
                    260:     
                    261:     my $CertificateDir  = $perlvar->{lonCertificateDirectory};
                    262:     my $CaFilename      = $perlvar->{lonnetCertificateAuthority};
                    263:     my $CertFilename    = $perlvar->{lonnetCertificate};
                    264:     
                    265:     #  Ensure the existence of these variables:
                    266:     
                    267:     if((!$CertificateDir)  || (!$CaFilename) || (!$CertFilename)) {
1.8       foxr      268: 	$lasterror = "Missing info: dir: $CertificateDir CA: $CaFilename "
                    269: 	            ."Cert: $CertFilename";
1.6       foxr      270: 	return undef;
                    271:     }
                    272:     
                    273:     #   Build the actual filenames and check for their existence and
                    274:     #   readability.
                    275:     
                    276:     my $CaFilename   = $CertificateDir.$pathsep.$CaFilename;
                    277:     my $CertFilename = $CertificateDir.$pathsep.$CertFilename;
                    278:     
                    279:     if((! -r $CaFilename) || (! -r $CertFilename)) {
1.8       foxr      280: 	$lasterror = "CA file $CaFilename or Cert File: $CertFilename "
                    281: 	            ."not readable";
1.6       foxr      282: 	return undef;
                    283:     }
                    284:     
                    285:     # Everything works fine!!
                    286:     
1.8       foxr      287:     return ($CaFilename, $CertFilename);
1.4       foxr      288: 
                    289: }
                    290: #------------------------------------------------------------------------
                    291: #
                    292: # Name	        KeyFile
                    293: # Description
                    294: #      Returns the name of the private key file of the current host.
                    295: # Returns
                    296: #      Returns the name of the key file or undef if the file cannot 
                    297: #      be found.
                    298: #
                    299: sub KeyFile {
                    300: 
1.6       foxr      301:     # I need some perl variables from the configuration file for this:
                    302:     
                    303:     my $CertificateDir   = $perlvar->{lonCertificateDirectory};
                    304:     my $KeyFilename      = $perlvar->{lonnetPrivateKey};
                    305:     
                    306:     # Ensure the variables exist:
                    307:     
                    308:     if((!$CertificateDir) || (!$KeyFilename)) {
1.8       foxr      309: 	$lasterror = "Missing parameter dir: $CertificateDir "
                    310: 	            ."key: $KeyFilename";
1.6       foxr      311: 	return undef;
                    312:     }
                    313:     
                    314:     # Build the actual filename and ensure that it not only exists but
                    315:     # is also readable:
                    316:     
                    317:     my $KeyFilename    = $CertificateDir.$pathsep.$KeyFilename;
                    318:     if(! (-r $KeyFilename)) {
1.8       foxr      319: 	$lasterror = "Unreadable key file $KeyFilename";
1.6       foxr      320: 	return undef;
                    321:     }
                    322:     
                    323:     return $KeyFilename;
1.4       foxr      324: }
1.2       foxr      325: 
1.4       foxr      326: 1;

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