[LON-CAPA-cvs] cvs: loncom / LondConnection.pm
foxr
lon-capa-cvs@mail.lon-capa.org
Thu, 17 Jun 2004 09:26:09 -0000
This is a MIME encoded message
--foxr1087464369
Content-Type: text/plain
foxr Thu Jun 17 05:26:09 2004 EDT
Modified files:
/loncom LondConnection.pm
Log:
Debug changes to get SSL and local file secure key exchanges done
--foxr1087464369
Content-Type: text/plain
Content-Disposition: attachment; filename="foxr-20040617052609.txt"
Index: loncom/LondConnection.pm
diff -u loncom/LondConnection.pm:1.30 loncom/LondConnection.pm:1.31
--- loncom/LondConnection.pm:1.30 Tue Jun 1 06:05:16 2004
+++ loncom/LondConnection.pm Thu Jun 17 05:26:09 2004
@@ -1,7 +1,7 @@
# This module defines and implements a class that represents
# a connection to a lond daemon.
#
-# $Id: LondConnection.pm,v 1.30 2004/06/01 10:05:16 foxr Exp $
+# $Id: LondConnection.pm,v 1.31 2004/06/17 09:26:09 foxr Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -36,14 +36,17 @@
use Fcntl;
use POSIX;
use Crypt::IDEA;
+use LONCAPA::lonlocal;
+use LONCAPA::lonssl;
-
-my $DebugLevel=0;
+my $DebugLevel=11;
my %hostshash;
my %perlvar;
+my $LocalDns = ""; # Need not be defined for managers.
+my $InsecureOk;
#
# Set debugging level
@@ -61,9 +64,11 @@
my $ConfigRead = 0;
# Read the configuration file for apache to get the perl
-# variable set.
+# variables set.
sub ReadConfig {
+ Debug(8, "ReadConfig called");
+
my $perlvarref = read_conf('loncapa.conf');
%perlvar = %{$perlvarref};
my $hoststab = read_hosts(
@@ -72,6 +77,18 @@
%hostshash = %{$hoststab};
$ConfigRead = 1;
+ my $myLonCapaName = $perlvar{lonHostID};
+ Debug(8, "My loncapa name is $myLonCapaName");
+
+ if(defined $hostshash{$myLonCapaName}) {
+ Debug(8, "My loncapa name is in hosthash");
+ my @ConfigLine = @{$hostshash{$myLonCapaName}};
+ $LocalDns = $ConfigLine[3];
+ Debug(8, "Got local name $LocalDns");
+ }
+ $InsecureOk = $perlvar{loncAllowInsecure};
+
+ Debug(3, "ReadConfig - LocalDNS = $LocalDns");
}
#
@@ -100,11 +117,21 @@
%hostshash = %{$hosttab};
if($DebugLevel > 3) {
foreach my $host (keys %hostshash) {
- print "host $host => $hostshash{$host}\n";
+ print STDERR "host $host => $hostshash{$host}\n";
}
}
$ConfigRead = 1;
+ my $myLonCapaName = $perlvar{lonHostID};
+
+ if(defined $hostshash{$myLonCapaName}) {
+ my @ConfigLine = @{$hostshash{$myLonCapaName}};
+ $LocalDns = $ConfigLine[3];
+ }
+ $InsecureOk = $perlvar{loncAllowInsecure};
+
+ Debug(3, "ReadForeignConfig - LocalDNS = $LocalDns");
+
}
sub Debug {
@@ -112,7 +139,7 @@
my ($level, $message) = @_;
if ($level < $DebugLevel) {
- print($message."\n");
+ print STDERR ($message."\n");
}
}
@@ -203,6 +230,7 @@
LoncapaHim => $Hostname,
Port => $Port,
State => "Initialized",
+ AuthenticationMode => "",
TransactionRequest => "",
TransactionReply => "",
InformReadable => 0,
@@ -212,6 +240,7 @@
Timeoutable => 0,
TimeoutValue => 30,
TimeoutRemaining => 0,
+ LocalKeyFile => "",
CipherKey => "",
LondVersion => "Unknown",
Cipher => undef};
@@ -223,30 +252,71 @@
Timeout => 3)) {
return undef; # Inidicates the socket could not be made.
}
+ my $socket = $self->{Socket}; # For local use only.
+ # If we are local, we'll first try local auth mode, otherwise, we'll try the
+ # ssl auth mode:
+
+ Debug(8, "Connecting to $DnsName I am $LocalDns");
+ my $key;
+ my $keyfile;
+ if ($DnsName eq $LocalDns) {
+ $self->{AuthenticationMode} = "local";
+ ($key, $keyfile) = lonlocal::CreateKeyFile();
+ Debug(8, "Local key: $key, stored in $keyfile");
+
+ # If I can't make the key file fall back to insecure if
+ # allowed...else give up right away.
+
+ if(!(defined $key) || !(defined $keyfile)) {
+ if($InsecureOk) {
+ $self->{AuthenticationMode} = "insecure";
+ $self->{TransactionRequest} = "init\n";
+ }
+ else {
+ $socket->close;
+ return undef;
+ }
+ }
+ $self->{TransactionRequest} = "init:local:$keyfile\n";
+ Debug(9, "Init string is init:local:$keyfile");
+ if(!$self->CreateCipher($key)) { # Nothing's going our way...
+ $socket->close;
+ return undef;
+ }
+
+ }
+ else {
+ $self->{AuthenticationMode} = "ssl";
+ $self->{TransactionRequest} = "init:ssl\n";
+ }
+
#
# We're connected. Set the state, and the events we'll accept:
#
$self->Transition("Connected");
$self->{InformWritable} = 1; # When socket is writable we send init
$self->{Timeoutable} = 1; # Timeout allowed during startup negotiation.
- $self->{TransactionRequest} = "init\n";
+
#
# Set socket to nonblocking I/O.
#
my $socket = $self->{Socket};
- my $flags = fcntl($socket->fileno, F_GETFL,0);
- if($flags == -1) {
+ my $flags = fcntl($socket, F_GETFL,0);
+ if(!$flags) {
$socket->close;
return undef;
}
- if(fcntl($socket, F_SETFL, $flags | O_NONBLOCK) == -1) {
+ if(!fcntl($socket, F_SETFL, $flags | O_NONBLOCK)) {
$socket->close;
return undef;
}
# return the object :
+ Debug(9, "Initial object state: ");
+ $self->Dump();
+
return $self;
}
@@ -281,6 +351,8 @@
my $socket = $self->{Socket};
my $data = '';
my $rv;
+ my $ConnectionMode = $self->{AuthenticationMode};
+
if ($socket) {
eval {
$rv = $socket->recv($data, POSIX::BUFSIZ, 0);
@@ -311,32 +383,98 @@
$self->{TransactionReply} .= $data;
if($self->{TransactionReply} =~ m/\n$/) {
&Debug(8,"Readable End of line detected");
+
+
if ($self->{State} eq "Initialized") { # We received the challenge:
- if($self->{TransactionReply} eq "refused\n") { # Remote doesn't have
-
- $self->Transition("Disconnected"); # in host tables.
- $socket->close();
- return -1;
+ # Our init was replied to. What happens next depends both on
+ # the actual init we sent (AuthenticationMode member data)
+ # and the response:
+ # AuthenticationMode == local:
+ # Response ok: The key has been exchanged and
+ # the key file destroyed. We can jump
+ # into setting the host and requesting the
+ # Later we'll also bypass key exchange.
+ # Response digits:
+ # Old style lond. Delete the keyfile.
+ # If allowed fall back to insecure mode.
+ # else close connection and fail.
+ # Response other:
+ # Failed local auth
+ # Close connection and fail.
+ #
+ # AuthenticationMode == ssl:
+ # Response ok:ssl
+ # Response digits:
+ # Response other:
+ # Authentication mode == insecure
+ # Response digits
+ # Response other:
+
+ my $Response = $self->{TransactionReply};
+ if($ConnectionMode eq "local") {
+ if($Response =~ /^ok:local/) { # Good local auth.
+ $self->ToVersionRequest();
+ return 0;
+ }
+ elsif ($Response =~/^[0-9]+/) { # Old style lond.
+ return $self->CompleteInsecure();
+
+ }
+ else { # Complete flop
+ &Debug(3, "init:local : unrecognized reply");
+ $self->Transition("Disconnected");
+ $socket->close;
+ return -1;
+ }
}
+ elsif ($ConnectionMode eq "ssl") {
+ if($Response =~ /^ok:ssl/) { # Good ssl...
+ if($self->ExchangeKeysViaSSL()) { # Success skip to vsn stuff
+ # Need to reset to non blocking:
+
+ my $flags = fcntl($socket, F_GETFL, 0);
+ fcntl($socket, F_SETFL, $flags | O_NONBLOCK);
+ $self->ToVersionRequest();
+ return 0;
+ }
+ else { # Failed in ssl exchange.
+ &Debug(3,"init:ssl failed key negotiation!");
+ $self->Transition("Disconnected");
+ $socket->close;
+ return -1;
+ }
+ }
+ elsif ($Response =~ /^[0-9]+/) { # Old style lond.
+ return $self->CompleteInsecure();
+ }
+ else { # Complete flop
+ }
+ }
+ elsif ($ConnectionMode eq "insecure") {
+ if($self->{TransactionReply} eq "refused\n") { # Remote doesn't have
+
+ $self->Transition("Disconnected"); # in host tables.
+ $socket->close();
+ return -1;
+
+ }
+ return $self->CompleteInsecure();
+ }
+ else {
+ &Debug(1,"Authentication mode incorrect");
+ die "BUG!!! LondConnection::Readable invalid authmode";
+ }
+
- &Debug(8," Transition out of Initialized");
- $self->{TransactionRequest} = $self->{TransactionReply};
- $self->{InformWritable} = 1;
- $self->{InformReadable} = 0;
- $self->Transition("ChallengeReceived");
- $self->{TimeoutRemaining} = $self->{TimeoutValue};
- return 0;
} elsif ($self->{State} eq "ChallengeReplied") {
if($self->{TransactionReply} ne "ok\n") {
$self->Transition("Disconnected");
$socket->close();
return -1;
}
- $self->Transition("RequestingVersion");
- $self->{InformReadable} = 0;
- $self->{InformWritable} = 1;
- $self->{TransactionRequest} = "version\n";
+ $self->ToVersionRequest();
return 0;
+
} elsif ($self->{State} eq "ReadingVersionString") {
$self->{LondVersion} = chomp($self->{TransactionReply});
$self->Transition("SetHost");
@@ -351,30 +489,35 @@
$socket->close();
return -1;
}
- $self->Transition("RequestingKey");
- $self->{InformReadable} = 0;
- $self->{InformWritable} = 1;
- $self->{TransactionRequest} = "ekey\n";
- return 0;
+ # If the auth mode is insecure we must still
+ # exchange session keys. Otherwise,
+ # we can just transition to idle.
+
+ if($ConnectionMode eq "insecure") {
+ $self->Transition("RequestingKey");
+ $self->{InformReadable} = 0;
+ $self->{InformWritable} = 1;
+ $self->{TransactionRequest} = "ekey\n";
+ return 0;
+ }
+ else {
+ $self->ToIdle();
+ return 0;
+ }
} elsif ($self->{State} eq "ReceivingKey") {
my $buildkey = $self->{TransactionReply};
my $key = $self->{LoncapaHim}.$perlvar{'lonHostID'};
$key=~tr/a-z/A-Z/;
$key=~tr/G-P/0-9/;
$key=~tr/Q-Z/0-9/;
- $key=$key.$buildkey.$key.$buildkey.$key.$buildkey;
- $key=substr($key,0,32);
- my $cipherkey=pack("H32",$key);
- $self->{Cipher} = new IDEA $cipherkey;
- if($self->{Cipher} eq undef) {
+ $key =$key.$buildkey.$key.$buildkey.$key.$buildkey;
+ $key = substr($key,0,32);
+ if(!$self->CreateCipher($key)) {
$self->Transition("Disconnected");
$socket->close();
return -1;
} else {
- $self->Transition("Idle");
- $self->{InformWritable} = 0;
- $self->{InformReadable} = 0;
- $self->{Timeoutable} = 0;
+ $self->ToIdle();
return 0;
}
} elsif ($self->{State} eq "ReceivingReply") {
@@ -389,10 +532,7 @@
# finish the transaction
- $self->{InformWritable} = 0;
- $self->{InformReadable} = 0;
- $self->{Timeoutable} = 0;
- $self->Transition("Idle");
+ $self->ToIdle();
return 0;
} elsif ($self->{State} eq "Disconnected") { # No connection.
return -1;
@@ -789,6 +929,156 @@
return $decrypted;
}
+# ToIdle
+# Called to transition to idle... done enough it's worth subbing
+# off to ensure it's always done right!!
+#
+sub ToIdle {
+ my $self = shift;
+
+ $self->Transition("Idle");
+ $self->{InformWritiable} = 0;
+ $self->{InformReadable} = 0;
+ $self->{Timeoutable} = 0;
+}
+
+# ToVersionRequest
+# Called to transition to "RequestVersion" also done a few times
+# so worth subbing out.
+#
+sub ToVersionRequest {
+ my $self = shift;
+
+ $self->Transition("RequestingVersion");
+ $self->{InformReadable} = 0;
+ $self->{InformWritable} = 1;
+ $self->{TransactionRequest} = "version\n";
+
+}
+#
+# CreateCipher
+# Given a cipher key stores the key in the object context,
+# creates the cipher object, (stores that in object context),
+# This is done a couple of places, so it's worth factoring it out.
+#
+# Parameters:
+# (self)
+# key - The Cipher key.
+#
+# Returns:
+# 0 - Failure to create IDEA cipher.
+# 1 - Success.
+#
+sub CreateCipher {
+ my ($self, $key) = @_; # According to coding std.
+
+ $self->{CipherKey} = $key; # Save the text key...
+ my $packedkey = pack ("H32", $key);
+ my $cipher = new IDEA $packedkey;
+ if($cipher) {
+ $self->{Cipher} = $cipher;
+ Debug("Cipher created dumping socket: ");
+ $self->Dump();
+ return 1;
+ }
+ else {
+ return 0;
+ }
+}
+# ExchangeKeysViaSSL
+# Called to do cipher key exchange via SSL.
+# The socket is promoted to an SSL socket. If that's successful,
+# we read out cipher key through the socket and create an IDEA
+# cipher object.
+# Parameters:
+# (self)
+# Returns:
+# true - Success.
+# false - Failure.
+#
+# Assumptions:
+# 1. The ssl session setup has timeout logic built in so we don't
+# have to worry about DOS attacks at that stage.
+# 2. If the ssl session gets set up we are talking to a legitimate
+# lond so again we don't have to worry about DOS attacks.
+# All this allows us just to call
+sub ExchangeKeysViaSSL {
+ my $self = shift;
+ my $socket = $self->{Socket};
+
+ # Get our signed certificate, the certificate authority's
+ # certificate and our private key file. All of these
+ # are needed to create the ssl connection.
+
+ my ($SSLCACertificate,
+ $SSLCertificate) = lonssl::CertificateFile();
+ my $SSLKey = lonssl::KeyFile();
+
+ # Promote our connection to ssl and read the key from lond.
+
+ my $SSLSocket = lonssl::PromoteClientSocket($socket,
+ $SSLCACertificate,
+ $SSLCertificate,
+ $SSLKey);
+ if(defined $SSLSocket) {
+ my $key = <$SSLSocket>;
+ lonssl::Close($SSLSocket);
+ if($key) {
+ chomp($key); # \n is not part of the key.
+ return $self->CreateCipher($key);
+ }
+ else {
+ Debug(3, "Failed to read ssl key");
+ return 0;
+ }
+ }
+ else {
+ # Failed!!
+ Debug(3, "Failed to negotiate SSL connection!");
+ return 0;
+ }
+ # should not get here
+ return 0;
+
+}
+
+
+
+#
+# CompleteInsecure:
+# This function is called to initiate the completion of
+# insecure challenge response negotiation.
+# To do this, we copy the challenge string to the transaction
+# request, flip to writability and state transition to
+# ChallengeReceived..
+# All this is only possible if InsecureOk is true.
+# Parameters:
+# (self) - This object's context hash.
+# Return:
+# 0 - Ok to transition.
+# -1 - Not ok to transition (InsecureOk not ok).
+#
+sub CompleteInsecure {
+ my $self = shift;
+ if($InsecureOk) {
+ $self->{AuthenticationMode} = "insecure";
+ &Debug(8," Transition out of Initialized:insecure");
+ $self->{TransactionRequest} = $self->{TransactionReply};
+ $self->{InformWritable} = 1;
+ $self->{InformReadable} = 0;
+ $self->Transition("ChallengeReceived");
+ $self->{TimeoutRemaining} = $self->{TimeoutValue};
+ return 0;
+
+
+ }
+ else {
+ &Debug(3, "Insecure key negotiation disabled!");
+ my $socket = $self->{Socket};
+ $socket->close;
+ return -1;
+ }
+}
=pod
@@ -838,7 +1128,7 @@
foreach my $filename (@conf_files,'loncapa_apache.conf')
{
if($DebugLevel > 3) {
- print("Going to read $confdir.$filename\n");
+ print STDERR ("Going to read $confdir.$filename\n");
}
open(CONFIG,'<'.$confdir.$filename) or
die("Can't read $confdir$filename");
@@ -854,9 +1144,9 @@
close(CONFIG);
}
if($DebugLevel > 3) {
- print "Dumping perlvar:\n";
+ print STDERR "Dumping perlvar:\n";
foreach my $var (keys %perlvar) {
- print "$var = $perlvar{$var}\n";
+ print STDERR "$var = $perlvar{$var}\n";
}
}
my $perlvarref=\%perlvar;
@@ -986,6 +1276,17 @@
The current state.
+=item AuthenticationMode
+
+How authentication is being done. This can be any of:
+
+ o local - Authenticate via a key exchanged in a file.
+ o ssl - Authenticate via a key exchaned through a temporary ssl tunnel.
+ o insecure - Exchange keys in an insecure manner.
+
+insecure is only allowed if the configuration parameter loncAllowInsecure
+is nonzero.
+
=item TransactionRequest
The request being transmitted.
--foxr1087464369--