Annotation of loncom/lonssl.pm, revision 1.22

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

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