Annotation of loncom/lonssl.pm, revision 1.19

1.2       foxr        1: #
1.19    ! raeburn     2: # $Id: lonssl.pm,v 1.18 2018/08/09 13:27:55 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.
1.17      raeburn   119: #               peer    string             lonHostID of remote LON-CAPA server
                    120: #               CRLFile                    Full path name to the certificate
                    121: #                                          revocation list file for the cluster
                    122: #                                          to which server belongs (optional)
                    123: 
1.2       foxr      124: # Returns
                    125: #	-	Reference to an SSL socket on success
                    126: #       -	undef on failure.  Reason for failure can be interrogated from 
                    127: #               IO::Socket::SSL
1.8       foxr      128: # Side effects:  socket is left in blocking mode!!
                    129: #
1.2       foxr      130: 
                    131: sub PromoteClientSocket {
1.6       foxr      132:     my ($PlaintextSocket,
                    133: 	$CACert,
                    134: 	$MyCert,
1.16      raeburn   135: 	$KeyFile,
1.17      raeburn   136:         $peer,
1.18      raeburn   137:         $CRLFile) = @_;
                    138: 
1.17      raeburn   139:     Debug("Client promotion using key: $KeyFile, Cert: $MyCert, CA: $CACert, CRL: $CRLFile, Remote Host: $peer\n");
1.8       foxr      140: 
1.3       albertel  141:     # To create the ssl socket we need to duplicate the existing
                    142:     # socket.  Otherwise closing the ssl socket will close the plaintext socket
1.8       foxr      143:     # too.  We also must flip into blocking mode for the duration of the
                    144:     # ssl negotiation phase.. the caller will have to flip to non block if
                    145:     # that's what they want
                    146: 
                    147:     my $oldflags = SetFdBlocking($PlaintextSocket);
                    148:     my $dupfno   = fcntl($PlaintextSocket, F_DUPFD, 0);
1.9       foxr      149:     Debug("Client promotion got dup = $dupfno\n");
1.8       foxr      150: 
1.14      raeburn   151:     # Starting with IO::Socket::SSL rev. 1.79, carp warns that a verify 
                    152:     # mode of SSL_VERIFY_NONE should be explicitly set for client, if 
                    153:     # verification is not to be used, and SSL_verify_mode is not set.
                    154:     # Starting with rev. 1.95, the default became SSL_VERIFY_PEER which
1.16      raeburn   155:     # prevents an SSL connection to lond unless SSL_verifycn_name is set
                    156:     # to the lonHostID of the remote host, (and the remote certificate has
1.17      raeburn   157:     # the remote lonHostID as CN, and has been signed by the LON-CAPA CA.
1.16      raeburn   158:     # Set SSL_verify_mode to Net::SSLeay::VERIFY_PEER() instead of to
                    159:     # SSL_VERIFY_PEER for compatibility with IO::Socket::SSL rev. 1.01
1.14      raeburn   160:     # used by CentOS/RHEL/Scientific Linux 5).
1.6       foxr      161:     
1.17      raeburn   162:     my %sslargs = (SSL_use_cert      => 1,
                    163:                    SSL_key_file      => $KeyFile,
                    164:                    SSL_cert_file     => $MyCert,
                    165:                    SSL_ca_file       => $CACert,
                    166:                    SSL_verifycn_name => $peer,
                    167:                    SSL_verify_mode   => Net::SSLeay::VERIFY_PEER());
                    168:     if (($CRLFile ne '') && (-e $CRLFile)) {
                    169:         $sslargs{SSL_check_crl} = 1;
                    170:         $sslargs{SSL_crl_file} = $CRLFile;
                    171:     }
                    172:     my $client = IO::Socket::SSL->new_from_fd($dupfno,%sslargs);
1.8       foxr      173:     if(!$client) {
1.17      raeburn   174:         if ($IO::Socket::SSL::SSL_ERROR == -1) {
                    175: 	    $lasterror = -1;
                    176:         }
1.8       foxr      177: 	return undef;
                    178:     }
1.3       albertel  179:     return $client;		# Undef if the client negotiation fails.
1.2       foxr      180: }
                    181: 
                    182: #----------------------------------------------------------------------
                    183: # Name	PromoteServerSocket
                    184: # Description	Given an ordinary IO::Socket::INET Creates an SSL socket 
