--- loncom/lonssl.pm 2004/06/17 09:27:38 1.8 +++ loncom/lonssl.pm 2017/02/28 05:42:06 1.15 @@ -1,5 +1,5 @@ # -# $Id: lonssl.pm,v 1.8 2004/06/17 09:27:38 foxr Exp $ +# $Id: lonssl.pm,v 1.15 2017/02/28 05:42:06 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -37,6 +37,7 @@ use strict; use IO::Socket::INET; use IO::Socket::SSL; +use Net::SSLeay; use Fcntl; use POSIX; @@ -52,6 +53,8 @@ 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: @@ -61,10 +64,18 @@ $perlvar = LONCAPA::Configuration::read_ 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 @@ -76,18 +87,18 @@ sub LastError { # prior flag settings. # sub SetFdBlocking { - print STDERR "SetFdBlocking called \n"; + Debug("SetFdBlocking called \n"); my $Handle = shift; my $flags = fcntl($Handle, F_GETFL, 0); if(!$flags) { - print STDERR "SetBLocking fcntl get faild $!\n"; + Debug("SetBLocking fcntl get faild $!\n"); } my $newflags = $flags & (~ O_NONBLOCK); # Turn off O_NONBLOCK... if(!fcntl($Handle, F_SETFL, $newflags)) { - print STDERR "Can't set non block mode $!\n"; + Debug("Can't set non block mode $!\n"); } return $flags; } @@ -119,7 +130,7 @@ sub PromoteClientSocket { $KeyFile) = @_; - print STDERR "Client promotion using key: $KeyFile, Cert: $MyCert, CA: $CACert\n"; + Debug("Client promotion using key: $KeyFile, Cert: $MyCert, CA: $CACert\n"); # To create the ssl socket we need to duplicate the existing # socket. Otherwise closing the ssl socket will close the plaintext socket @@ -129,14 +140,23 @@ sub PromoteClientSocket { my $oldflags = SetFdBlocking($PlaintextSocket); my $dupfno = fcntl($PlaintextSocket, F_DUPFD, 0); - print STDERR "Client promotion got dup = $dupfno\n"; + 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 connections to lond. + # Set SSL_verify_mode to Net::SSLeay::VERIFY_NONE() instead of to + # SSL_VERIFY_NONE 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_user_cert => 1, + SSL_use_cert => 1, SSL_key_file => $KeyFile, SSL_cert_file => $MyCert, - SSL_ca_fie => $CACert); + SSL_ca_file => $CACert, + SSL_verify_mode => Net::SSLeay::VERIFY_NONE()); if(!$client) { $lasterror = IO::Socket::SSL::errstr(); @@ -176,20 +196,20 @@ sub PromoteServerSocket { # socket. Otherwise closing the ssl socket will close the plaintext socket # too: - print STDERR "Server promotion: Key = $KeyFile, Cert $MyCert CA $CACert\n"; + Debug("Server promotion: Key = $KeyFile, Cert $MyCert CA $CACert\n"); my $oldflags = SetFdBlocking($PlaintextSocket); my $dupfno = fcntl($PlaintextSocket, F_DUPFD, 0); if (!$dupfno) { - print STDERR "dup failed: $!\n"; + Debug("dup failed: $!\n"); } - print STDERR " Fileno = $dupfno\n"; + Debug(" Fileno = $dupfno\n"); my $client = IO::Socket::SSL->new_from_fd($dupfno, SSL_server => 1, # Server role. - SSL_user_cert => 1, + SSL_use_cert => 1, SSL_key_file => $KeyFile, SSL_cert_file => $MyCert, - SSL_ca_fie => $CACert); + SSL_ca_file => $CACert); if(!$client) { $lasterror = IO::Socket::SSL::errstr(); return undef; @@ -263,8 +283,8 @@ sub CertificateFile { # 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 " @@ -304,7 +324,7 @@ sub KeyFile { # 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; @@ -313,4 +333,64 @@ sub KeyFile { 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;