--- loncom/lonssl.pm 2004/05/26 21:45:46 1.3
+++ loncom/lonssl.pm 2018/12/10 17:34:22 1.21
@@ -1,5 +1,5 @@
#
-# $Id: lonssl.pm,v 1.3 2004/05/26 21:45:46 albertel Exp $
+# $Id: lonssl.pm,v 1.21 2018/12/10 17:34:22 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
@@ -32,10 +32,77 @@
#
use strict;
+
+# CPAN/Standard modules:
+
use IO::Socket::INET;
use IO::Socket::SSL;
+use Net::SSLeay;
+
+use Fcntl;
+use POSIX;
+
+# Loncapa modules:
+
+use LONCAPA::Configuration;
+
+# Global storage:
+
+my $perlvar; # this refers to the apache perlsetvar
+ # variable hash.
+
+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;
+}
+
#--------------------------------------------------------------------------
#
# Name PromoteClientSocket
@@ -45,40 +112,84 @@ use IO::Socket::SSL;
# 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 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
# 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,
+ $peerdef,
+ $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 $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) {
+ 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
@@ -87,29 +198,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;
}
@@ -127,8 +272,209 @@ sub PromoteServerSocket {
#
sub Close {
my $Socket = shift;
-
+
$Socket->close(SSL_no_shutdown =>1); # Otherwise the parent socket
# gets torn down.
}
+#---------------------------------------------------------------------------
+#
+# Name GetPeerCertificate
+# Description Inquires about the certificate of the peer of a connection.
+# Parameters Name Type Description
+# SSLSocket IO::Socket::SSL SSL tunnel socket open on
+# the peer.
+# Returns
+# A two element list. The first element of the list is the name of
+# 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);
+}
+#----------------------------------------------------------------------------
+#
+# Name CertificateFile
+# Description Locate the certificate files for this host.
+# Returns
+# Returns a two element array. The first element contains the name of
+# the certificate file for this host. The second element contains the name
+# of the certificate file for the CA that granted the certificate. If
+# either file cannot be located, returns undef.
+#
+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)) {
+ $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);
+
+}
+#------------------------------------------------------------------------
+#
+# Name KeyFile
+# Description
+# Returns the name of the private key file of the current host.
+# Returns
+# Returns the name of the key file or undef if the file cannot
+# be found.
+#
+sub KeyFile {
+
+ # 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 $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');
+
+ unless (ref($perlvarref) eq 'HASH') {
+ $perlvarref = $perlvar;
+ }
+
+ # 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;
+}
+
+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;
500 Internal Server Error
Internal Server Error
The server encountered an internal error or
misconfiguration and was unable to complete
your request.
Please contact the server administrator at
root@localhost to inform them of the time this error occurred,
and the actions you performed just before this error.
More information about this error may be available
in the server error log.