--- loncom/lonssl.pm 2018/07/29 03:03:36 1.16
+++ loncom/lonssl.pm 2018/08/07 17:12:08 1.17
@@ -1,5 +1,5 @@
#
-# $Id: lonssl.pm,v 1.16 2018/07/29 03:03:36 raeburn Exp $
+# $Id: lonssl.pm,v 1.17 2018/08/07 17:12:08 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -116,7 +116,11 @@ sub SetFdBlocking {
# 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 server
+# peer string lonHostID of remote LON-CAPA 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 +133,11 @@ sub PromoteClientSocket {
$CACert,
$MyCert,
$KeyFile,
- $peer) = @_;
+ $peer,
+ $CRLFile) = @_;
- Debug("Client promotion using key: $KeyFile, Cert: $MyCert, CA: $CACert, Remote Host: $peer\n");
+ Debug("Client promotion using key: $KeyFile, Cert: $MyCert, CA: $CACert, CRL: $CRLFile, Remote Host: $peer\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 +155,26 @@ 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 %sslargs = (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());
+ 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 +192,10 @@ 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)
# Returns
# - Reference to an SSL socket on success
# - undef on failure. Reason for failure can be interrogated from
@@ -195,7 +208,8 @@ sub PromoteServerSocket {
$CACert,
$MyCert,
$KeyFile,
- $peer) = @_;
+ $peer,
+ $CRLFile) = @_;
@@ -211,16 +225,22 @@ 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,
+ SSL_verifycn_name => $peer,
+ 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 +362,61 @@ 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) = @_;
- return unless (ref($secureconf) eq 'HASH');
+ my ($secureconf,$checkedcrl,$perlvarref) = @_;
+ return unless ((ref($secureconf) eq 'HASH') && (ref($checkedcrl) eq 'HASH'));
unless (ref($perlvarref) eq 'HASH') {
$perlvarref = $perlvar;
}
-
+
+ # Clear hash of clients for which Certificate Revocation List checked
+ foreach my $key (keys(%{$checkedcrl})) {
+ delete($checkedcrl->{$key});
+ }
# Clean out the old table first.
foreach my $key (keys(%{$secureconf})) {
delete($secureconf->{$key});