File:
[LON-CAPA] /
loncom /
LondConnection.pm
Revision
1.9:
download - view:
text,
annotated -
select for diffs
Tue Aug 26 09:21:01 2003 UTC (20 years, 8 months ago) by
foxr
Branches:
MAIN
CVS tags:
HEAD
Make the socket/connection timeoutable during connection setup negotiation.
Otherwise we can have some nasty cases where we are able to connect within
the socket connection timeout to a brain dead lond, but then the connection
setup negotiation (init etc.) can take much longer than our paitence permits to
complete.
1: # This module defines and implements a class that represents
2: # a connection to a lond daemon.
3: #
4: # $Id: LondConnection.pm,v 1.9 2003/08/26 09:21:01 foxr Exp $
5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
28: package LondConnection;
29:
30: use IO::Socket;
31: use IO::Socket::INET;
32: use IO::Handle;
33: use IO::File;
34: use Fcntl;
35: use POSIX;
36: use Crypt::IDEA;
37: use LONCAPA::Configuration;
38: use LONCAPA::HashIterator;
39:
40: my $DebugLevel=0;
41:
42: # Read the configuration file for apache to get the perl
43: # variable set.
44:
45: my $perlvarref = LONCAPA::Configuration::read_conf('loncapa.conf');
46: my %perlvar = %{$perlvarref};
47: my $hoststab =
48: LONCAPA::Configuration::read_hosts(
49: "$perlvar{'lonTabDir'}/hosts.tab") ||
50: die "Can't read host table!!";
51: my %hostshash = %{$hoststab};
52:
53: close(CONFIG);
54:
55: sub Debug {
56: my $level = shift;
57: my $message = shift;
58: if ($level < $DebugLevel) {
59: print($message."\n");
60: }
61: }
62:
63: =pod
64:
65: =head2 Dump
66:
67: Dump the internal state of the object: For debugging purposes.
68:
69: =cut
70:
71: sub Dump {
72: my $self = shift;
73: print "Dumping LondConnectionObject:\n";
74: while(($key, $value) = each %$self) {
75: print "$key -> $value\n";
76: }
77: print "-------------------------------\n";
78: }
79:
80: =pod
81:
82: Local function to do a state transition. If the state transition
83: callback is defined it is called with two parameters: the self and the
84: old state.
85:
86: =cut
87:
88: sub Transition {
89: my $self = shift;
90: my $newstate = shift;
91: my $oldstate = $self->{State};
92: $self->{State} = $newstate;
93: $self->{TimeoutRemaining} = $self->{TimeoutValue};
94: if($self->{TransitionCallback}) {
95: ($self->{TransitionCallback})->($self, $oldstate);
96: }
97: }
98:
99:
100: =pod
101:
102: =head2 new
103:
104: Construct a new lond connection.
105:
106: Parameters (besides the class name) include:
107:
108: =item hostname
109:
110: host the remote lond is on. This host is a host in the hosts.tab file
111:
112: =item port
113:
114: port number the remote lond is listening on.
115:
116: =cut
117:
118: sub new {
119: my $class = shift; # class name.
120: my $Hostname = shift; # Name of host to connect to.
121: my $Port = shift; # Port to connect
122: &Debug(4,$class."::new( ".$Hostname.",".$Port.")\n");
123:
124: # The host must map to an entry in the hosts table:
125: # We connect to the dns host that corresponds to that
126: # system and use the hostname for the encryption key
127: # negotion. In the objec these become the Host and
128: # LoncapaHim fields of the object respectively.
129: #
130: if (!exists $hostshash{$Hostname}) {
131: return undef; # No such host!!!
132: }
133: my @ConfigLine = @{$hostshash{$Hostname}};
134: my $DnsName = $ConfigLine[3]; # 4'th item is dns of host.
135: Debug(5, "Connecting to ".$DnsName);
136: # Now create the object...
137: my $self = { Host => $DnsName,
138: LoncapaHim => $Hostname,
139: Port => $Port,
140: State => "Initialized",
141: TransactionRequest => "",
142: TransactionReply => "",
143: InformReadable => 0,
144: InformWritable => 0,
145: TimeoutCallback => undef,
146: TransitionCallback => undef,
147: Timeoutable => 0,
148: TimeoutValue => 30,
149: TimeoutRemaining => 0,
150: CipherKey => "",
151: Cipher => undef};
152: bless($self, $class);
153: unless ($self->{Socket} = IO::Socket::INET->new(PeerHost => $self->{Host},
154: PeerPort => $self->{Port},
155: Type => SOCK_STREAM,
156: Proto => "tcp",
157: Timeout => 5)) {
158: return undef; # Inidicates the socket could not be made.
159: }
160: #
161: # We're connected. Set the state, and the events we'll accept:
162: #
163: $self->Transition("Connected");
164: $self->{InformWritable} = 1; # When socket is writable we send init
165: $self->{Timeoutable} = 1; # Timeout allowed during startup negotiation.
166: $self->{TransactionRequest} = "init\n";
167:
168: #
169: # Set socket to nonblocking I/O.
170: #
171: my $socket = $self->{Socket};
172: $flags = fcntl($socket->fileno, F_GETFL,0);
173: if($flags == -1) {
174: $socket->close;
175: return undef;
176: }
177: if(fcntl($socket, F_SETFL, $flags | O_NONBLOCK) == -1) {
178: $socket->close;
179: return undef;
180: }
181:
182: # return the object :
183:
184: return $self;
185: }
186:
187: =pod
188:
189: =head2 Readable
190:
191: This member should be called when the Socket becomes readable. Until
192: the read completes, action is state independet. Data are accepted into
193: the TransactionReply until a newline character is received. At that
194: time actionis state dependent:
195:
196: =item Connected
197:
198: in this case we received challenge, the state changes to
199: ChallengeReceived, and we initiate a send with the challenge response.
200:
201: =item ReceivingReply
202:
203: In this case a reply has been received for a transaction, the state
204: goes to Idle and we disable write and read notification.
205:
206: =item ChallengeReeived
207:
208: we just got what should be an ok\n and the connection can now handle
209: transactions.
210:
211: =cut
212:
213: sub Readable {
214: my $self = shift;
215: my $socket = $self->{Socket};
216: my $data = '';
217: my $rv = $socket->recv($data, POSIX::BUFSIZ, 0);
218: my $errno = $! + 0; # Force numeric context.
219:
220: unless (defined($rv) && length $data) {# Read failed,
221: if(($errno == POSIX::EWOULDBLOCK) ||
222: ($errno == POSIX::EAGAIN) ||
223: ($errno == POSIX::EINTR)) {
224: return 0;
225: }
226:
227: # Connection likely lost.
228: &Debug(4, "Connection lost");
229: $self->{TransactionRequest} = '';
230: $socket->close();
231: $self->Transition("Disconnected");
232: return -1;
233: }
234: # Append the data to the buffer. And figure out if the read is done:
235:
236: &Debug(9,"Received from host: ".$data);
237: $self->{TransactionReply} .= $data;
238: if($self->{TransactionReply} =~ /(.*\n)/) {
239: &Debug(8,"Readable End of line detected");
240: if ($self->{State} eq "Initialized") { # We received the challenge:
241: if($self->{TransactionReply} eq "refused") { # Remote doesn't have
242:
243: $self->Transition("Disconnected"); # in host tables.
244: $socket->close();
245: return -1;
246: }
247:
248: &Debug(8," Transition out of Initialized");
249: $self->{TransactionRequest} = $self->{TransactionReply};
250: $self->{InformWritable} = 1;
251: $self->{InformReadable} = 0;
252: $self->Transition("ChallengeReceived");
253: $self->{TimeoutRemaining} = $self->{TimeoutValue};
254: return 0;
255: } elsif ($self->{State} eq "ChallengeReplied") { # should be ok.
256: if($self->{TransactionReply} != "ok\n") {
257: $self->Transition("Disconnected");
258: $socket->close();
259: return -1;
260: }
261: $self->Transition("RequestingKey");
262: $self->{InformReadable} = 0;
263: $self->{InformWritable} = 1;
264: $self->{TransactionRequest} = "ekey\n";
265: return 0;
266: } elsif ($self->{State} eq "ReceivingKey") {
267: my $buildkey = $self->{TransactionReply};
268: my $key = $self->{LoncapaHim}.$perlvar{'lonHostID'};
269: $key=~tr/a-z/A-Z/;
270: $key=~tr/G-P/0-9/;
271: $key=~tr/Q-Z/0-9/;
272: $key=$key.$buildkey.$key.$buildkey.$key.$buildkey;
273: $key=substr($key,0,32);
274: my $cipherkey=pack("H32",$key);
275: $self->{Cipher} = new IDEA $cipherkey;
276: if($self->{Cipher} == undef) {
277: $self->Transition("Disconnected");
278: $socket->close();
279: return -1;
280: } else {
281: $self->Transition("Idle");
282: $self->{InformWritable} = 0;
283: $self->{InformReadable} = 0;
284: $self->{Timeoutable} = 0;
285: return 0;
286: }
287: } elsif ($self->{State} eq "ReceivingReply") {
288:
289: # If the data are encrypted, decrypt first.
290:
291: my $answer = $self->{TransactionReply};
292: if($answer =~ /^enc\:/) {
293: $answer = $self->Decrypt($answer);
294: $self->{TransactionReply} = $answer;
295: }
296:
297: # finish the transaction
298:
299: $self->{InformWritable} = 0;
300: $self->{InformReadable} = 0;
301: $self->{Timeoutable} = 0;
302: $self->Transition("Idle");
303: return 0;
304: } elsif ($self->{State} eq "Disconnected") { # No connection.
305: return -1;
306: } else { # Internal error: Invalid state.
307: $self->Transition("Disconnected");
308: $socket->close();
309: return -1;
310: }
311: }
312:
313: return 0;
314:
315: }
316:
317:
318: =pod
319:
320: This member should be called when the Socket becomes writable.
321:
322: The action is state independent. An attempt is made to drain the
323: contents of the TransactionRequest member. Once this is drained, we
324: mark the object as waiting for readability.
325:
326: Returns 0 if successful, or -1 if not.
327:
328: =cut
329: sub Writable {
330: my $self = shift; # Get reference to the object.
331: my $socket = $self->{Socket};
332: my $nwritten = $socket->send($self->{TransactionRequest}, 0);
333: my $errno = $! + 0;
334: unless (defined $nwritten) {
335: if($errno != POSIX::EINTR) {
336: $self->Transition("Disconnected");
337: return -1;
338: }
339:
340: }
341: if (($rv >= 0) ||
342: ($errno == POSIX::EWOULDBLOCK) ||
343: ($errno == POSIX::EAGAIN) ||
344: ($errno == POSIX::EINTR) ||
345: ($errno == 0)) {
346: substr($self->{TransactionRequest}, 0, $nwritten) = ""; # rmv written part
347: if(length $self->{TransactionRequest} == 0) {
348: $self->{InformWritable} = 0;
349: $self->{InformReadable} = 1;
350: $self->{TransactionReply} = '';
351: #
352: # Figure out the next state:
353: #
354: if($self->{State} eq "Connected") {
355: $self->Transition("Initialized");
356: } elsif($self->{State} eq "ChallengeReceived") {
357: $self->Transition("ChallengeReplied");
358: } elsif($self->{State} eq "RequestingKey") {
359: $self->Transition("ReceivingKey");
360: $self->{InformWritable} = 0;
361: $self->{InformReadable} = 1;
362: $self->{TransactionReply} = '';
363: } elsif ($self->{State} eq "SendingRequest") {
364: $self->Transition("ReceivingReply");
365: $self->{TimeoutRemaining} = $self->{TimeoutValue};
366: } elsif ($self->{State} eq "Disconnected") {
367: return -1;
368: }
369: return 0;
370: }
371: } else { # The write failed (e.g. partner disconnected).
372: $self->Transition("Disconnected");
373: $socket->close();
374: return -1;
375: }
376:
377: }
378: =pod
379:
380: =head2 Tick
381:
382: Tick is called every time unit by the event framework. It
383:
384: =item 1 decrements the remaining timeout.
385:
386: =item 2 If the timeout is zero, calls TimedOut indicating that the current operation timed out.
387:
388: =cut
389:
390: sub Tick {
391: my $self = shift;
392: $self->{TimeoutRemaining}--;
393: if ($self->{TimeoutRemaining} < 0) {
394: $self->TimedOut();
395: }
396: }
397:
398: =pod
399:
400: =head2 TimedOut
401:
402: called on a timeout. If the timeout callback is defined, it is called
403: with $self as its parameters.
404:
405: =cut
406:
407: sub TimedOut {
408:
409: my $self = shift;
410: if($self->{TimeoutCallback}) {
411: my $callback = $self->{TimeoutCallback};
412: my @args = ( $self);
413: &$callback(@args);
414: }
415: }
416:
417: =pod
418:
419: =head2 InitiateTransaction
420:
421: Called to initiate a transaction. A transaction can only be initiated
422: when the object is idle... otherwise an error is returned. A
423: transaction consists of a request to the server that will have a
424: reply. This member sets the request data in the TransactionRequest
425: member, makes the state SendingRequest and sets the data to allow a
426: timout, and to request writability notification.
427:
428: =cut
429:
430: sub InitiateTransaction {
431: my $self = shift;
432: my $data = shift;
433:
434: Debug(1, "initiating transaction: ".$data);
435: if($self->{State} ne "Idle") {
436: Debug(0," .. but not idle here\n");
437: return -1; # Error indicator.
438: }
439: # if the transaction is to be encrypted encrypt the data:
440:
441: if($data =~ /^encrypt\:/) {
442: $data = $self->Encrypt($data);
443: }
444:
445: # Setup the trasaction
446:
447: $self->{TransactionRequest} = $data;
448: $self->{TransactionReply} = "";
449: $self->{InformWritable} = 1;
450: $self->{InformReadable} = 0;
451: $self->{Timeoutable} = 1;
452: $self->{TimeoutRemaining} = $self->{TimeoutValue};
453: $self->Transition("SendingRequest");
454: }
455:
456:
457: =pod
458:
459: =head2 SetStateTransitionCallback
460:
461: Sets a callback for state transitions. Returns a reference to any
462: prior established callback, or undef if there was none:
463:
464: =cut
465:
466: sub SetStateTransitionCallback {
467: my $self = shift;
468: my $oldCallback = $self->{TransitionCallback};
469: $self->{TransitionCallback} = shift;
470: return $oldCallback;
471: }
472:
473: =pod
474:
475: =head2 SetTimeoutCallback
476:
477: Sets the timeout callback. Returns a reference to any prior
478: established callback or undef if there was none.
479:
480: =cut
481:
482: sub SetTimeoutCallback {
483: my $self = shift;
484: my $callback = shift;
485: my $oldCallback = $self->{TimeoutCallback};
486: $self->{TimeoutCallback} = $callback;
487: return $oldCallback;
488: }
489:
490: =pod
491:
492: =head2 Shutdown:
493:
494: Shuts down the socket.
495:
496: =cut
497:
498: sub Shutdown {
499: my $self = shift;
500: my $socket = $self->GetSocket();
501: $socket->shutdown(2);
502: }
503:
504: =pod
505:
506: =head2 GetState
507:
508: selector for the object state.
509:
510: =cut
511:
512: sub GetState {
513: my $self = shift;
514: return $self->{State};
515: }
516:
517: =pod
518:
519: =head2 GetSocket
520:
521: selector for the object socket.
522:
523: =cut
524:
525: sub GetSocket {
526: my $self = shift;
527: return $self->{Socket};
528: }
529:
530:
531: =pod
532:
533: =head2 WantReadable
534:
535: Return the state of the flag that indicates the object wants to be
536: called when readable.
537:
538: =cut
539:
540: sub WantReadable {
541: my $self = shift;
542:
543: return $self->{InformReadable};
544: }
545:
546: =pod
547:
548: =head2 WantWritable
549:
550: Return the state of the flag that indicates the object wants write
551: notification.
552:
553: =cut
554:
555: sub WantWritable {
556: my $self = shift;
557: return $self->{InformWritable};
558: }
559:
560: =pod
561:
562: =head2 WantTimeout
563:
564: return the state of the flag that indicates the object wants to be
565: informed of timeouts.
566:
567: =cut
568:
569: sub WantTimeout {
570: my $self = shift;
571: return $self->{Timeoutable};
572: }
573:
574: =pod
575:
576: =head2 GetReply
577:
578: Returns the reply from the last transaction.
579:
580: =cut
581:
582: sub GetReply {
583: my $self = shift;
584: return $self->{TransactionReply};
585: }
586:
587: =pod
588:
589: =head2 Encrypt
590:
591: Returns the encrypted version of the command string.
592:
593: The command input string is of the form:
594:
595: encrypt:command
596:
597: The output string can be directly sent to lond as it is of the form:
598:
599: enc:length:<encodedrequest>
600:
601: =cut
602:
603: sub Encrypt {
604: my $self = shift; # Reference to the object.
605: my $request = shift; # Text to send.
606:
607:
608: # Split the encrypt: off the request and figure out it's length.
609: # the cipher works in blocks of 8 bytes.
610:
611: my $cmd = $request;
612: $cmd =~ s/^encrypt\://; # strip off encrypt:
613: chomp($cmd); # strip off trailing \n
614: my $length=length($cmd); # Get the string length.
615: $cmd .= " "; # Pad with blanks so we can fill out a block.
616:
617: # encrypt the request in 8 byte chunks to create the encrypted
618: # output request.
619:
620: my $Encoded = '';
621: for(my $index = 0; $index <= $length; $index += 8) {
622: $Encoded .=
623: unpack("H16",
624: $self->{Cipher}->encrypt(substr($cmd,
625: $index, 8)));
626: }
627:
628: # Build up the answer as enc:length:$encrequest.
629:
630: $request = "enc:$length:$Encoded\n";
631: return $request;
632:
633:
634: }
635:
636: =pod
637:
638: =head2 Decrypt
639:
640: Decrypt a response from the server. The response is in the form:
641:
642: enc:<length>:<encrypted data>
643:
644: =cut
645:
646: sub Decrypt {
647: my $self = shift; # Recover reference to object
648: my $encrypted = shift; # This is the encrypted data.
649:
650: # Bust up the response into length, and encryptedstring:
651:
652: my ($enc, $length, $EncryptedString) = split(/:/,$encrypted);
653: chomp($EncryptedString);
654:
655: # Decode the data in 8 byte blocks. The string is encoded
656: # as hex digits so there are two characters per byte:
657:
658: $decrpyted = "";
659: for(my $index = 0; $index < length($EncryptedString);
660: $index += 16) {
661: $decrypted .= $self->{Cipher}->decrypt(
662: pack("H16",
663: substr($EncryptedString,
664: $index,
665: 16)));
666: }
667: # the answer may have trailing pads to fill out a block.
668: # $length tells us the actual length of the decrypted string:
669:
670: $decrypted = substr($decrypted, 0, $length);
671:
672: return $decrypted;
673:
674: }
675:
676: =pod
677:
678: =head2 GetHostIterator
679:
680: Returns a hash iterator to the host information. Each get from
681: this iterator returns a reference to an array that contains
682: information read from the hosts configuration file. Array elements
683: are used as follows:
684:
685: [0] - LonCapa host name.
686: [1] - LonCapa domain name.
687: [2] - Loncapa role (e.g. library or access).
688: [3] - DNS name server hostname.
689: [4] - IP address (result of e.g. nslooup [3]).
690: [5] - Maximum connection count.
691: [6] - Idle timeout for reducing connection count.
692: [7] - Minimum connection count.
693:
694: =cut
695:
696: sub GetHostIterator {
697:
698: return HashIterator->new(\%hostshash);
699: }
700:
701: 1;
702:
703: =pod
704:
705: =head1 Theory
706:
707: The lond object is a state machine. It lives through the following states:
708:
709: =item Connected:
710:
711: a TCP connection has been formed, but the passkey has not yet been
712: negotiated.
713:
714: =item Initialized:
715:
716: "init" sent.
717:
718: =item ChallengeReceived:
719:
720: lond sent its challenge to us.
721:
722: =item ChallengeReplied:
723:
724: We replied to lond's challenge waiting for lond's ok.
725:
726: =item RequestingKey:
727:
728: We are requesting an encryption key.
729:
730: =item ReceivingKey:
731:
732: We are receiving an encryption key.
733:
734: =item Idle:
735:
736: Connection was negotiated but no requests are active.
737:
738: =item SendingRequest:
739:
740: A request is being sent to the peer.
741:
742: =item ReceivingReply:
743:
744: Waiting for an entire reply from the peer.
745:
746: =item Disconnected:
747:
748: For whatever reason, the connection was dropped.
749:
750: When we need to be writing data, we have a writable event. When we
751: need to be reading data, a readable event established. Events
752: dispatch through the class functions Readable and Writable, and the
753: watcher contains a reference to the associated object to allow object
754: context to be reached.
755:
756: =head2 Member data.
757:
758: =item Host
759:
760: Host socket is connected to.
761:
762: =item Port
763:
764: The port the remote lond is listening on.
765:
766: =item Socket
767:
768: Socket open on the connection.
769:
770: =item State
771:
772: The current state.
773:
774: =item TransactionRequest
775:
776: The request being transmitted.
777:
778: =item TransactionReply
779:
780: The reply being received from the transaction.
781:
782: =item InformReadable
783:
784: True if we want to be called when socket is readable.
785:
786: =item InformWritable
787:
788: True if we want to be informed if the socket is writable.
789:
790: =item Timeoutable
791:
792: True if the current operation is allowed to timeout.
793:
794: =item TimeoutValue
795:
796: Number of seconds in the timeout.
797:
798: =item TimeoutRemaining
799:
800: Number of seconds left in the timeout.
801:
802: =item CipherKey
803:
804: The key that was negotiated with the peer.
805:
806: =item Cipher
807:
808: The cipher obtained via the key.
809:
810:
811: =head2 The following are callback like members:
812:
813: =item Tick:
814:
815: Called in response to a timer tick. Used to managed timeouts etc.
816:
817: =item Readable:
818:
819: Called when the socket becomes readable.
820:
821: =item Writable:
822:
823: Called when the socket becomes writable.
824:
825: =item TimedOut:
826:
827: Called when a timed operation timed out.
828:
829:
830: =head2 The following are operational member functions.
831:
832: =item InitiateTransaction:
833:
834: Called to initiate a new transaction
835:
836: =item SetStateTransitionCallback:
837:
838: Called to establish a function that is called whenever the object goes
839: through a state transition. This is used by The client to manage the
840: work flow for the object.
841:
842: =item SetTimeoutCallback:
843:
844: Set a function to be called when a transaction times out. The
845: function will be called with the object as its sole parameter.
846:
847: =item Encrypt:
848:
849: Encrypts a block of text according to the cipher negotiated with the
850: peer (assumes the text is a command).
851:
852: =item Decrypt:
853:
854: Decrypts a block of text according to the cipher negotiated with the
855: peer (assumes the block was a reply.
856:
857: =item Shutdown:
858:
859: Shuts off the socket.
860:
861: =head2 The following are selector member functions:
862:
863: =item GetState:
864:
865: Returns the current state
866:
867: =item GetSocket:
868:
869: Gets the socekt open on the connection to lond.
870:
871: =item WantReadable:
872:
873: true if the current state requires a readable event.
874:
875: =item WantWritable:
876:
877: true if the current state requires a writable event.
878:
879: =item WantTimeout:
880:
881: true if the current state requires timeout support.
882:
883: =item GetHostIterator:
884:
885: Returns an iterator into the host file hash.
886:
887: =cut
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to LondConnection.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom