version 1.8, 2004/06/17 09:27:38
|
version 1.13, 2015/11/07 18:41:11
|
Line 52 my $perlvar; # this refers to the apa
|
Line 52 my $perlvar; # this refers to the apa
|
|
|
my $pathsep = "/"; # We're on unix after all. |
my $pathsep = "/"; # We're on unix after all. |
|
|
|
my $DEBUG = 0; # Set to non zero to enable debug output. |
|
|
|
|
# Initialization code: |
# Initialization code: |
|
|
Line 61 $perlvar = LONCAPA::Configuration::read_
|
Line 63 $perlvar = LONCAPA::Configuration::read_
|
my $lasterror=""; |
my $lasterror=""; |
|
|
|
|
|
|
sub LastError { |
sub LastError { |
return $lasterror; |
return $lasterror; |
} |
} |
|
|
|
sub Debug { |
|
my $msg = shift; |
|
if ($DEBUG) { |
|
print STDERR $msg; |
|
} |
|
} |
|
|
#------------------------------------------------------------------------- |
#------------------------------------------------------------------------- |
# Name SetFdBlocking - |
# Name SetFdBlocking - |
# Turn blocking mode on on the file handle. This is required for |
# Turn blocking mode on on the file handle. This is required for |
Line 76 sub LastError {
|
Line 86 sub LastError {
|
# prior flag settings. |
# prior flag settings. |
# |
# |
sub SetFdBlocking { |
sub SetFdBlocking { |
print STDERR "SetFdBlocking called \n"; |
Debug("SetFdBlocking called \n"); |
my $Handle = shift; |
my $Handle = shift; |
|
|
|
|
|
|
my $flags = fcntl($Handle, F_GETFL, 0); |
my $flags = fcntl($Handle, F_GETFL, 0); |
if(!$flags) { |
if(!$flags) { |
print STDERR "SetBLocking fcntl get faild $!\n"; |
Debug("SetBLocking fcntl get faild $!\n"); |
} |
} |
my $newflags = $flags & (~ O_NONBLOCK); # Turn off O_NONBLOCK... |
my $newflags = $flags & (~ O_NONBLOCK); # Turn off O_NONBLOCK... |
if(!fcntl($Handle, F_SETFL, $newflags)) { |
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; |
return $flags; |
} |
} |
Line 119 sub PromoteClientSocket {
|
Line 129 sub PromoteClientSocket {
|
$KeyFile) = @_; |
$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 |
# 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 129 sub PromoteClientSocket {
|
Line 139 sub PromoteClientSocket {
|
|
|
my $oldflags = SetFdBlocking($PlaintextSocket); |
my $oldflags = SetFdBlocking($PlaintextSocket); |
my $dupfno = fcntl($PlaintextSocket, F_DUPFD, 0); |
my $dupfno = fcntl($PlaintextSocket, F_DUPFD, 0); |
print STDERR "Client promotion got dup = $dupfno\n"; |
Debug("Client promotion got dup = $dupfno\n"); |
|
|
|
|
my $client = IO::Socket::SSL->new_from_fd($dupfno, |
my $client = IO::Socket::SSL->new_from_fd($dupfno, |
SSL_user_cert => 1, |
SSL_use_cert => 1, |
SSL_key_file => $KeyFile, |
SSL_key_file => $KeyFile, |
SSL_cert_file => $MyCert, |
SSL_cert_file => $MyCert, |
SSL_ca_fie => $CACert); |
SSL_ca_file => $CACert); |
|
|
if(!$client) { |
if(!$client) { |
$lasterror = IO::Socket::SSL::errstr(); |
$lasterror = IO::Socket::SSL::errstr(); |
Line 176 sub PromoteServerSocket {
|
Line 186 sub PromoteServerSocket {
|
# socket. Otherwise closing the ssl socket will close the plaintext socket |
# socket. Otherwise closing the ssl socket will close the plaintext socket |
# too: |
# 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 $oldflags = SetFdBlocking($PlaintextSocket); |
my $dupfno = fcntl($PlaintextSocket, F_DUPFD, 0); |
my $dupfno = fcntl($PlaintextSocket, F_DUPFD, 0); |
if (!$dupfno) { |
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, |
my $client = IO::Socket::SSL->new_from_fd($dupfno, |
SSL_server => 1, # Server role. |
SSL_server => 1, # Server role. |
SSL_user_cert => 1, |
SSL_use_cert => 1, |
SSL_key_file => $KeyFile, |
SSL_key_file => $KeyFile, |
SSL_cert_file => $MyCert, |
SSL_cert_file => $MyCert, |
SSL_ca_fie => $CACert); |
SSL_ca_file => $CACert); |
if(!$client) { |
if(!$client) { |
$lasterror = IO::Socket::SSL::errstr(); |
$lasterror = IO::Socket::SSL::errstr(); |
return undef; |
return undef; |
Line 263 sub CertificateFile {
|
Line 273 sub CertificateFile {
|
# Build the actual filenames and check for their existence and |
# Build the actual filenames and check for their existence and |
# readability. |
# readability. |
|
|
my $CaFilename = $CertificateDir.$pathsep.$CaFilename; |
$CaFilename = $CertificateDir.$pathsep.$CaFilename; |
my $CertFilename = $CertificateDir.$pathsep.$CertFilename; |
$CertFilename = $CertificateDir.$pathsep.$CertFilename; |
|
|
if((! -r $CaFilename) || (! -r $CertFilename)) { |
if((! -r $CaFilename) || (! -r $CertFilename)) { |
$lasterror = "CA file $CaFilename or Cert File: $CertFilename " |
$lasterror = "CA file $CaFilename or Cert File: $CertFilename " |
Line 304 sub KeyFile {
|
Line 314 sub KeyFile {
|
# Build the actual filename and ensure that it not only exists but |
# Build the actual filename and ensure that it not only exists but |
# is also readable: |
# is also readable: |
|
|
my $KeyFilename = $CertificateDir.$pathsep.$KeyFilename; |
$KeyFilename = $CertificateDir.$pathsep.$KeyFilename; |
if(! (-r $KeyFilename)) { |
if(! (-r $KeyFilename)) { |
$lasterror = "Unreadable key file $KeyFilename"; |
$lasterror = "Unreadable key file $KeyFilename"; |
return undef; |
return undef; |