--- loncom/lonssl.pm 2018/07/29 03:03:36 1.16 +++ loncom/lonssl.pm 2018/12/11 13:05:40 1.22 @@ -1,5 +1,5 @@ # -# $Id: lonssl.pm,v 1.16 2018/07/29 03:03:36 raeburn Exp $ +# $Id: lonssl.pm,v 1.22 2018/12/11 13:05:40 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -112,11 +112,16 @@ sub SetFdBlocking { # Socket IO::Socket::INET Original ordinary socket. # CACert string Full path name to the certificate # authority certificate file. -# MyCert string Full path name to the certificate +# MyCert string Full path name to the certificate # issued to this host. -# KeyFile string Full pathname to the host's private +# KeyFile string Full pathname to the host's private # key file for the certificate. -# peer string lonHostID of remote LON-CAPA server +# peer string lonid of remote LON-CAPA server +# peerdef string default lonHostID of remote server +# CRLFile Full path name to the certificate +# revocation list file for the cluster +# to which server belongs (optional) + # Returns # - Reference to an SSL socket on success # - undef on failure. Reason for failure can be interrogated from @@ -129,10 +134,11 @@ sub PromoteClientSocket { $CACert, $MyCert, $KeyFile, - $peer) = @_; - - - Debug("Client promotion using key: $KeyFile, Cert: $MyCert, CA: $CACert, Remote Host: $peer\n"); + $peer, + $peerdef, + $CRLFile) = @_; + + Debug("Client promotion using key: $KeyFile, Cert: $MyCert, CA: $CACert, CRL: $CRLFile, Remote Host: $peer, RemoteDefHost: $peerdef\n"); # To create the ssl socket we need to duplicate the existing # socket. Otherwise closing the ssl socket will close the plaintext socket @@ -150,21 +156,31 @@ sub PromoteClientSocket { # Starting with rev. 1.95, the default became SSL_VERIFY_PEER which # prevents an SSL connection to lond unless SSL_verifycn_name is set # to the lonHostID of the remote host, (and the remote certificate has - # the remote lonHostID as CN, and has been signed by the LON-CAPA CA. + # the remote lonHostID as CN, and has been signed by the LON-CAPA CA. # Set SSL_verify_mode to Net::SSLeay::VERIFY_PEER() instead of to # SSL_VERIFY_PEER for compatibility with IO::Socket::SSL rev. 1.01 # used by CentOS/RHEL/Scientific Linux 5). - - my $client = IO::Socket::SSL->new_from_fd($dupfno, - SSL_use_cert => 1, - SSL_key_file => $KeyFile, - SSL_cert_file => $MyCert, - SSL_ca_file => $CACert, - SSL_verifycn_name => $peer, - SSL_verify_mode => Net::SSLeay::VERIFY_PEER()); - + + my $verify_cn = $peerdef; + if ($verify_cn eq '') { + $verify_cn = $peer; + } + + my %sslargs = (SSL_use_cert => 1, + SSL_key_file => $KeyFile, + SSL_cert_file => $MyCert, + SSL_ca_file => $CACert, + SSL_verifycn_name => $verify_cn, + SSL_verify_mode => Net::SSLeay::VERIFY_PEER()); + if (($CRLFile ne '') && (-e $CRLFile)) { + $sslargs{SSL_check_crl} = 1; + $sslargs{SSL_crl_file} = $CRLFile; + } + my $client = IO::Socket::SSL->new_from_fd($dupfno,%sslargs); if(!$client) { - $lasterror = IO::Socket::SSL::errstr(); + if ($IO::Socket::SSL::SSL_ERROR == -1) { + $lasterror = -1; + } return undef; } return $client; # Undef if the client negotiation fails. @@ -182,7 +198,12 @@ sub PromoteClientSocket { # issued to this host. # KeyFile string Full pathname to the host's private # key file for the certificate. -# peer string lonHostID of remote LON-CAPA client +# peer string lonHostID of remote LON-CAPA client +# CRLFile Full path name to the certificate +# revocation list file for the cluster +# to which server belongs (optional) +# clientversion LON-CAPA version running on remote +# client # Returns # - Reference to an SSL socket on success # - undef on failure. Reason for failure can be interrogated from @@ -195,9 +216,9 @@ sub PromoteServerSocket { $CACert, $MyCert, $KeyFile, - $peer) = @_; - - + $peer, + $CRLFile, + $clientversion) = @_; # To create the ssl socket we need to duplicate the existing # socket. Otherwise closing the ssl socket will close the plaintext socket @@ -211,16 +232,27 @@ sub PromoteServerSocket { Debug("dup failed: $!\n"); } Debug(" Fileno = $dupfno\n"); - my $client = IO::Socket::SSL->new_from_fd($dupfno, - SSL_server => 1, # Server role. - SSL_use_cert => 1, - SSL_key_file => $KeyFile, - SSL_cert_file => $MyCert, - SSL_ca_file => $CACert, - SSL_verifycn_name => $peer, - SSL_verify_mode => Net::SSLeay::VERIFY_PEER()); + my %sslargs = (SSL_server => 1, # Server role. + SSL_use_cert => 1, + SSL_key_file => $KeyFile, + SSL_cert_file => $MyCert, + SSL_ca_file => $CACert); + my ($major,$minor) = split(/\./,$clientversion); + if (($major < 2) || ($major == 2 && $minor < 12)) { + $sslargs{SSL_verify_mode} = Net::SSLeay::VERIFY_NONE(); + } else { + $sslargs{SSL_verifycn_name} = $peer; + $sslargs{SSL_verify_mode} = Net::SSLeay::VERIFY_PEER(); + if (($CRLFile ne '') && (-e $CRLFile)) { + $sslargs{SSL_check_crl} = 1; + $sslargs{SSL_crl_file} = $CRLFile; + } + } + my $client = IO::Socket::SSL->new_from_fd($dupfno,%sslargs); if(!$client) { - $lasterror = IO::Socket::SSL::errstr(); + if ($IO::Socket::SSL::SSL_ERROR == -1) { + $lasterror = -1; + } return undef; } return $client; @@ -342,14 +374,63 @@ sub KeyFile { return $KeyFilename; } +sub CRLFile { + + # I need some perl variables from the configuration file for this: + + my $CertificateDir = $perlvar->{lonCertificateDirectory}; + my $CRLFilename = $perlvar->{lonnetCertRevocationList}; + + # Ensure the variables exist: + + if((!$CertificateDir) || (!$CRLFilename)) { + $lasterror = "Missing parameter dir: $CertificateDir " + ."CRL file: $CRLFilename"; + return undef; + } + + # Build the actual filename and ensure that it not only exists but + # is also readable: + + $CRLFilename = $CertificateDir.$pathsep.$CRLFilename; + if(! (-r $CRLFilename)) { + $lasterror = "Unreadable key file $CRLFilename"; + return undef; + } + + return $CRLFilename; +} + +sub BadCertDir { + my $SocketDir = $perlvar->{lonSockDir}; + if (-d "$SocketDir/nosslverify/") { + return "$SocketDir/nosslverify" + } +} + +sub has_badcert_file { + my ($client) = @_; + my $SocketDir = $perlvar->{lonSockDir}; + if (-e "$SocketDir/nosslverify/$client") { + return 1; + } + return; +} + sub Read_Connect_Config { - my ($secureconf,$perlvarref) = @_; + my ($secureconf,$perlvarref,$crlchecked) = @_; return unless (ref($secureconf) eq 'HASH'); unless (ref($perlvarref) eq 'HASH') { $perlvarref = $perlvar; } - + + # Clear hash of clients in lond for which Certificate Revocation List checked + if (ref($crlcheckedref) eq 'HASH') { + foreach my $key (keys(%{$crlcheckedref})) { + delete($crlcheckedref->{$key}); + } + } # Clean out the old table first. foreach my $key (keys(%{$secureconf})) { delete($secureconf->{$key}); @@ -357,7 +438,7 @@ sub Read_Connect_Config { my $result; my $tablename = $perlvarref->{'lonTabDir'}."/connectionrules.tab"; - if (open(my $fh,"<$tablename")) { + if (open(my $fh,'<',$tablename)) { while (my $line = <$fh>) { chomp($line); my ($name,$value) = split(/=/,$line); @@ -380,7 +461,7 @@ sub Read_Host_Types { unless (ref($perlvarref) eq 'HASH') { $perlvarref = $perlvar; } - + # Clean out the old table first. foreach my $key (keys(%{$hosttypes})) { delete($hosttypes->{$key}); @@ -388,7 +469,7 @@ sub Read_Host_Types { my $result; my $tablename = $perlvarref->{'lonTabDir'}."/hosttypes.tab"; - if (open(my $fh,"<$tablename")) { + if (open(my $fh,'<',$tablename)) { while (my $line = <$fh>) { chomp($line); my ($name,$value) = split(/:/,$line);