--- loncom/lonssl.pm 2004/05/27 10:26:19 1.5
+++ loncom/lonssl.pm 2018/08/09 13:27:55 1.18
@@ -1,5 +1,5 @@
#
-# $Id: lonssl.pm,v 1.5 2004/05/27 10:26:19 foxr Exp $
+# $Id: lonssl.pm,v 1.18 2018/08/09 13:27:55 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -23,7 +23,7 @@
#
# http://www.lon-capa.org/
#
-
+package lonssl;
# lonssl.pm
# This file contains common functions used by lond and lonc when
# negotiating the exchange of the session encryption key via an
@@ -33,10 +33,14 @@
use strict;
-# CPAN modules:
+# CPAN/Standard modules:
use IO::Socket::INET;
use IO::Socket::SSL;
+use Net::SSLeay;
+
+use Fcntl;
+use POSIX;
# Loncapa modules:
@@ -49,12 +53,55 @@ my $perlvar; # this refers to the apa
my $pathsep = "/"; # We're on unix after all.
+my $DEBUG = 0; # Set to non zero to enable debug output.
+
# Initialization code:
$perlvar = LONCAPA::Configuration::read_conf('loncapa.conf');
+my $lasterror="";
+
+
+
+sub LastError {
+ return $lasterror;
+}
+
+sub Debug {
+ my $msg = shift;
+ if ($DEBUG) {
+ print STDERR $msg;
+ }
+}
+
+#-------------------------------------------------------------------------
+# Name SetFdBlocking -
+# Turn blocking mode on on the file handle. This is required for
+# SSL key negotiation.
+#
+# Parameters:
+# Handle - Reference to the handle to modify.
+# Returns:
+# prior flag settings.
+#
+sub SetFdBlocking {
+ Debug("SetFdBlocking called \n");
+ my $Handle = shift;
+
+
+
+ my $flags = fcntl($Handle, F_GETFL, 0);
+ if(!$flags) {
+ Debug("SetBLocking fcntl get faild $!\n");
+ }
+ my $newflags = $flags & (~ O_NONBLOCK); # Turn off O_NONBLOCK...
+ if(!fcntl($Handle, F_SETFL, $newflags)) {
+ Debug("Can't set non block mode $!\n");
+ }
+ return $flags;
+}
#--------------------------------------------------------------------------
#
@@ -69,36 +116,73 @@ $perlvar = LONCAPA::Configuration::read_
# 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
+# 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
# IO::Socket::SSL
+# Side effects: socket is left in blocking mode!!
+#
sub PromoteClientSocket {
- my $PlaintextSocket = shift;
- my $CACert = shift;
- my $MyCert = shift;
- my $KeyFile = shift;
+ my ($PlaintextSocket,
+ $CACert,
+ $MyCert,
+ $KeyFile,
+ $peer,
+ $CRLFile) = @_;
+
+ 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
- # too:
-
- open (DUPLICATE, "+>$PlaintextSocket");
-
- my $client = IO::Socket::SSL->new_from_fd(fileno(DUPLICATE),
- SSL_user_cert => 1,
- SSL_key_file => $KeyFile,
- SSL_cert_file => $MyCert,
- SSL_ca_fie => $$CACert);
-
+ # too. We also must flip into blocking mode for the duration of the
+ # ssl negotiation phase.. the caller will have to flip to non block if
+ # that's what they want
+
+ my $oldflags = SetFdBlocking($PlaintextSocket);
+ my $dupfno = fcntl($PlaintextSocket, F_DUPFD, 0);
+ Debug("Client promotion got dup = $dupfno\n");
+
+ # Starting with IO::Socket::SSL rev. 1.79, carp warns that a verify
+ # mode of SSL_VERIFY_NONE should be explicitly set for client, if
+ # verification is not to be used, and SSL_verify_mode is not set.
+ # 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.
+ # 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 %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) {
+ if ($IO::Socket::SSL::SSL_ERROR == -1) {
+ $lasterror = -1;
+ }
+ return undef;
+ }
return $client; # Undef if the client negotiation fails.
}
#----------------------------------------------------------------------
# Name PromoteServerSocket
# Description Given an ordinary IO::Socket::INET Creates an SSL socket
-# for a server that is connected to the same client.l
+# for a server that is connected to the same client.
# Parameters Name Type Description
# Socket IO::Socket::INET Original ordinary socket.
# CACert string Full path name to the certificate
@@ -107,29 +191,63 @@ 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
+# 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
# IO::Socket::SSL
+# Side Effects:
+# Socket is left in blocking mode!!!
+#
sub PromoteServerSocket {
- my $PlaintextSocket = shift;
- my $CACert = shift;
- my $MyCert = shift;
- my $KeyFile = shift;
-
+ my ($PlaintextSocket,
+ $CACert,
+ $MyCert,
+ $KeyFile,
+ $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
# too:
- open (DUPLICATE, "+>$PlaintextSocket");
-
- my $client = IO::Socket::SSL->new_from_fd(fileno(DUPLICATE),
- SSL_server => 1, # Server role.
- SSL_user_cert => 1,
- SSL_key_file => $KeyFile,
- SSL_cert_file => $MyCert,
- SSL_ca_fie => $$CACert);
+ Debug("Server promotion: Key = $KeyFile, Cert $MyCert CA $CACert\n");
+
+ my $oldflags = SetFdBlocking($PlaintextSocket);
+ my $dupfno = fcntl($PlaintextSocket, F_DUPFD, 0);
+ if (!$dupfno) {
+ Debug("dup failed: $!\n");
+ }
+ Debug(" Fileno = $dupfno\n");
+ 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) {
+ if ($IO::Socket::SSL::SSL_ERROR == -1) {
+ $lasterror = -1;
+ }
+ return undef;
+ }
return $client;
}
@@ -163,12 +281,12 @@ sub Close {
# the certificate authority. The second element of the list is the name
# of the owner of the certificate.
sub GetPeerCertificate {
- my $SSLSocket = shift;
-
- my $CertOwner = $SSLSocket->peer_certificate("owner");
- my $CertCA = $SSLSocket->peer_certificate("authority");
-
- return \($CertCA, $CertOwner);
+ my $SSLSocket = shift;
+
+ my $CertOwner = $SSLSocket->peer_certificate("owner");
+ my $CertCA = $SSLSocket->peer_certificate("authority");
+
+ return ($CertCA, $CertOwner);
}
#----------------------------------------------------------------------------
#
@@ -182,31 +300,35 @@ sub GetPeerCertificate {
#
sub CertificateFile {
- # I need some perl variables from the configuration file for this:
-
- my $CertificateDir = $perlvar->{lonCertificateDirectory};
- my $CaFilename = $perlvar->{lonnetCertificateAuthority};
- my $CertFilename = $perlvar->{lonnetCertificate};
-
- # Ensure the existence of these variables:
-
- if((!$CertificateDir) || (!$CaFilename) || (!$CertFilename)) {
- return undef;
- }
-
- # Build the actual filenames and check for their existence and
- # readability.
-
- my $CaFilename = $CertificateDir.$pathsep.$CaFilename;
- my $CertFilename = $CertificateDir.$pathsep.$CertFilename;
-
- if((! -r $CaFilename) || (! -r $CertFilename)) {
- return undef;
- }
-
- # Everything works fine!!
-
- return \($CaFilename, $CertFilename);
+ # I need some perl variables from the configuration file for this:
+
+ my $CertificateDir = $perlvar->{lonCertificateDirectory};
+ my $CaFilename = $perlvar->{lonnetCertificateAuthority};
+ my $CertFilename = $perlvar->{lonnetCertificate};
+
+ # Ensure the existence of these variables:
+
+ if((!$CertificateDir) || (!$CaFilename) || (!$CertFilename)) {
+ $lasterror = "Missing info: dir: $CertificateDir CA: $CaFilename "
+ ."Cert: $CertFilename";
+ return undef;
+ }
+
+ # Build the actual filenames and check for their existence and
+ # readability.
+
+ $CaFilename = $CertificateDir.$pathsep.$CaFilename;
+ $CertFilename = $CertificateDir.$pathsep.$CertFilename;
+
+ if((! -r $CaFilename) || (! -r $CertFilename)) {
+ $lasterror = "CA file $CaFilename or Cert File: $CertFilename "
+ ."not readable";
+ return undef;
+ }
+
+ # Everything works fine!!
+
+ return ($CaFilename, $CertFilename);
}
#------------------------------------------------------------------------
@@ -220,26 +342,136 @@ sub CertificateFile {
#
sub KeyFile {
- # I need some perl variables from the configuration file for this:
+ # I need some perl variables from the configuration file for this:
+
+ my $CertificateDir = $perlvar->{lonCertificateDirectory};
+ my $KeyFilename = $perlvar->{lonnetPrivateKey};
+
+ # Ensure the variables exist:
+
+ if((!$CertificateDir) || (!$KeyFilename)) {
+ $lasterror = "Missing parameter dir: $CertificateDir "
+ ."key: $KeyFilename";
+ return undef;
+ }
+
+ # Build the actual filename and ensure that it not only exists but
+ # is also readable:
+
+ $KeyFilename = $CertificateDir.$pathsep.$KeyFilename;
+ if(! (-r $KeyFilename)) {
+ $lasterror = "Unreadable key file $KeyFilename";
+ return undef;
+ }
+
+ return $KeyFilename;
+}
+
+sub CRLFile {
+
+ # I need some perl variables from the configuration file for this:
- my $CertificateDir = $perlvar->{lonCertificateDirectory};
- my $KeyFilename = $perlvar->{lonnetPrivateKey};
+ my $CertificateDir = $perlvar->{lonCertificateDirectory};
+ my $CRLFilename = $perlvar->{lonnetCertRevocationList};
- # Ensure the variables exist:
+ # Ensure the variables exist:
- if((!$CertificateDir) || (!$KeyFilename)) {
- return undef;
- }
+ 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:
+ # Build the actual filename and ensure that it not only exists but
+ # is also readable:
- my $KeyFilename = $CertificateDir.$pathsep.$KeyFilename;
- if(! (-r $KeyFilename)) {
- return undef;
- }
+ $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,$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});
+ }
+
+ my $result;
+ my $tablename = $perlvarref->{'lonTabDir'}."/connectionrules.tab";
+ if (open(my $fh,"<$tablename")) {
+ while (my $line = <$fh>) {
+ chomp($line);
+ my ($name,$value) = split(/=/,$line);
+ if ($value =~ /^(?:no|yes|req)$/) {
+ if ($name =~ /^conn(to|from)_(dom|intdom|other)$/) {
+ $secureconf->{'conn'.$1}{$2} = $value;
+ }
+ }
+ }
+ close($fh);
+ return 'ok';
+ }
+ return;
+}
- return $KeyFilename;
+sub Read_Host_Types {
+ my ($hosttypes,$perlvarref) = @_;
+ return unless (ref($hosttypes) eq 'HASH');
+
+ unless (ref($perlvarref) eq 'HASH') {
+ $perlvarref = $perlvar;
+ }
+
+ # Clean out the old table first.
+ foreach my $key (keys(%{$hosttypes})) {
+ delete($hosttypes->{$key});
+ }
+
+ my $result;
+ my $tablename = $perlvarref->{'lonTabDir'}."/hosttypes.tab";
+ if (open(my $fh,"<$tablename")) {
+ while (my $line = <$fh>) {
+ chomp($line);
+ my ($name,$value) = split(/:/,$line);
+ if (($name ne '') && ($value =~ /^(dom|intdom|other)$/)) {
+ $hosttypes->{$name} = $value;
+ }
+ }
+ close($fh);
+ return 'ok';
+ }
+ return;
}
1;