1: # This module defines and implements a class that represents
2: # a connection to a lond daemon.
3: #
4: # $Id: LondConnection.pm,v 1.3 2003/04/18 06:07:27 albertel 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=4;
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: return undef; # Inidicates the socket could not be made.
158: }
159: #
160: # We're connected. Set the state, and the events we'll accept:
161: #
162: $self->Transition("Connected");
163: $self->{InformWritable} = 1; # When socket is writable we send init
164: $self->{TransactionRequest} = "init\n";
165:
166: #
167: # Set socket to nonblocking I/O.
168: #
169: my $socket = $self->{Socket};
170: $flags = fcntl($socket->fileno, F_GETFL,0);
171: if($flags == -1) {
172: $socket->close;
173: return undef;
174: }
175: if(fcntl($socket, F_SETFL, $flags | O_NONBLOCK) == -1) {
176: $socket->close;
177: return undef;
178: }
179:
180: # return the object :
181:
182: return $self;
183: }
184:
185: =pod
186:
187: =head2 Readable
188:
189: This member should be called when the Socket becomes readable. Until
190: the read completes, action is state independet. Data are accepted into
191: the TransactionReply until a newline character is received. At that
192: time actionis state dependent:
193:
194: =item Connected
195:
196: in this case we received challenge, the state changes to
197: ChallengeReceived, and we initiate a send with the challenge response.
198:
199: =item ReceivingReply
200:
201: In this case a reply has been received for a transaction, the state
202: goes to Idle and we disable write and read notification.
203:
204: =item ChallengeReeived
205:
206: we just got what should be an ok\n and the connection can now handle
207: transactions.
208:
209: =cut
210:
211: sub Readable {
212: my $self = shift;
213: my $socket = $self->{Socket};
214: my $data = '';
215: my $rv = $socket->recv($data, POSIX::BUFSIZ, 0);
216: my $errno = $! + 0; # Force numeric context.
217:
218: unless (defined($rv) && length($data)) { # Read failed,
219: if(($errno == POSIX::EWOULDBLOCK) ||
220: ($errno == POSIX::EAGAIN) ||
221: ($errno == POSIX::EINTR) ||
222: ($errno == 0)) {
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: if($self->{State} ne "Idle") {
434: return -1; # Error indicator.
435: }
436: # if the transaction is to be encrypted encrypt the data:
437:
438: if($data =~ /^encrypt\:/) {
439: $data = $self->Encrypt($data);
440: }
441:
442: # Setup the trasaction
443:
444: $self->{TransactionRequest} = $data;
445: $self->{TransactionReply} = "";
446: $self->{InformWritable} = 1;
447: $self->{InformReadable} = 0;
448: $self->{Timeoutable} = 1;
449: $self->{TimeoutRemaining} = $self->{TimeoutValue};
450: $self->Transition("SendingRequest");
451: }
452:
453:
454: =pod
455:
456: =head2 SetStateTransitionCallback
457:
458: Sets a callback for state transitions. Returns a reference to any
459: prior established callback, or undef if there was none:
460:
461: =cut
462:
463: sub SetStateTransitionCallback {
464: my $self = shift;
465: my $oldCallback = $self->{TransitionCallback};
466: $self->{TransitionCallback} = shift;
467: return $oldCallback;
468: }
469:
470: =pod
471:
472: =head2 SetTimeoutCallback
473:
474: Sets the timeout callback. Returns a reference to any prior
475: established callback or undef if there was none.
476:
477: =cut
478:
479: sub SetTimeoutCallback {
480: my $self = shift;
481: my $callback = shift;
482: my $oldCallback = $self->{TimeoutCallback};
483: $self->{TimeoutCallback} = $callback;
484: return $oldCallback;
485: }
486:
487: =pod
488:
489: =head2 GetState
490:
491: selector for the object state.
492:
493: =cut
494:
495: sub GetState {
496: my $self = shift;
497: return $self->{State};
498: }
499:
500: =pod
501:
502: =head2 GetSocket
503:
504: selector for the object socket.
505:
506: =cut
507:
508: sub GetSocket {
509: my $self = shift;
510: return $self->{Socket};
511: }
512:
513: =pod
514:
515: =head2 WantReadable
516:
517: Return the state of the flag that indicates the object wants to be
518: called when readable.
519:
520: =cut
521:
522: sub WantReadable {
523: my $self = shift;
524:
525: return $self->{InformReadable};
526: }
527:
528: =pod
529:
530: =head2 WantWritable
531:
532: Return the state of the flag that indicates the object wants write
533: notification.
534:
535: =cut
536:
537: sub WantWritable {
538: my $self = shift;
539: return $self->{InformWritable};
540: }
541:
542: =pod
543:
544: =head2 WantTimeout
545:
546: return the state of the flag that indicates the object wants to be
547: informed of timeouts.
548:
549: =cut
550:
551: sub WantTimeout {
552: my $self = shift;
553: return $self->{Timeoutable};
554: }
555:
556: =pod
557:
558: =head2 GetReply
559:
560: Returns the reply from the last transaction.
561:
562: =cut
563:
564: sub GetReply {
565: my $self = shift;
566: return $self->{TransactionReply};
567: }
568:
569: =pod
570:
571: =head2 Encrypt
572:
573: Returns the encrypted version of the command string.
574:
575: The command input string is of the form:
576:
577: encrypt:command
578:
579: The output string can be directly sent to lond as it is of the form:
580:
581: enc:length:<encodedrequest>
582:
583: =cut
584:
585: sub Encrypt {
586: my $self = shift; # Reference to the object.
587: my $request = shift; # Text to send.
588:
589:
590: # Split the encrypt: off the request and figure out it's length.
591: # the cipher works in blocks of 8 bytes.
592:
593: my $cmd = $request;
594: $cmd =~ s/^encrypt\://; # strip off encrypt:
595: chomp($cmd); # strip off trailing \n
596: my $length=length($cmd); # Get the string length.
597: $cmd .= " "; # Pad with blanks so we can fill out a block.
598:
599: # encrypt the request in 8 byte chunks to create the encrypted
600: # output request.
601:
602: my $Encoded = '';
603: for(my $index = 0; $index <= $length; $index += 8) {
604: $Encoded .=
605: unpack("H16",
606: $self->{Cipher}->encrypt(substr($cmd,
607: $index, 8)));
608: }
609:
610: # Build up the answer as enc:length:$encrequest.
611:
612: $request = "enc:$length:$Encoded\n";
613: return $request;
614:
615:
616: }
617:
618: =pod
619:
620: =head2 Decrypt
621:
622: Decrypt a response from the server. The response is in the form:
623:
624: enc:<length>:<encrypted data>
625:
626: =cut
627:
628: sub Decrypt {
629: my $self = shift; # Recover reference to object
630: my $encrypted = shift; # This is the encrypted data.
631:
632: # Bust up the response into length, and encryptedstring:
633:
634: my ($enc, $length, $EncryptedString) = split(/:/,$encrypted);
635: chomp($EncryptedString);
636:
637: # Decode the data in 8 byte blocks. The string is encoded
638: # as hex digits so there are two characters per byte:
639:
640: $decrpyted = "";
641: for(my $index = 0; $index < length($EncryptedString);
642: $index += 16) {
643: $decrypted .= $self->{Cipher}->decrypt(
644: pack("H16",
645: substr($EncryptedString,
646: $index,
647: 16)));
648: }
649: # the answer may have trailing pads to fill out a block.
650: # $length tells us the actual length of the decrypted string:
651:
652: $decrypted = substr($decrypted, 0, $length);
653:
654: return $decrypted;
655:
656: }
657:
658: =pod
659:
660: =head2 GetHostIterator
661:
662: Returns a hash iterator to the host information. Each get from
663: this iterator returns a reference to an array that contains
664: information read from the hosts configuration file. Array elements
665: are used as follows:
666:
667: [0] - LonCapa host name.
668: [1] - LonCapa domain name.
669: [2] - Loncapa role (e.g. library or access).
670: [3] - DNS name server hostname.
671: [4] - IP address (result of e.g. nslooup [3]).
672: [5] - Maximum connection count.
673: [6] - Idle timeout for reducing connection count.
674: [7] - Minimum connection count.
675:
676: =cut
677:
678: sub GetHostIterator {
679:
680: return HashIterator->new(\%hostshash);
681: }
682:
683: 1;
684:
685: =pod
686:
687: =head1 Theory
688:
689: The lond object is a state machine. It lives through the following states:
690:
691: =item Connected:
692:
693: a TCP connection has been formed, but the passkey has not yet been
694: negotiated.
695:
696: =item Initialized:
697:
698: "init" sent.
699:
700: =item ChallengeReceived:
701:
702: lond sent its challenge to us.
703:
704: =item ChallengeReplied:
705:
706: We replied to lond's challenge waiting for lond's ok.
707:
708: =item RequestingKey:
709:
710: We are requesting an encryption key.
711:
712: =item ReceivingKey:
713:
714: We are receiving an encryption key.
715:
716: =item Idle:
717:
718: Connection was negotiated but no requests are active.
719:
720: =item SendingRequest:
721:
722: A request is being sent to the peer.
723:
724: =item ReceivingReply:
725:
726: Waiting for an entire reply from the peer.
727:
728: =item Disconnected:
729:
730: For whatever reason, the connection was dropped.
731:
732: When we need to be writing data, we have a writable event. When we
733: need to be reading data, a readable event established. Events
734: dispatch through the class functions Readable and Writable, and the
735: watcher contains a reference to the associated object to allow object
736: context to be reached.
737:
738: =head2 Member data.
739:
740: =item Host
741:
742: Host socket is connected to.
743:
744: =item Port
745:
746: The port the remote lond is listening on.
747:
748: =item Socket
749:
750: Socket open on the connection.
751:
752: =item State
753:
754: The current state.
755:
756: =item TransactionRequest
757:
758: The request being transmitted.
759:
760: =item TransactionReply
761:
762: The reply being received from the transaction.
763:
764: =item InformReadable
765:
766: True if we want to be called when socket is readable.
767:
768: =item InformWritable
769:
770: True if we want to be informed if the socket is writable.
771:
772: =item Timeoutable
773:
774: True if the current operation is allowed to timeout.
775:
776: =item TimeoutValue
777:
778: Number of seconds in the timeout.
779:
780: =item TimeoutRemaining
781:
782: Number of seconds left in the timeout.
783:
784: =item CipherKey
785:
786: The key that was negotiated with the peer.
787:
788: =item Cipher
789:
790: The cipher obtained via the key.
791:
792:
793: =head2 The following are callback like members:
794:
795: =item Tick:
796:
797: Called in response to a timer tick. Used to managed timeouts etc.
798:
799: =item Readable:
800:
801: Called when the socket becomes readable.
802:
803: =item Writable:
804:
805: Called when the socket becomes writable.
806:
807: =item TimedOut:
808:
809: Called when a timed operation timed out.
810:
811:
812: =head2 The following are operational member functions.
813:
814: =item InitiateTransaction:
815:
816: Called to initiate a new transaction
817:
818: =item SetStateTransitionCallback:
819:
820: Called to establish a function that is called whenever the object goes
821: through a state transition. This is used by The client to manage the
822: work flow for the object.
823:
824: =item SetTimeoutCallback:
825:
826: Set a function to be called when a transaction times out. The
827: function will be called with the object as its sole parameter.
828:
829: =item Encrypt:
830:
831: Encrypts a block of text according to the cipher negotiated with the
832: peer (assumes the text is a command).
833:
834: =item Decrypt:
835:
836: Decrypts a block of text according to the cipher negotiated with the
837: peer (assumes the block was a reply.
838:
839: =head2 The following are selector member functions:
840:
841: =item GetState:
842:
843: Returns the current state
844:
845: =item GetSocket:
846:
847: Gets the socekt open on the connection to lond.
848:
849: =item WantReadable:
850:
851: true if the current state requires a readable event.
852:
853: =item WantWritable:
854:
855: true if the current state requires a writable event.
856:
857: =item WantTimeout:
858:
859: true if the current state requires timeout support.
860:
861: =item GetHostIterator:
862:
863: Returns an iterator into the host file hash.
864:
865: =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