--- loncom/lonssl.pm 2004/05/26 10:19:54 1.1
+++ loncom/lonssl.pm 2018/07/29 03:03:36 1.16
@@ -0,0 +1,405 @@
+#
+# $Id: lonssl.pm,v 1.16 2018/07/29 03:03:36 raeburn Exp $
+#
+# Copyright Michigan State University Board of Trustees
+#
+# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
+#
+# LON-CAPA is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# LON-CAPA is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with LON-CAPA; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+# /home/httpd/html/adm/gpl.txt
+#
+# 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
+# SSL tunnel.
+# See the POD sections and function documentation for more information.
+#
+
+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
+# Description Given an ordinary IO::Socket::INET Creates an SSL socket
+# for a client that is connected to the same server.
+# Parameters Name Type Description
+# 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
+# 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
+# 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,
+ $CACert,
+ $MyCert,
+ $KeyFile,
+ $peer) = @_;
+
+
+ Debug("Client promotion using key: $KeyFile, Cert: $MyCert, CA: $CACert, 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. 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 $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());
+
+ if(!$client) {
+ $lasterror = IO::Socket::SSL::errstr();
+ 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.
+# Parameters Name Type Description
+# 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
+# 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
+# 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,
+ $CACert,
+ $MyCert,
+ $KeyFile,
+ $peer) = @_;
+
+
+
+ # To create the ssl socket we need to duplicate the existing
+ # socket. Otherwise closing the ssl socket will close the plaintext socket
+ # too:
+
+ 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 $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());
+ if(!$client) {
+ $lasterror = IO::Socket::SSL::errstr();
+ return undef;
+ }
+ return $client;
+}
+
+#-------------------------------------------------------------------------
+#
+# Name: Close
+# Description: Properly closes an ssl client or ssl server socket in
+# a way that keeps the parent socket open.
+# Parameters: Name Type Description
+# Socket IO::Socket::SSL SSL Socket gotten from either
+# PromoteClientSocket or
+# PromoteServerSocket
+# Returns:
+# NONE
+#
+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 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;