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