--- loncom/lonssl.pm 2004/05/26 10:19:54 1.1 +++ loncom/lonssl.pm 2014/11/06 02:22:11 1.11 @@ -0,0 +1,326 @@ +# +# $Id: lonssl.pm,v 1.11 2014/11/06 02:22:11 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 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. +# 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) = @_; + + + 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 + # 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"); + + + my $client = IO::Socket::SSL->new_from_fd($dupfno, + SSL_user_cert => 1, + SSL_key_file => $KeyFile, + SSL_cert_file => $MyCert, + SSL_ca_file => $CACert); + + if(!$client) { + $lasterror = IO::Socket::SSL::errstr(); + 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 +# 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. +# 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) = @_; + + + + # 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 $client = IO::Socket::SSL->new_from_fd($dupfno, + SSL_server => 1, # Server role. + SSL_user_cert => 1, + SSL_key_file => $KeyFile, + SSL_cert_file => $MyCert, + SSL_ca_file => $CACert); + if(!$client) { + $lasterror = IO::Socket::SSL::errstr(); + 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; +} + +1;