Annotation of loncom/lonssl.pm, revision 1.15

1.2       foxr        1: #
1.15    ! raeburn     2: # $Id: lonssl.pm,v 1.14 2015/11/08 03:15:13 raeburn 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;
1.14      raeburn    40: use Net::SSLeay;
1.2       foxr       41: 
1.8       foxr       42: use Fcntl;
                     43: use POSIX;
                     44: 
1.4       foxr       45: #  Loncapa modules:
                     46: 
                     47: use LONCAPA::Configuration;
                     48: 
                     49: #  Global storage:
                     50: 
1.5       foxr       51: my $perlvar;			#  this refers to the apache perlsetvar 
                     52:                                 # variable hash.
1.4       foxr       53: 
                     54: my $pathsep = "/";		# We're on unix after all.
                     55: 
1.9       foxr       56: my $DEBUG = 0;			# Set to non zero to enable debug output.
                     57: 
1.4       foxr       58: 
                     59: # Initialization code:
                     60: 
                     61: $perlvar = LONCAPA::Configuration::read_conf('loncapa.conf');
                     62: 
                     63: 
1.8       foxr       64: my $lasterror="";
                     65: 
                     66: 
1.9       foxr       67: 
1.8       foxr       68: sub LastError {
                     69:     return $lasterror;
                     70: }
                     71: 
1.9       foxr       72: sub Debug {
                     73:     my $msg  = shift;
                     74:     if ($DEBUG) {
                     75: 	print STDERR $msg;
                     76:     }
                     77: }
                     78: 
1.8       foxr       79: #-------------------------------------------------------------------------
                     80: # Name SetFdBlocking - 
                     81: #      Turn blocking mode on on the file handle.  This is required for
                     82: #      SSL key negotiation.
                     83: #
                     84: # Parameters:
                     85: #      Handle   - Reference to the handle to modify.
                     86: # Returns:
                     87: #      prior flag settings.
                     88: #
                     89: sub SetFdBlocking {
1.9       foxr       90:     Debug("SetFdBlocking called \n");
1.8       foxr       91:     my $Handle = shift;
                     92: 
                     93: 
                     94: 
                     95:     my $flags  = fcntl($Handle, F_GETFL, 0);
                     96:     if(!$flags) {
1.9       foxr       97: 	Debug("SetBLocking fcntl get faild $!\n");
1.8       foxr       98:     }
                     99:     my $newflags  = $flags & (~ O_NONBLOCK); # Turn off O_NONBLOCK...
                    100:     if(!fcntl($Handle, F_SETFL, $newflags)) {
1.9       foxr      101: 	Debug("Can't set non block mode  $!\n");
1.8       foxr      102:     }
                    103:     return $flags;
                    104: }
1.2       foxr      105: 
                    106: #--------------------------------------------------------------------------
                    107: #
                    108: # Name	PromoteClientSocket
                    109: # Description	Given an ordinary IO::Socket::INET Creates an SSL socket 
                    110: #               for a client that is connected to the same server.
                    111: # Parameters	Name	Type	           Description
                    112: #               Socket	IO::Socket::INET   Original ordinary socket.
                    113: #               CACert	string	           Full path name to the certificate 
                    114: #                                          authority certificate file.
                    115: #                MyCert	string	           Full path name to the certificate 
                    116: #                                          issued to this host.
                    117: #                KeyFile string    	   Full pathname to the host's private 
                    118: #                                          key file for the certificate.
                    119: # Returns
                    120: #	-	Reference to an SSL socket on success
                    121: #       -	undef on failure.  Reason for failure can be interrogated from 
                    122: #               IO::Socket::SSL
1.8       foxr      123: # Side effects:  socket is left in blocking mode!!
                    124: #
