--- loncom/lonssl.pm 2004/05/28 09:37:03 1.6 +++ loncom/lonssl.pm 2018/12/11 15:15:26 1.23 @@ -1,5 +1,5 @@ # -# $Id: lonssl.pm,v 1.6 2004/05/28 09:37:03 foxr Exp $ +# $Id: lonssl.pm,v 1.23 2018/12/11 15:15:26 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -35,9 +35,12 @@ use strict; # CPAN/Standard modules: -use English; use IO::Socket::INET; use IO::Socket::SSL; +use Net::SSLeay; + +use Fcntl; +use POSIX; # Loncapa modules: @@ -50,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; +} #-------------------------------------------------------------------------- # @@ -66,41 +112,84 @@ $perlvar = LONCAPA::Configuration::read_ # 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, $CACert, $MyCert, - $KeyFile) = @ARG; - - + $KeyFile, + $peer, + $peerdef, + $CRLFile) = @_; + + Debug("Client promotion using key: $KeyFile, Cert: $MyCert, CA: $CACert, CRL: $CRLFile, Remote Host: $peer, RemoteDefHost: $peerdef\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 @@ -109,30 +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, $CACert, $MyCert, - $KeyFile) = @ARG; - - + $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; } @@ -171,7 +293,7 @@ sub GetPeerCertificate { my $CertOwner = $SSLSocket->peer_certificate("owner"); my $CertCA = $SSLSocket->peer_certificate("authority"); - return \($CertCA, $CertOwner); + return ($CertCA, $CertOwner); } #---------------------------------------------------------------------------- # @@ -194,22 +316,26 @@ sub CertificateFile { # 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. - my $CaFilename = $CertificateDir.$pathsep.$CaFilename; - my $CertFilename = $CertificateDir.$pathsep.$CertFilename; + $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); + return ($CaFilename, $CertFilename); } #------------------------------------------------------------------------ @@ -231,18 +357,130 @@ sub KeyFile { # 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: - my $KeyFilename = $CertificateDir.$pathsep.$KeyFilename; + $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,$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}); + } + + 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;