version 1.13, 2015/11/07 18:41:11
|
version 1.16, 2018/07/29 03:03:36
|
Line 37 use strict;
|
Line 37 use strict;
|
|
|
use IO::Socket::INET; |
use IO::Socket::INET; |
use IO::Socket::SSL; |
use IO::Socket::SSL; |
|
use Net::SSLeay; |
|
|
use Fcntl; |
use Fcntl; |
use POSIX; |
use POSIX; |
Line 115 sub SetFdBlocking {
|
Line 116 sub SetFdBlocking {
|
# issued to this host. |
# 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. |
# key file for the certificate. |
|
# peer string lonHostID of remote LON-CAPA server |
# Returns |
# Returns |
# - Reference to an SSL socket on success |
# - Reference to an SSL socket on success |
# - undef on failure. Reason for failure can be interrogated from |
# - undef on failure. Reason for failure can be interrogated from |
Line 126 sub PromoteClientSocket {
|
Line 128 sub PromoteClientSocket {
|
my ($PlaintextSocket, |
my ($PlaintextSocket, |
$CACert, |
$CACert, |
$MyCert, |
$MyCert, |
$KeyFile) = @_; |
$KeyFile, |
|
$peer) = @_; |
|
|
|
|
Debug("Client promotion using key: $KeyFile, Cert: $MyCert, CA: $CACert\n"); |
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 |
# To create the ssl socket we need to duplicate the existing |
# socket. Otherwise closing the ssl socket will close the plaintext socket |
# socket. Otherwise closing the ssl socket will close the plaintext socket |
Line 141 sub PromoteClientSocket {
|
Line 144 sub PromoteClientSocket {
|
my $dupfno = fcntl($PlaintextSocket, F_DUPFD, 0); |
my $dupfno = fcntl($PlaintextSocket, F_DUPFD, 0); |
Debug("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 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, |
my $client = IO::Socket::SSL->new_from_fd($dupfno, |
SSL_use_cert => 1, |
SSL_use_cert => 1, |
SSL_key_file => $KeyFile, |
SSL_key_file => $KeyFile, |
SSL_cert_file => $MyCert, |
SSL_cert_file => $MyCert, |
SSL_ca_file => $CACert); |
SSL_ca_file => $CACert, |
|
SSL_verifycn_name => $peer, |
|
SSL_verify_mode => Net::SSLeay::VERIFY_PEER()); |
|
|
if(!$client) { |
if(!$client) { |
$lasterror = IO::Socket::SSL::errstr(); |
$lasterror = IO::Socket::SSL::errstr(); |
Line 158 sub PromoteClientSocket {
|
Line 173 sub PromoteClientSocket {
|
#---------------------------------------------------------------------- |
#---------------------------------------------------------------------- |
# Name PromoteServerSocket |
# Name PromoteServerSocket |
# Description Given an ordinary IO::Socket::INET Creates an SSL socket |
# 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 |
# Parameters Name Type Description |
# Socket IO::Socket::INET Original ordinary socket. |
# Socket IO::Socket::INET Original ordinary socket. |
# CACert string Full path name to the certificate |
# CACert string Full path name to the certificate |
Line 167 sub PromoteClientSocket {
|
Line 182 sub PromoteClientSocket {
|
# issued to this host. |
# 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. |
# key file for the certificate. |
|
# peer string lonHostID of remote LON-CAPA client |
# Returns |
# Returns |
# - Reference to an SSL socket on success |
# - Reference to an SSL socket on success |
# - undef on failure. Reason for failure can be interrogated from |
# - undef on failure. Reason for failure can be interrogated from |
Line 178 sub PromoteServerSocket {
|
Line 194 sub PromoteServerSocket {
|
my ($PlaintextSocket, |
my ($PlaintextSocket, |
$CACert, |
$CACert, |
$MyCert, |
$MyCert, |
$KeyFile) = @_; |
$KeyFile, |
|
$peer) = @_; |
|
|
|
|
|
|
Line 199 sub PromoteServerSocket {
|
Line 216 sub PromoteServerSocket {
|
SSL_use_cert => 1, |
SSL_use_cert => 1, |
SSL_key_file => $KeyFile, |
SSL_key_file => $KeyFile, |
SSL_cert_file => $MyCert, |
SSL_cert_file => $MyCert, |
SSL_ca_file => $CACert); |
SSL_ca_file => $CACert, |
|
SSL_verifycn_name => $peer, |
|
SSL_verify_mode => Net::SSLeay::VERIFY_PEER()); |
if(!$client) { |
if(!$client) { |
$lasterror = IO::Socket::SSL::errstr(); |
$lasterror = IO::Socket::SSL::errstr(); |
return undef; |
return undef; |
Line 323 sub KeyFile {
|
Line 342 sub KeyFile {
|
return $KeyFilename; |
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; |
1; |