1.16      raeburn   185: #               for a server that is connected to the same client.
1.2       foxr      186: # Parameters	Name	Type	           Description
                    187: #               Socket	IO::Socket::INET   Original ordinary socket.
                    188: #               CACert	string	           Full path name to the certificate 
                    189: #                                          authority certificate file.
                    190: #                MyCert	string	           Full path name to the certificate 
                    191: #                                          issued to this host.
                    192: #                KeyFile string    	   Full pathname to the host's private 
                    193: #                                          key file for the certificate.
1.17      raeburn   194: #               peer   string              lonHostID of remote LON-CAPA client
                    195: #               CRLFile                    Full path name to the certificate
                    196: #                                          revocation list file for the cluster
                    197: #                                          to which server belongs (optional)
1.18      raeburn   198: #               clientversion              LON-CAPA version running on remote
                    199: #                                          client
1.2       foxr      200: # Returns
                    201: #	-	Reference to an SSL socket on success
                    202: #       -	undef on failure.  Reason for failure can be interrogated from 
                    203: #               IO::Socket::SSL
1.8       foxr      204: # Side Effects:
                    205: #       Socket is left in blocking mode!!!
                    206: #
1.3       albertel  207: sub PromoteServerSocket {
1.6       foxr      208:     my ($PlaintextSocket,
                    209: 	$CACert,
                    210: 	$MyCert,
1.16      raeburn   211: 	$KeyFile,
1.17      raeburn   212:         $peer,
1.18      raeburn   213:         $CRLFile,
                    214:         $clientversion) = @_;
1.3       albertel  215: 
                    216:     # To create the ssl socket we need to duplicate the existing
                    217:     # socket.  Otherwise closing the ssl socket will close the plaintext socket
                    218:     # too:
                    219: 
1.9       foxr      220:     Debug("Server promotion: Key = $KeyFile, Cert $MyCert CA $CACert\n");
1.8       foxr      221:  
                    222:     my $oldflags = SetFdBlocking($PlaintextSocket);
                    223:     my $dupfno   = fcntl($PlaintextSocket, F_DUPFD, 0);
                    224:     if (!$dupfno) {
1.9       foxr      225: 	Debug("dup failed: $!\n");
1.8       foxr      226:     }
1.9       foxr      227:     Debug(" Fileno = $dupfno\n");
1.17      raeburn   228:     my %sslargs = (SSL_server        => 1, # Server role.
                    229:                    SSL_use_cert      => 1,
                    230:                    SSL_key_file      => $KeyFile,
                    231:                    SSL_cert_file     => $MyCert,
1.18      raeburn   232:                    SSL_ca_file       => $CACert);
                    233:     my ($major,$minor) = split(/\./,$clientversion);
                    234:     if (($major < 2) || ($major == 2 && $minor < 12)) {
                    235:         $sslargs{SSL_verify_mode} = Net::SSLeay::VERIFY_NONE();
                    236:     } else {
                    237:         $sslargs{SSL_verifycn_name} = $peer;
                    238:         $sslargs{SSL_verify_mode} = Net::SSLeay::VERIFY_PEER();
                    239:         if (($CRLFile ne '') && (-e $CRLFile)) {
                    240:             $sslargs{SSL_check_crl} = 1;
                    241:             $sslargs{SSL_crl_file} = $CRLFile; 
                    242:         }
1.17      raeburn   243:     }
                    244:     my $client = IO::Socket::SSL->new_from_fd($dupfno,%sslargs);
1.8       foxr      245:     if(!$client) {
1.17      raeburn   246:         if ($IO::Socket::SSL::SSL_ERROR == -1) {
                    247:             $lasterror = -1;
                    248:         }
1.8       foxr      249: 	return undef;
                    250:     }
1.3       albertel  251:     return $client;
1.2       foxr      252: }
                    253: 
                    254: #-------------------------------------------------------------------------
                    255: #
                    256: # Name: Close
                    257: # Description: Properly closes an ssl client or ssl server socket in
                    258: #              a way that keeps the parent socket open.
                    259: # Parameters:  Name      Type            Description
                    260: #              Socket   IO::Socket::SSL  SSL Socket gotten from either
                    261: #                                        PromoteClientSocket or 
                    262: #                                        PromoteServerSocket
                    263: # Returns:
                    264: #   NONE
                    265: #
                    266: sub Close {
1.3       albertel  267:     my $Socket = shift;
1.4       foxr      268:     
1.3       albertel  269:     $Socket->close(SSL_no_shutdown =>1); # Otherwise the parent socket 
                    270:                                          # gets torn down.
1.2       foxr      271: }
1.4       foxr      272: #---------------------------------------------------------------------------
                    273: #
                    274: # Name   	GetPeerCertificate
                    275: # Description	Inquires about the certificate of the peer of a connection.
                    276: # Parameters	Name	        Type	          Description
                    277: #               SSLSocket	IO::Socket::SSL	  SSL tunnel socket open on 
                    278: #                                                 the peer.
                    279: # Returns
                    280: #	A two element list.  The first element of the list is the name of 
                    281: #       the certificate authority.  The second element of the list is the name 
                    282: #       of the owner of the certificate.
                    283: sub GetPeerCertificate {
1.6       foxr      284:     my $SSLSocket = shift;
                    285:     
                    286:     my $CertOwner = $SSLSocket->peer_certificate("owner");
                    287:     my $CertCA    = $SSLSocket->peer_certificate("authority");
                    288:     
1.8       foxr      289:     return ($CertCA, $CertOwner);
1.4       foxr      290: }
                    291: #----------------------------------------------------------------------------
                    292: #
                    293: # Name  	CertificateFile
                    294: # Description	Locate the certificate files for this host.
                    295: # Returns
                    296: #	Returns a two element array.  The first element contains the name of
                    297: #  the certificate file for this host.  The second element contains the name
                    298: #  of the  certificate file for the CA that granted the certificate.  If 
                    299: #  either file cannot be located, returns undef.
                    300: #
                    301: sub CertificateFile {
                    302: 
1.6       foxr      303:     # I need some perl variables from the configuration file for this:
                    304:     
                    305:     my $CertificateDir  = $perlvar->{lonCertificateDirectory};
                    306:     my $CaFilename      = $perlvar->{lonnetCertificateAuthority};
                    307:     my $CertFilename    = $perlvar->{lonnetCertificate};
                    308:     
                    309:     #  Ensure the existence of these variables:
                    310:     
                    311:     if((!$CertificateDir)  || (!$CaFilename) || (!$CertFilename)) {
1.8       foxr      312: 	$lasterror = "Missing info: dir: $CertificateDir CA: $CaFilename "
                    313: 	            ."Cert: $CertFilename";
1.6       foxr      314: 	return undef;
                    315:     }
                    316:     
                    317:     #   Build the actual filenames and check for their existence and
                    318:     #   readability.
                    319:     
1.10      albertel  320:     $CaFilename   = $CertificateDir.$pathsep.$CaFilename;
                    321:     $CertFilename = $CertificateDir.$pathsep.$CertFilename;
1.6       foxr      322:     
                    323:     if((! -r $CaFilename) || (! -r $CertFilename)) {
1.8       foxr      324: 	$lasterror = "CA file $CaFilename or Cert File: $CertFilename "
                    325: 	            ."not readable";
1.6       foxr      326: 	return undef;
                    327:     }
                    328:     
                    329:     # Everything works fine!!
                    330:     
1.8       foxr      331:     return ($CaFilename, $CertFilename);
1.4       foxr      332: 
                    333: }
                    334: #------------------------------------------------------------------------
                    335: #
                    336: # Name	        KeyFile
                    337: # Description
                    338: #      Returns the name of the private key file of the current host.
                    339: # Returns
                    340: #      Returns the name of the key file or undef if the file cannot 
                    341: #      be found.
                    342: #
                    343: sub KeyFile {
                    344: 
1.6       foxr      345:     # I need some perl variables from the configuration file for this:
                    346:     
                    347:     my $CertificateDir   = $perlvar->{lonCertificateDirectory};
                    348:     my $KeyFilename      = $perlvar->{lonnetPrivateKey};
                    349:     
                    350:     # Ensure the variables exist:
                    351:     
                    352:     if((!$CertificateDir) || (!$KeyFilename)) {
1.8       foxr      353: 	$lasterror = "Missing parameter dir: $CertificateDir "
                    354: 	            ."key: $KeyFilename";
1.6       foxr      355: 	return undef;
                    356:     }
                    357:     
                    358:     # Build the actual filename and ensure that it not only exists but
                    359:     # is also readable:
                    360:     
1.10      albertel  361:     $KeyFilename    = $CertificateDir.$pathsep.$KeyFilename;
1.6       foxr      362:     if(! (-r $KeyFilename)) {
1.8       foxr      363: 	$lasterror = "Unreadable key file $KeyFilename";
1.6       foxr      364: 	return undef;
                    365:     }
                    366:     
                    367:     return $KeyFilename;
1.4       foxr      368: }
1.2       foxr      369: 
1.17      raeburn   370: sub CRLFile {
                    371: 
                    372:     # I need some perl variables from the configuration file for this:
                    373: 
                    374:     my $CertificateDir   = $perlvar->{lonCertificateDirectory};
                    375:     my $CRLFilename      = $perlvar->{lonnetCertRevocationList};
                    376: 
                    377:     # Ensure the variables exist:
                    378: 
                    379:     if((!$CertificateDir) || (!$CRLFilename)) {
                    380:         $lasterror = "Missing parameter dir: $CertificateDir "
                    381:                     ."CRL file: $CRLFilename";
                    382:         return undef;
                    383:     }
                    384: 
                    385:     # Build the actual filename and ensure that it not only exists but
                    386:     # is also readable:
                    387: 
                    388:     $CRLFilename    = $CertificateDir.$pathsep.$CRLFilename;
                    389:     if(! (-r $CRLFilename)) {
                    390:         $lasterror = "Unreadable key file $CRLFilename";
                    391:         return undef;
                    392:     }
                    393: 
                    394:     return $CRLFilename;
                    395: }
                    396: 
                    397: sub BadCertDir {
                    398:     my $SocketDir = $perlvar->{lonSockDir};
                    399:     if (-d "$SocketDir/nosslverify/") {
                    400:         return "$SocketDir/nosslverify"
                    401:     }
                    402: }
                    403: 
                    404: sub has_badcert_file {
                    405:     my ($client) = @_;
                    406:     my $SocketDir = $perlvar->{lonSockDir};
                    407:     if (-e "$SocketDir/nosslverify/$client") {
                    408:         return 1;
                    409:     }
                    410:     return;
                    411: }
                    412: 
