--- loncom/LondConnection.pm 2003/04/18 05:52:43 1.2 +++ loncom/LondConnection.pm 2018/12/03 13:48:13 1.58 @@ -1,7 +1,7 @@ # This module defines and implements a class that represents # a connection to a lond daemon. # -# $Id: LondConnection.pm,v 1.2 2003/04/18 05:52:43 albertel Exp $ +# $Id: LondConnection.pm,v 1.58 2018/12/03 13:48:13 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -25,8 +25,10 @@ # # http://www.lon-capa.org/ # + package LondConnection; +use strict; use IO::Socket; use IO::Socket::INET; use IO::Handle; @@ -34,51 +36,109 @@ use IO::File; use Fcntl; use POSIX; use Crypt::IDEA; -use LONCAPA::Configuration; -use LONCAPA::HashIterator; +use LONCAPA::lonlocal; +use LONCAPA::lonssl; + + +my $DebugLevel=0; +my %perlvar; +my %secureconf; +my %badcerts; +my %hosttypes; +my %crlchecked; +my $InsecureOk; + +# +# Set debugging level +# +sub SetDebug { + $DebugLevel = shift; +} + +# +# The config read is done in this way to support the read of +# the non-default configuration file in the +# event we are being used outside of loncapa. +# -my $DebugLevel=4; +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 = LONCAPA::Configuration::read_conf('loncapa.conf'); -my %perlvar = %{$perlvarref}; -my $hoststab = - LONCAPA::Configuration::read_hosts( - "$perlvar{'lonTabDir'}/hosts.tab") || - die "Can't read host table!!"; -my %hostshash = %{$hoststab}; + my $perlvarref = read_conf('loncapa.conf'); + %perlvar = %{$perlvarref}; + $ConfigRead = 1; -close(CONFIG); + $InsecureOk = $perlvar{loncAllowInsecure}; + + unless (lonssl::Read_Connect_Config(\%secureconf,\%perlvar) eq 'ok') { + Debug(1,"Failed to retrieve secureconf hash.\n"); + } + unless (lonssl::Read_Host_Types(\%hosttypes,\%perlvar) eq 'ok') { + Debug(1,"Failed to retrieve hosttypes hash.\n"); + } + %badcerts = (); + %crlchecked = (); +} + +sub ResetReadConfig { + $ConfigRead = 0; +} sub Debug { - my $level = shift; - my $message = shift; + + my ($level, $message) = @_; + if ($level < $DebugLevel) { - print($message."\n"); + print STDERR ($message."\n"); } } -=pod - Dump the internal state of the object: For debugging purposes. + +=pod + +=head2 Dump + +Dump the internal state of the object: For debugging purposes, to stderr. + =cut sub Dump { my $self = shift; - print "Dumping LondConnectionObject:\n"; + my $level = shift; + my $now = time; + my $local = localtime($now); + + if ($level >= $DebugLevel) { + return; + } + + + my $key; + my $value; + print STDERR "[ $local ] Dumping LondConnectionObject:\n"; + print STDERR join(':',caller(1))."\n"; while(($key, $value) = each %$self) { - print "$key -> $value\n"; + print STDERR "$key -> $value\n"; } - print "-------------------------------\n"; + print STDERR "-------------------------------\n"; } =pod - Local function to do a state transition. If the state transition callback - is defined it is called with two parameters: the self and the old state. + +Local function to do a state transition. If the state transition +callback is defined it is called with two parameters: the self and the +old state. + =cut + sub Transition { - my $self = shift; - my $newstate = shift; + + my ($self, $newstate) = @_; + my $oldstate = $self->{State}; $self->{State} = $newstate; $self->{TimeoutRemaining} = $self->{TimeoutValue}; @@ -87,18 +147,49 @@ sub Transition { } } + + =pod - Construct a new lond connection. - Parameters (besides the class name) include: -=item hostname - host the remote lond is on. - This host is a host in the hosts.tab file -=item port - port number the remote lond is listening on. + +=head2 new + +Construct a new lond connection. + +Parameters (besides the class name) include: + +=item hostname + +host the remote lond is on. This host is a host in the hosts.tab file + +=item port + + port number the remote lond is listening on. + =cut + sub new { - my $class = shift; # class name. - my $Hostname = shift; # Name of host to connect to. - my $Port = shift; # Port to connect - &Debug(4,$class."::new( ".$Hostname.",".$Port.")\n"); + my ($class, $DnsName, $Port, $lonid) = @_; + + if (!$ConfigRead) { + ReadConfig(); + $ConfigRead = 1; + } + &Debug(4,$class."::new( ".$DnsName.",".$Port.",".$lonid.")\n"); + + my ($conntype,$gotconninfo,$allowinsecure); + if ((ref($secureconf{'connto'}) eq 'HASH') && + (exists($hosttypes{$lonid}))) { + $conntype = $secureconf{'connto'}{$hosttypes{$lonid}}; + if ($conntype ne '') { + if ($conntype ne 'req') { + $allowinsecure = 1; + } + $gotconninfo = 1; + } + } + unless ($gotconninfo) { + $allowinsecure = $InsecureOk; + } # The host must map to an entry in the hosts table: # We connect to the dns host that corresponds to that @@ -106,85 +197,180 @@ sub new { # negotion. In the objec these become the Host and # LoncapaHim fields of the object respectively. # - if (!exists $hostshash{$Hostname}) { - return undef; # No such host!!! - } - my @ConfigLine = @{$hostshash{$Hostname}}; - my $DnsName = $ConfigLine[3]; # 4'th item is dns of host. - Debug(5, "Connecting to ".$DnsName); + # if it is me use loopback for connection + if ($DnsName eq &main::my_hostname()) { $DnsName="127.0.0.1"; } + Debug(9, "Connecting to $DnsName"); # Now create the object... my $self = { Host => $DnsName, - LoncapaHim => $Hostname, - Port => $Port, - State => "Initialized", - TransactionRequest => "", - TransactionReply => "", - InformReadable => 0, - InformWritable => 0, - TimeoutCallback => undef, - TransitionCallback => undef, - Timeoutable => 0, - TimeoutValue => 60, - TimeoutRemaining => 0, - CipherKey => "", - Cipher => undef}; + LoncapaHim => $lonid, + Port => $Port, + State => "Initialized", + AuthenticationMode => "", + InsecureOK => $allowinsecure, + TransactionRequest => "", + TransactionReply => "", + NextRequest => "", + InformReadable => 0, + InformWritable => 0, + TimeoutCallback => undef, + TransitionCallback => undef, + Timeoutable => 0, + TimeoutValue => 30, + TimeoutRemaining => 0, + LocalKeyFile => "", + CipherKey => "", + LondVersion => "Unknown", + Cipher => undef, + ClientData => undef}; bless($self, $class); unless ($self->{Socket} = IO::Socket::INET->new(PeerHost => $self->{Host}, PeerPort => $self->{Port}, Type => SOCK_STREAM, - Proto => "tcp")) { + Proto => "tcp", + Timeout => 3)) { + Debug(8, "Error? \n$@ \n$!"); return undef; # Inidicates the socket could not be made. } + my $socket = $self->{Socket}; # For local use only. + $socket->sockopt(SO_KEEPALIVE, 1); # Turn on keepalive probes when idle. + # If we are local, we'll first try local auth mode, otherwise, we'll try + # the ssl auth mode: + + my $key; + my $keyfile; + if ($DnsName eq '127.0.0.1') { + $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)) { + my $canconnect = 0; + if (ref($secureconf{'connto'}) eq 'HASH') { + unless ($secureconf{'connto'}->{'dom'} eq 'req') { + $canconnect = 1; + } + } else { + $canconnect = $InsecureOk; + } + if ($canconnect) { + $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 { + # Remote peer: I'd like to do ssl, but if my host key or certificates + # are not all installed, my only choice is insecure, if that's + # allowed: + + my ($ca, $cert) = lonssl::CertificateFile; + my $sslkeyfile = lonssl::KeyFile; + my $badcertfile = lonssl::has_badcert_file($self->{LoncapaHim}); + + if (($conntype ne 'no') && (defined($ca)) && (defined($cert)) && (defined($sslkeyfile)) && + (!exists($badcerts{$self->{LoncapaHim}})) && !$badcertfile) { + $self->{AuthenticationMode} = "ssl"; + $self->{TransactionRequest} = "init:ssl:$perlvar{'lonVersion'}\n"; + } elsif ($self->{InsecureOK}) { + # Allowed to do insecure: + $self->{AuthenticationMode} = "insecure"; + $self->{TransactionRequest} = "init::$perlvar{'lonVersion'}\n"; + } else { + # Not allowed to do insecure... + $socket->close; + return undef; + } + } + # # 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->{TransactionRequest} = "init\n"; + $self->{Timeoutable} = 1; # Timeout allowed during startup negotiation. + # # Set socket to nonblocking I/O. # - my $socket = $self->{Socket}; - $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(9); + return $self; } + =pod - This member should be called when the Socket becomes readable. - Until the read completes, action is state independet. Data are accepted - into the TransactionReply until a newline character is received. At that - time actionis state dependent: -=item Connected: in this case we received challenge, the state changes - to ChallengeReceived, and we initiate a send with the challenge response. -=item ReceivingReply: In this case a reply has been received for a transaction, - the state goes to Idle and we disable write and read notification. -=item ChallengeReeived: we just got what should be an ok\n and the - connection can now handle transactions. + +=head2 Readable + +This member should be called when the Socket becomes readable. Until +the read completes, action is state independet. Data are accepted into +the TransactionReply until a newline character is received. At that +time actionis state dependent: + +=item Connected + +in this case we received challenge, the state changes to +ChallengeReceived, and we initiate a send with the challenge response. + +=item ReceivingReply + +In this case a reply has been received for a transaction, the state +goes to Idle and we disable write and read notification. + +=item ChallengeReeived + +we just got what should be an ok\n and the connection can now handle +transactions. =cut + sub Readable { my $self = shift; my $socket = $self->{Socket}; my $data = ''; - my $rv = $socket->recv($data, POSIX::BUFSIZ, 0); + my $rv; + my $ConnectionMode = $self->{AuthenticationMode}; + + if ($socket) { + eval { + $rv = $socket->recv($data, POSIX::BUFSIZ, 0); + } + } else { + $self->Transition("Disconnected"); + return -1; + } my $errno = $! + 0; # Force numeric context. - unless (defined($rv) && length($data)) { # Read failed, + unless (defined($rv) && length $data) {# Read failed, if(($errno == POSIX::EWOULDBLOCK) || ($errno == POSIX::EAGAIN) || - ($errno == POSIX::EINTR) || - ($errno == 0)) { + ($errno == POSIX::EINTR)) { return 0; } @@ -195,57 +381,168 @@ sub Readable { $self->Transition("Disconnected"); return -1; } + # If we actually got data, reset the timeout. + + if (length $data) { + $self->{TimeoutRemaining} = $self->{TimeoutValue}; # getting data resets the timeout period. + } # Append the data to the buffer. And figure out if the read is done: &Debug(9,"Received from host: ".$data); $self->{TransactionReply} .= $data; - if($self->{TransactionReply} =~ /(.*\n)/) { + 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") { # Remote doesn't have - - $self->Transition("Disconnected"); # in host tables. + # 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... + my $sslresult = $self->ExchangeKeysViaSSL(); + if ($sslresult == 1) { # 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. + if (($sslresult == -1) && (lonssl::LastError == -1) && ($self->{InsecureOK})) { + my $badcertdir = &lonssl::BadCertDir(); + if (($badcertdir) && $self->{LoncapaHim}) { + if (open(my $fh,'>',"$badcertdir/".$self->{LoncapaHim})) { + close($fh); + } + } + $badcerts{$self->{LoncapaHim}} = 1; + &Debug(3,"SSL verification failed: close socket and initiate insecure connection"); + $self->Transition("ReInitNoSSL"); + $socket->close; + return -1; + } + &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"; + } + + + } elsif ($self->{State} eq "ChallengeReplied") { + if($self->{TransactionReply} ne "ok\n") { + $self->Transition("Disconnected"); $socket->close(); return -1; } + $self->ToVersionRequest(); + return 0; - &Debug(8," Transition out of Initialized"); - $self->{TransactionRequest} = $self->{TransactionReply}; - $self->{InformWritable} = 1; - $self->{InformReadable} = 0; - $self->Transition("ChallengeReceived"); - $self->{TimeoutRemaining} = $self->{TimeoutValue}; + } elsif ($self->{State} eq "ReadingVersionString") { + chomp($self->{TransactionReply}); + $self->{LondVersion} = $self->{TransactionReply}; + $self->Transition("SetHost"); + $self->{InformReadable} = 0; + $self->{InformWritable} = 1; + my $peer = $self->{LoncapaHim}; + $self->{TransactionRequest}= "sethost:$peer\n"; return 0; - } elsif ($self->{State} eq "ChallengeReplied") { # should be ok. - if($self->{TransactionReply} != "ok\n") { + } elsif ($self->{State} eq "HostSet") { # should be ok. + if($self->{TransactionReply} ne "ok\n") { $self->Transition("Disconnected"); $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}; + chomp($buildkey); 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} == 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") { @@ -255,16 +552,24 @@ sub Readable { my $answer = $self->{TransactionReply}; if($answer =~ /^enc\:/) { $answer = $self->Decrypt($answer); - $self->{TransactionReply} = $answer; + $self->{TransactionReply} = "$answer\n"; } - + # if we have a NextRequest do it immeadiately + if ($self->{NextRequest}) { + $self->{TransactionRequest} = $self->{NextRequest}; + undef( $self->{NextRequest} ); + $self->{TransactionReply} = ""; + $self->{InformWritable} = 1; + $self->{InformReadable} = 0; + $self->{Timeoutable} = 1; + $self->Transition("SendingRequest"); + return 0; + } else { # finish the transaction - $self->{InformWritable} = 0; - $self->{InformReadable} = 0; - $self->{Timeoutable} = 0; - $self->Transition("Idle"); - return 0; + $self->ToIdle(); + return 0; + } } elsif ($self->{State} eq "Disconnected") { # No connection. return -1; } else { # Internal error: Invalid state. @@ -280,18 +585,31 @@ sub Readable { =pod - This member should be called when the Socket becomes writable. -The action is state independent. An attempt is made to drain the contents of -the TransactionRequest member. Once this is drained, we mark the object -as waiting for readability. + +This member should be called when the Socket becomes writable. + +The action is state independent. An attempt is made to drain the +contents of the TransactionRequest member. Once this is drained, we +mark the object as waiting for readability. Returns 0 if successful, or -1 if not. - + =cut sub Writable { my $self = shift; # Get reference to the object. my $socket = $self->{Socket}; - my $nwritten = $socket->send($self->{TransactionRequest}, 0); + my $nwritten; + if ($socket) { + eval { + $nwritten = $socket->send($self->{TransactionRequest}, 0); + } + } else { + # For whatever reason, there's no longer a socket left. + + + $self->Transition("Disconnected"); + return -1; + } my $errno = $! + 0; unless (defined $nwritten) { if($errno != POSIX::EINTR) { @@ -300,11 +618,12 @@ sub Writable { } } - if (($rv >= 0) || + if (($nwritten >= 0) || ($errno == POSIX::EWOULDBLOCK) || ($errno == POSIX::EAGAIN) || ($errno == POSIX::EINTR) || ($errno == 0)) { + $self->{TimeoutRemaining} = $self->{TimeoutValue}; substr($self->{TransactionRequest}, 0, $nwritten) = ""; # rmv written part if(length $self->{TransactionRequest} == 0) { $self->{InformWritable} = 0; @@ -317,11 +636,15 @@ sub Writable { $self->Transition("Initialized"); } elsif($self->{State} eq "ChallengeReceived") { $self->Transition("ChallengeReplied"); + } elsif($self->{State} eq "RequestingVersion") { + $self->Transition("ReadingVersionString"); + } elsif ($self->{State} eq "SetHost") { + $self->Transition("HostSet"); } elsif($self->{State} eq "RequestingKey") { $self->Transition("ReceivingKey"); - $self->{InformWritable} = 0; - $self->{InformReadable} = 1; - $self->{TransactionReply} = ''; +# $self->{InformWritable} = 0; +# $self->{InformReadable} = 1; +# $self->{TransactionReply} = ''; } elsif ($self->{State} eq "SendingRequest") { $self->Transition("ReceivingReply"); $self->{TimeoutRemaining} = $self->{TimeoutValue}; @@ -335,13 +658,17 @@ sub Writable { $socket->close(); return -1; } - + } =pod + +=head2 Tick + Tick is called every time unit by the event framework. It - 1. decrements the remaining timeout. - 2. If the timeout is zero, calls TimedOut indicating that the - current operation timed out. + +=item 1 decrements the remaining timeout. + +=item 2 If the timeout is zero, calls TimedOut indicating that the current operation timed out. =cut @@ -352,11 +679,16 @@ sub Tick { $self->TimedOut(); } } + =pod - TimedOut - called on a timeout. If the timeout callback is defined, - it is called with $self as its parameters. -=cut +=head2 TimedOut + +called on a timeout. If the timeout callback is defined, it is called +with $self as its parameters. + +=cut + sub TimedOut { my $self = shift; @@ -366,30 +698,50 @@ sub TimedOut { &$callback(@args); } } + =pod - Called to initiate a transaction. A transaction can only be initiated - when the object is idle... otherwise an error is returned. - A transaction consists of a request to the server that will have a reply. - This member sets the request data in the TransactionRequest member, - makes the state SendingRequest and sets the data to allow a timout, - and to request writability notification. + +=head2 InitiateTransaction + +Called to initiate a transaction. A transaction can only be initiated +when the object is idle... otherwise an error is returned. A +transaction consists of a request to the server that will have a +reply. This member sets the request data in the TransactionRequest +member, makes the state SendingRequest and sets the data to allow a +timout, and to request writability notification. + =cut + sub InitiateTransaction { - my $self = shift; - my $data = shift; + my ($self, $data) = @_; + + Debug(1, "initiating transaction: ".$data); if($self->{State} ne "Idle") { + Debug(0," .. but not idle here\n"); return -1; # Error indicator. } # if the transaction is to be encrypted encrypt the data: + (my $sethost, my $server,$data)=split(/:/,$data,3); if($data =~ /^encrypt\:/) { $data = $self->Encrypt($data); } # Setup the trasaction - - $self->{TransactionRequest} = $data; + # currently no version of lond supports inlining the sethost + if ($self->PeerVersion() <= 321) { + if ($server ne $self->{LoncapaHim}) { + $self->{NextRequest} = $data; + $self->{TransactionRequest} = "$sethost:$server\n"; + $self->{LoncapaHim} = $server; + } else { + $self->{TransactionRequest} = $data; + } + } else { + $self->{LoncapaHim} = $server; + $self->{TransactionRequest} = "$sethost:$server:$data"; + } $self->{TransactionReply} = ""; $self->{InformWritable} = 1; $self->{InformReadable} = 0; @@ -400,86 +752,164 @@ sub InitiateTransaction { =pod - Sets a callback for state transitions. Returns a reference to any - prior established callback, or undef if there was none: + +=head2 SetStateTransitionCallback + +Sets a callback for state transitions. Returns a reference to any +prior established callback, or undef if there was none: + =cut + sub SetStateTransitionCallback { my $self = shift; my $oldCallback = $self->{TransitionCallback}; $self->{TransitionCallback} = shift; return $oldCallback; } + =pod - Sets the timeout callback. Returns a reference to any prior established - callback or undef if there was none. + +=head2 SetTimeoutCallback + +Sets the timeout callback. Returns a reference to any prior +established callback or undef if there was none. + =cut + sub SetTimeoutCallback { - my $self = shift; - my $callback = shift; + + my ($self, $callback) = @_; + my $oldCallback = $self->{TimeoutCallback}; $self->{TimeoutCallback} = $callback; return $oldCallback; } =pod - GetState - selector for the object state. + +=head2 Shutdown: + +Shuts down the socket. + +=cut + +sub Shutdown { + my $self = shift; + my $socket = $self->GetSocket(); + Debug(5,"socket is -$socket-"); + if ($socket) { + # Ask lond to exit too. Non blocking so + # there is no cost for failure. + eval { + $socket->send("exit\n", 0); + $socket->shutdown(2); + } + } + $self->{Timeoutable} = 0; # Shutdown sockets can't timeout. +} + +=pod + +=head2 GetState + +selector for the object state. + =cut + sub GetState { my $self = shift; return $self->{State}; } + =pod - GetSocket - selector for the object socket. + +=head2 GetSocket + +selector for the object socket. + =cut + sub GetSocket { my $self = shift; return $self->{Socket}; } + + =pod - Return the state of the flag that indicates the object wants to be - called when readable. + +=head2 WantReadable + +Return the state of the flag that indicates the object wants to be +called when readable. + =cut + sub WantReadable { my $self = shift; return $self->{InformReadable}; } + =pod - Return the state of the flag that indicates the object wants write - notification. + +=head2 WantWritable + +Return the state of the flag that indicates the object wants write +notification. + =cut + sub WantWritable { my $self = shift; return $self->{InformWritable}; } + =pod - return the state of the flag that indicates the object wants to be informed - of timeouts. + +=head2 WantTimeout + +return the state of the flag that indicates the object wants to be +informed of timeouts. + =cut + sub WantTimeout { my $self = shift; return $self->{Timeoutable}; } =pod - Returns the reply from the last transaction. + +=head2 GetReply + +Returns the reply from the last transaction. + =cut + sub GetReply { my $self = shift; return $self->{TransactionReply}; } =pod - Returns the encrypted version of the command string. - The command input string is of the form: + +=head2 Encrypt + +Returns the encrypted version of the command string. + +The command input string is of the form: + encrypt:command - The output string can be directly sent to lond as it's of the form: + +The output string can be directly sent to lond as it is of the form: + enc:length: -' + =cut + sub Encrypt { - my $self = shift; # Reference to the object. - my $request = shift; # Text to send. + + my ($self, $request) = @_; # Split the encrypt: off the request and figure out it's length. @@ -509,14 +939,20 @@ sub Encrypt { } -=pod - Decrypt - Decrypt a response from the server. The response is in the form: - enc:: + +=pod + +=head2 Decrypt + +Decrypt a response from the server. The response is in the form: + + enc:: + =cut + sub Decrypt { - my $self = shift; # Recover reference to object - my $encrypted = shift; # This is the encrypted data. + + my ($self, $encrypted) = @_; # Bust up the response into length, and encryptedstring: @@ -526,7 +962,7 @@ sub Decrypt { # Decode the data in 8 byte blocks. The string is encoded # as hex digits so there are two characters per byte: - $decrpyted = ""; + my $decrypted = ""; for(my $index = 0; $index < length($EncryptedString); $index += 16) { $decrypted .= $self->{Cipher}->decrypt( @@ -539,100 +975,461 @@ sub Decrypt { # $length tells us the actual length of the decrypted string: $decrypted = substr($decrypted, 0, $length); + Debug(9, "Decrypted $EncryptedString to $decrypted"); 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; -=pod -=head GetHostIterator + $self->Transition("Idle"); + $self->{InformWritiable} = 0; + $self->{InformReadable} = 0; + $self->{Timeoutable} = 0; +} -Returns a hash iterator to the host information. Each get from -this iterator returns a reference to an array that contains -information read from the hosts configuration file. Array elements -are used as follows: +# 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. -[0] - LonCapa host name. -[1] - LonCapa domain name. -[2] - Loncapa role (e.g. library or access). -[3] - DNS name server hostname. -[4] - IP address (result of e.g. nslooup [3]). -[5] - Maximum connection count. -[6] - Idle timeout for reducing connection count. -[7] - Minimum connection count. + $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(9); + 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}; + my $peer = $self->{LoncapaHim}; + # 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(); + my $CRLFile; + unless ($crlchecked{$peer}) { + $CRLFile = lonssl::CRLFile(); + $crlchecked{$peer} = 1; + } + # Promote our connection to ssl and read the key from lond. -=cut -sub GetHostIterator { + my $SSLSocket = lonssl::PromoteClientSocket($socket, + $SSLCACertificate, + $SSLCertificate, + $SSLKey, + $peer, + $CRLFile); + 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 -1; + } + # 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 ($self->{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; + } +} + +########################################################### +# +# The following is an unashamed kludge that is here to +# allow LondConnection to be used outside of the +# loncapa environment (e.g. by lonManage). +# +# This is a textual inclusion of pieces of the +# Configuration.pm module. +# + + +my @confdirs=('/etc/httpd/conf/','/etc/apache2/'); + +# ------------------- Subroutine read_conf: read LON-CAPA server configuration. +# This subroutine reads PerlSetVar values out of specified web server +# configuration files. +sub read_conf + { + my (@conf_files)=@_; + my (%perlvar,%configdirs); + foreach my $filename (@conf_files,'loncapa_apache.conf') { + my $configdir = ''; + $configdirs{$filename} = [@confdirs]; + while ($configdir eq '' && @{$configdirs{$filename}} > 0) { + my $testdir = shift(@{$configdirs{$filename}}); + if (-e $testdir.$filename) { + $configdir = $testdir; + } + } + if ($configdir eq '') { + die("Couldn't find a directory containing $filename"); + } + if($DebugLevel > 3) { + print STDERR ("Going to read $configdir.$filename\n"); + } + open(CONFIG,'<'.$configdir.$filename) or + die("Can't read $configdir$filename"); + while (my $configline=) { + if ($configline =~ /^[^\#]*PerlSetVar/) { + my ($unused,$varname,$varvalue)=split(/\s+/,$configline); + chomp($varvalue); + $perlvar{$varname}=$varvalue; + } + } + close(CONFIG); + } + if($DebugLevel > 3) { + print STDERR "Dumping perlvar:\n"; + foreach my $var (keys %perlvar) { + print STDERR "$var = $perlvar{$var}\n"; + } + } + my $perlvarref=\%perlvar; + return $perlvarref; +} + +# +# Get the version of our peer. Note that this is only well +# defined if the state machine has hit the idle state at least +# once (well actually if it has transitioned out of +# ReadingVersionString The member data LondVersion is returned. +# +sub PeerVersion { + my $self = shift; + my ($version) = ($self->{LondVersion} =~ /Revision: 1\.(\d+)/); + return $version; +} + +# +# Manipulate the client data field +# +sub SetClientData { + my ($self, $newData) = @_; + $self->{ClientData} = $newData; +} +# +# Get the current client data field. +# +sub GetClientData { + my $self = shift; + return $self->{ClientData}; +} + +# +# Get the HostID of our peer +# - return HashIterator->new(\%hostshash); +sub PeerLoncapaHim { + my $self = shift; + return $self->{LoncapaHim}; +} + +# +# Get the Authentication mode +# + +sub GetKeyMode { + my $self = shift; + return $self->{AuthenticationMode}; } 1; =pod + =head1 Theory - The lond object is a state machine. It lives through the following states: -=item Connected: a TCP connection has been formed, but the passkey has not yet - been negotiated. -=item Initialized: "init" sent. -=item ChallengeReceived: lond sent its challenge to us. -=item ChallengeReplied: We replied to lond's challenge waiting for lond's ok. -=item RequestingKey: We are requesting an encryption key. -=item ReceivingKey: We are receiving an encryption key. -=item Idle: Connection was negotiated but no requests are active. -=item SendingRequest: A request is being sent to the peer. -=item ReceivingReply: Waiting for an entire reply from the peer. -=item Disconnected: For whatever reason, the connection was dropped. - - When we need to be writing data, we have a writable -event. When we need to be reading data, a readable event established. -Events dispatch through the class functions Readable and Writable, and the -watcher contains a reference to the associated object to allow object context -to be reached. +The lond object is a state machine. It lives through the following states: + +=item Connected: + +a TCP connection has been formed, but the passkey has not yet been +negotiated. + +=item Initialized: + +"init" sent. + +=item ChallengeReceived: + +lond sent its challenge to us. + +=item ChallengeReplied: + +We replied to lond's challenge waiting for lond's ok. + +=item RequestingKey: + +We are requesting an encryption key. + +=item ReceivingKey: + +We are receiving an encryption key. + +=item Idle: + +Connection was negotiated but no requests are active. + +=item SendingRequest: + +A request is being sent to the peer. + +=item ReceivingReply: + +Waiting for an entire reply from the peer. + +=item Disconnected: + +For whatever reason, the connection was dropped. + +When we need to be writing data, we have a writable event. When we +need to be reading data, a readable event established. Events +dispatch through the class functions Readable and Writable, and the +watcher contains a reference to the associated object to allow object +context to be reached. =head2 Member data. -Host - Host socket is connected to. -Port - The port the remote lond is listening on. -Socket - Socket open on the connection. -State - The current state. -TransactionRequest - The request being transmitted. -TransactionReply - The reply being received from the transaction. -InformReadable - True if we want to be called when socket is readable. -InformWritable - True if we want to be informed if the socket is writable. -Timeoutable - True if the current operation is allowed to timeout. -TimeoutValue - Number of seconds in the timeout. -TimeoutRemaining - Number of seconds left in the timeout. -CipherKey - The key that was negotiated with the peer. -Cipher - The cipher obtained via the key. +=item Host + +Host socket is connected to. + +=item Port + +The port the remote lond is listening on. + +=item Socket + +Socket open on the connection. + +=item State + +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. + +=item TransactionReply + +The reply being received from the transaction. + +=item InformReadable + +True if we want to be called when socket is readable. + +=item InformWritable + +True if we want to be informed if the socket is writable. + +=item Timeoutable + +True if the current operation is allowed to timeout. + +=item TimeoutValue + +Number of seconds in the timeout. + +=item TimeoutRemaining + +Number of seconds left in the timeout. + +=item CipherKey + +The key that was negotiated with the peer. + +=item Cipher + +The cipher obtained via the key. =head2 The following are callback like members: -=item Tick: Called in response to a timer tick. Used to managed timeouts etc. -=item Readable: Called when the socket becomes readable. -=item Writable: Called when the socket becomes writable. -=item TimedOut: Called when a timed operation timed out. + +=item Tick: + +Called in response to a timer tick. Used to managed timeouts etc. + +=item Readable: + +Called when the socket becomes readable. + +=item Writable: + +Called when the socket becomes writable. + +=item TimedOut: + +Called when a timed operation timed out. + =head2 The following are operational member functions. -=item InitiateTransaction: Called to initiate a new transaction -=item SetStateTransitionCallback: Called to establish a function that is called - whenever the object goes through a state transition. This is used by - The client to manage the work flow for the object. -=item SetTimeoutCallback -Set a function to be called when a transaction times - out. The function will be called with the object as its sole parameter. -=item Encrypt - Encrypts a block of text according to the cipher negotiated - with the peer (assumes the text is a command). -=item Decrypt - Decrypts a block of text according to the cipher negotiated - with the peer (assumes the block was a reply. + +=item InitiateTransaction: + +Called to initiate a new transaction + +=item SetStateTransitionCallback: + +Called to establish a function that is called whenever the object goes +through a state transition. This is used by The client to manage the +work flow for the object. + +=item SetTimeoutCallback: + +Set a function to be called when a transaction times out. The +function will be called with the object as its sole parameter. + +=item Encrypt: + +Encrypts a block of text according to the cipher negotiated with the +peer (assumes the text is a command). + +=item Decrypt: + +Decrypts a block of text according to the cipher negotiated with the +peer (assumes the block was a reply. + +=item Shutdown: + +Shuts off the socket. =head2 The following are selector member functions: -=item GetState: Returns the current state -=item GetSocket: Gets the socekt open on the connection to lond. -=item WantReadable: true if the current state requires a readable event. -=item WantWritable: true if the current state requires a writable event. -=item WantTimeout: true if the current state requires timeout support. -=item GetHostIterator: Returns an iterator into the host file hash. +=item GetState: + +Returns the current state + +=item GetSocket: + +Gets the socekt open on the connection to lond. + +=item WantReadable: + +true if the current state requires a readable event. + +=item WantWritable: + +true if the current state requires a writable event. + +=item WantTimeout: + +true if the current state requires timeout support. + =cut 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.