1.2       foxr      125: 
                    126: sub PromoteClientSocket {
1.6       foxr      127:     my ($PlaintextSocket,
                    128: 	$CACert,
                    129: 	$MyCert,
1.7       foxr      130: 	$KeyFile)          = @_;
1.6       foxr      131:     
                    132:     
1.9       foxr      133:     Debug("Client promotion using key: $KeyFile, Cert: $MyCert, CA: $CACert\n");
1.8       foxr      134: 
1.3       albertel  135:     # To create the ssl socket we need to duplicate the existing
                    136:     # socket.  Otherwise closing the ssl socket will close the plaintext socket
1.8       foxr      137:     # too.  We also must flip into blocking mode for the duration of the
                    138:     # ssl negotiation phase.. the caller will have to flip to non block if
                    139:     # that's what they want
                    140: 
                    141:     my $oldflags = SetFdBlocking($PlaintextSocket);
                    142:     my $dupfno   = fcntl($PlaintextSocket, F_DUPFD, 0);
1.9       foxr      143:     Debug("Client promotion got dup = $dupfno\n");
1.8       foxr      144: 
1.14      raeburn   145:     # Starting with IO::Socket::SSL rev. 1.79, carp warns that a verify 
                    146:     # mode of SSL_VERIFY_NONE should be explicitly set for client, if 
                    147:     # verification is not to be used, and SSL_verify_mode is not set.
                    148:     # Starting with rev. 1.95, the default became SSL_VERIFY_PEER which
                    149:     # prevents connections to lond.
                    150:     # Set SSL_verify_mode to Net::SSLeay::VERIFY_NONE() instead of to
                    151:     # SSL_VERIFY_NONE for compatibility with IO::Socket::SSL rev. 1.01
                    152:     # used by CentOS/RHEL/Scientific Linux 5).
1.6       foxr      153:     
1.8       foxr      154:     my $client = IO::Socket::SSL->new_from_fd($dupfno,
1.12      raeburn   155: 					      SSL_use_cert => 1,
1.3       albertel  156: 					      SSL_key_file  => $KeyFile,
                    157: 					      SSL_cert_file => $MyCert,
1.14      raeburn   158: 					      SSL_ca_file   => $CACert,
                    159: 					      SSL_verify_mode => Net::SSLeay::VERIFY_NONE());
1.6       foxr      160:     
1.8       foxr      161:     if(!$client) {
                    162: 	$lasterror = IO::Socket::SSL::errstr();
                    163: 	return undef;
                    164:     }
1.3       albertel  165:     return $client;		# Undef if the client negotiation fails.
1.2       foxr      166: }
                    167: 
                    168: #----------------------------------------------------------------------
                    169: # Name	PromoteServerSocket
                    170: # Description	Given an ordinary IO::Socket::INET Creates an SSL socket 
                    171: #               for a server that is connected to the same client.l
                    172: # Parameters	Name	Type	           Description
                    173: #               Socket	IO::Socket::INET   Original ordinary socket.
                    174: #               CACert	string	           Full path name to the certificate 
                    175: #                                          authority certificate file.
                    176: #                MyCert	string	           Full path name to the certificate 
                    177: #                                          issued to this host.
                    178: #                KeyFile string    	   Full pathname to the host's private 
                    179: #                                          key file for the certificate.
                    180: # Returns
                    181: #	-	Reference to an SSL socket on success
                    182: #       -	undef on failure.  Reason for failure can be interrogated from 
                    183: #               IO::Socket::SSL
1.8       foxr      184: # Side Effects:
                    185: #       Socket is left in blocking mode!!!
                    186: #