1.15      raeburn   413: sub Read_Connect_Config {
1.19    ! raeburn   414:     my ($secureconf,$perlvarref) = @_;
        !           415:     return unless (ref($secureconf) eq 'HASH');
1.15      raeburn   416: 
                    417:     unless (ref($perlvarref) eq 'HASH') {
                    418:         $perlvarref = $perlvar;
                    419:     }
1.17      raeburn   420: 
1.15      raeburn   421:     # Clean out the old table first.
                    422:     foreach my $key (keys(%{$secureconf})) {
                    423:         delete($secureconf->{$key});
                    424:     }
                    425: 
                    426:     my $result;
                    427:     my $tablename = $perlvarref->{'lonTabDir'}."/connectionrules.tab";
                    428:     if (open(my $fh,"<$tablename")) {
                    429:         while (my $line = <$fh>) {
                    430:             chomp($line);
                    431:             my ($name,$value) = split(/=/,$line);
                    432:             if ($value =~ /^(?:no|yes|req)$/) {
                    433:                 if ($name =~ /^conn(to|from)_(dom|intdom|other)$/) {
                    434:                     $secureconf->{'conn'.$1}{$2} = $value;
                    435:                 }
                    436:             }
                    437:         }
                    438:         close($fh);
                    439:         return 'ok';
                    440:     }
                    441:     return;
                    442: }
                    443: 
                    444: sub Read_Host_Types {
                    445:     my ($hosttypes,$perlvarref) = @_;
                    446:     return unless (ref($hosttypes) eq 'HASH');
                    447: 
                    448:     unless (ref($perlvarref) eq 'HASH') {
                    449:         $perlvarref = $perlvar;
                    450:     }
                    451:    
                    452:     # Clean out the old table first.
                    453:     foreach my $key (keys(%{$hosttypes})) {
                    454:         delete($hosttypes->{$key});
                    455:     }
                    456: 
                    457:     my $result;
                    458:     my $tablename = $perlvarref->{'lonTabDir'}."/hosttypes.tab";
                    459:     if (open(my $fh,"<$tablename")) {
                    460:         while (my $line = <$fh>) {
                    461:             chomp($line);
                    462:             my ($name,$value) = split(/:/,$line);
                    463:             if (($name ne '') && ($value =~ /^(dom|intdom|other)$/)) { 
                    464:                 $hosttypes->{$name} = $value;
                    465:             }
                    466:         }
                    467:         close($fh);
                    468:         return 'ok';
                    469:     }
                    470:     return;
                    471: }
                    472: 
1.4       foxr      473: 1;

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