# # $Id: lonssl.pm,v 1.18 2018/08/09 13:27:55 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 # 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, $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. 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. # 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 # 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, $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: 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; } #------------------------------------------------------------------------- # # 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 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,$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; } 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;