--- loncom/lonssl.pm 2018/08/20 18:53:20 1.19
+++ loncom/lonssl.pm 2018/12/14 02:05:38 1.24
@@ -1,5 +1,5 @@
#
-# $Id: lonssl.pm,v 1.19 2018/08/20 18:53:20 raeburn Exp $
+# $Id: lonssl.pm,v 1.24 2018/12/14 02:05:38 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -112,14 +112,17 @@ 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)
+# serverversion LON-CAPA version running on remote
+# server.
# Returns
# - Reference to an SSL socket on success
@@ -134,9 +137,11 @@ sub PromoteClientSocket {
$MyCert,
$KeyFile,
$peer,
- $CRLFile) = @_;
+ $peerdef,
+ $CRLFile,
+ $serverversion) = @_;
- Debug("Client promotion using key: $KeyFile, Cert: $MyCert, CA: $CACert, CRL: $CRLFile, Remote Host: $peer\n");
+ Debug("Client promotion using key: $KeyFile, Cert: $MyCert, CA: $CACert, CRL: $CRLFile, Remote Host: $peer, RemoteDefHost: $peerdef, RemoteLCVersion: $serverversion\n");
# To create the ssl socket we need to duplicate the existing
# socket. Otherwise closing the ssl socket will close the plaintext socket
@@ -158,18 +163,33 @@ sub PromoteClientSocket {
# 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 $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 => $peer,
- SSL_verify_mode => Net::SSLeay::VERIFY_PEER());
- if (($CRLFile ne '') && (-e $CRLFile)) {
- $sslargs{SSL_check_crl} = 1;
- $sslargs{SSL_crl_file} = $CRLFile;
+ SSL_ca_file => $CACert);
+ my ($major,$minor) = split(/\./,$serverversion);
+ if (($major < 2) || ($major == 2 && $minor < 12)) {
+ $sslargs{SSL_verify_mode} = Net::SSLeay::VERIFY_NONE();
+ } else {
+ $sslargs{SSL_verifycn_scheme} = 'http',
+ $sslargs{SSL_verifycn_name} = $verify_cn,
+ $sslargs{SSL_verify_mode} = Net::SSLeay::VERIFY_PEER();
+ if (($CRLFile ne '') && (-e $CRLFile)) {
+ $sslargs{SSL_check_crl} = 1;
+ $sslargs{SSL_crl_file} = $CRLFile;
+ }
}
+# Uncomment next two $IO::Socket::SSL::DEBUG lines, for debugging
+# $IO::Socket::SSL::DEBUG = 0; # Set to integer >0 and <4
+# # to write debugging to lonc_errors
my $client = IO::Socket::SSL->new_from_fd($dupfno,%sslargs);
+# $IO::Socket::SSL::DEBUG = 0; # Do not change
if(!$client) {
if ($IO::Socket::SSL::SSL_ERROR == -1) {
$lasterror = -1;
@@ -234,14 +254,19 @@ sub PromoteServerSocket {
if (($major < 2) || ($major == 2 && $minor < 12)) {
$sslargs{SSL_verify_mode} = Net::SSLeay::VERIFY_NONE();
} else {
+ $sslargs{SSL_verifycn_scheme} = 'http';
$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;
+ $sslargs{SSL_crl_file} = $CRLFile;
}
}
+# Uncomment next two $IO::Socket::SSL::DEBUG lines, for debugging
+# $IO::Socket::SSL::DEBUG = 0; # Set to integer >0 and <4
+# # to write debugging to lond_errors
my $client = IO::Socket::SSL->new_from_fd($dupfno,%sslargs);
+# $IO::Socket::SSL::DEBUG = 0; # Do not change
if(!$client) {
if ($IO::Socket::SSL::SSL_ERROR == -1) {
$lasterror = -1;
@@ -411,13 +436,19 @@ sub has_badcert_file {
}
sub Read_Connect_Config {
- my ($secureconf,$perlvarref) = @_;
+ my ($secureconf,$perlvarref,$crlcheckedref) = @_;
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});
@@ -425,7 +456,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);
@@ -448,7 +479,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});
@@ -456,7 +487,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);