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