1.3       albertel  187: sub PromoteServerSocket {
1.6       foxr      188:     my ($PlaintextSocket,
                    189: 	$CACert,
                    190: 	$MyCert,
1.7       foxr      191: 	$KeyFile)          = @_;
1.6       foxr      192: 
1.3       albertel  193: 
                    194: 
                    195:     # To create the ssl socket we need to duplicate the existing
                    196:     # socket.  Otherwise closing the ssl socket will close the plaintext socket
                    197:     # too:
                    198: 
1.9       foxr      199:     Debug("Server promotion: Key = $KeyFile, Cert $MyCert CA $CACert\n");
1.8       foxr      200:  
                    201:     my $oldflags = SetFdBlocking($PlaintextSocket);
                    202:     my $dupfno   = fcntl($PlaintextSocket, F_DUPFD, 0);
                    203:     if (!$dupfno) {
1.9       foxr      204: 	Debug("dup failed: $!\n");
1.8       foxr      205:     }
1.9       foxr      206:     Debug(" Fileno = $dupfno\n");
1.8       foxr      207:     my $client = IO::Socket::SSL->new_from_fd($dupfno,
1.3       albertel  208: 					      SSL_server    => 1, # Server role.
1.13      raeburn   209: 					      SSL_use_cert  => 1,
1.3       albertel  210: 					      SSL_key_file  => $KeyFile,
                    211: 					      SSL_cert_file => $MyCert,
1.11      raeburn   212: 					      SSL_ca_file   => $CACert);
1.8       foxr      213:     if(!$client) {
                    214: 	$lasterror = IO::Socket::SSL::errstr();
                    215: 	return undef;
                    216:     }
1.3       albertel  217:     return $client;
1.2       foxr      218: }
                    219: 
                    220: #-------------------------------------------------------------------------
                    221: #
                    222: # Name: Close
                    223: # Description: Properly closes an ssl client or ssl server socket in
                    224: #              a way that keeps the parent socket open.
                    225: # Parameters:  Name      Type            Description
                    226: #              Socket   IO::Socket::SSL  SSL Socket gotten from either
                    227: #                                        PromoteClientSocket or 
                    228: #                                        PromoteServerSocket
                    229: # Returns:
                    230: #   NONE
                    231: #
                    232: sub Close {
1.3       albertel  233:     my $Socket = shift;
1.4       foxr      234:     
1.3       albertel  235:     $Socket->close(SSL_no_shutdown =>1); # Otherwise the parent socket 
                    236:                                          # gets torn down.
1.2       foxr      237: }
1.4       foxr      238: #---------------------------------------------------------------------------
                    239: #
                    240: # Name   	GetPeerCertificate
                    241: # Description	Inquires about the certificate of the peer of a connection.
                    242: # Parameters	Name	        Type	          Description
                    243: #               SSLSocket	IO::Socket::SSL	  SSL tunnel socket open on 
                    244: #                                                 the peer.
                    245: # Returns
                    246: #	A two element list.  The first element of the list is the name of 
                    247: #       the certificate authority.  The second element of the list is the name 
                    248: #       of the owner of the certificate.
                    249: sub GetPeerCertificate {
1.6       foxr      250:     my $SSLSocket = shift;
                    251:     
                    252:     my $CertOwner = $SSLSocket->peer_certificate("owner");
                    253:     my $CertCA    = $SSLSocket->peer_certificate("authority");
                    254:     
1.8       foxr      255:     return ($CertCA, $CertOwner);
1.4       foxr      256: }
                    257: #----------------------------------------------------------------------------
                    258: #
                    259: # Name  	CertificateFile
                    260: # Description	Locate the certificate files for this host.
                    261: # Returns
                    262: #	Returns a two element array.  The first element contains the name of
                    263: #  the certificate file for this host.  The second element contains the name
                    264: #  of the  certificate file for the CA that granted the certificate.  If 
                    265: #  either file cannot be located, returns undef.
                    266: #
                    267: sub CertificateFile {
                    268: 
1.6       foxr      269:     # I need some perl variables from the configuration file for this:
                    270:     
                    271:     my $CertificateDir  = $perlvar->{lonCertificateDirectory};
                    272:     my $CaFilename      = $perlvar->{lonnetCertificateAuthority};
                    273:     my $CertFilename    = $perlvar->{lonnetCertificate};
                    274:     
                    275:     #  Ensure the existence of these variables:
                    276:     
                    277:     if((!$CertificateDir)  || (!$CaFilename) || (!$CertFilename)) {
1.8       foxr      278: 	$lasterror = "Missing info: dir: $CertificateDir CA: $CaFilename "
                    279: 	            ."Cert: $CertFilename";
1.6       foxr      280: 	return undef;
                    281:     }
                    282:     
                    283:     #   Build the actual filenames and check for their existence and
                    284:     #   readability.
                    285:     
1.10      albertel  286:     $CaFilename   = $CertificateDir.$pathsep.$CaFilename;
                    287:     $CertFilename = $CertificateDir.$pathsep.$CertFilename;
1.6       foxr      288:     
                    289:     if((! -r $CaFilename) || (! -r $CertFilename)) {
1.8       foxr      290: 	$lasterror = "CA file $CaFilename or Cert File: $CertFilename "
                    291: 	            ."not readable";
1.6       foxr      292: 	return undef;
                    293:     }
                    294:     
                    295:     # Everything works fine!!
                    296:     
1.8       foxr      297:     return ($CaFilename, $CertFilename);
1.4       foxr      298: 
                    299: }
                    300: #------------------------------------------------------------------------
                    301: #
                    302: # Name	        KeyFile
                    303: # Description
                    304: #      Returns the name of the private key file of the current host.
                    305: # Returns
                    306: #      Returns the name of the key file or undef if the file cannot 
                    307: #      be found.
                    308: #
                    309: sub KeyFile {
                    310: 
1.6       foxr      311:     # I need some perl variables from the configuration file for this:
                    312:     
                    313:     my $CertificateDir   = $perlvar->{lonCertificateDirectory};
                    314:     my $KeyFilename      = $perlvar->{lonnetPrivateKey};
                    315:     
                    316:     # Ensure the variables exist:
                    317:     
                    318:     if((!$CertificateDir) || (!$KeyFilename)) {
1.8       foxr      319: 	$lasterror = "Missing parameter dir: $CertificateDir "
                    320: 	            ."key: $KeyFilename";
1.6       foxr      321: 	return undef;
                    322:     }
                    323:     
                    324:     # Build the actual filename and ensure that it not only exists but
                    325:     # is also readable:
                    326:     
1.10      albertel  327:     $KeyFilename    = $CertificateDir.$pathsep.$KeyFilename;
1.6       foxr      328:     if(! (-r $KeyFilename)) {
1.8       foxr      329: 	$lasterror = "Unreadable key file $KeyFilename";
1.6       foxr      330: 	return undef;
                    331:     }
                    332:     
                    333:     return $KeyFilename;
1.4       foxr      334: }
1.2       foxr      335: 
1.15    ! raeburn   336: sub Read_Connect_Config {
        !           337:     my ($secureconf,$perlvarref) = @_;
        !           338:     return unless (ref($secureconf) eq 'HASH');
        !           339: 
        !           340:     unless (ref($perlvarref) eq 'HASH') {
        !           341:         $perlvarref = $perlvar;
        !           342:     }
        !           343:     
        !           344:     # Clean out the old table first.
        !           345:     foreach my $key (keys(%{$secureconf})) {
        !           346:         delete($secureconf->{$key});
        !           347:     }
        !           348: 
        !           349:     my $result;
        !           350:     my $tablename = $perlvarref->{'lonTabDir'}."/connectionrules.tab";
        !           351:     if (open(my $fh,"<$tablename")) {
        !           352:         while (my $line = <$fh>) {
        !           353:             chomp($line);
        !           354:             my ($name,$value) = split(/=/,$line);
        !           355:             if ($value =~ /^(?:no|yes|req)$/) {
        !           356:                 if ($name =~ /^conn(to|from)_(dom|intdom|other)$/) {
        !           357:                     $secureconf->{'conn'.$1}{$2} = $value;
        !           358:                 }
        !           359:             }
        !           360:         }
        !           361:         close($fh);
        !           362:         return 'ok';
        !           363:     }
        !           364:     return;
        !           365: }
        !           366: 
        !           367: sub Read_Host_Types {
        !           368:     my ($hosttypes,$perlvarref) = @_;
        !           369:     return unless (ref($hosttypes) eq 'HASH');
        !           370: 
        !           371:     unless (ref($perlvarref) eq 'HASH') {
        !           372:         $perlvarref = $perlvar;
        !           373:     }
        !           374:    
        !           375:     # Clean out the old table first.
        !           376:     foreach my $key (keys(%{$hosttypes})) {
        !           377:         delete($hosttypes->{$key});
        !           378:     }
        !           379: 
        !           380:     my $result;
        !           381:     my $tablename = $perlvarref->{'lonTabDir'}."/hosttypes.tab";
        !           382:     if (open(my $fh,"<$tablename")) {
        !           383:         while (my $line = <$fh>) {
        !           384:             chomp($line);
        !           385:             my ($name,$value) = split(/:/,$line);
        !           386:             if (($name ne '') && ($value =~ /^(dom|intdom|other)$/)) { 
        !           387:                 $hosttypes->{$name} = $value;
        !           388:             }
        !           389:         }
        !           390:         close($fh);
        !           391:         return 'ok';
        !           392:     }
        !           393:     return;
        !           394: }
        !           395: 
1.4       foxr      396: 1;

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