1: # This module defines and implements a class that represents
2: # a connection to a lond daemon.
3: #
4: # $Id: LondConnection.pm,v 1.4 2003/06/11 02:04:35 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=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: 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 GetState
492:
493: selector for the object state.
494:
495: =cut
496:
497: sub GetState {
498: my $self = shift;
499: return $self->{State};
500: }
501:
502: =pod
503:
504: =head2 GetSocket
505:
506: selector for the object socket.
507:
508: =cut
509:
510: sub GetSocket {
511: my $self = shift;
512: return $self->{Socket};
513: }
514:
515: =pod
516:
517: =head2 WantReadable
518:
519: Return the state of the flag that indicates the object wants to be
520: called when readable.
521:
522: =cut
523:
524: sub WantReadable {
525: my $self = shift;
526:
527: return $self->{InformReadable};
528: }
529:
530: =pod
531:
532: =head2 WantWritable
533:
534: Return the state of the flag that indicates the object wants write
535: notification.
536:
537: =cut
538:
539: sub WantWritable {
540: my $self = shift;
541: return $self->{InformWritable};
542: }
543:
544: =pod
545:
546: =head2 WantTimeout
547:
548: return the state of the flag that indicates the object wants to be
549: informed of timeouts.
550:
551: =cut
552:
553: sub WantTimeout {
554: my $self = shift;
555: return $self->{Timeoutable};
556: }
557:
558: =pod
559:
560: =head2 GetReply
561:
562: Returns the reply from the last transaction.
563:
564: =cut
565:
566: sub GetReply {
567: my $self = shift;
568: return $self->{TransactionReply};
569: }
570:
571: =pod
572:
573: =head2 Encrypt
574:
575: Returns the encrypted version of the command string.
576:
577: The command input string is of the form:
578:
579: encrypt:command
580:
581: The output string can be directly sent to lond as it is of the form:
582:
583: enc:length:<encodedrequest>
584:
585: =cut
586:
587: sub Encrypt {
588: my $self = shift; # Reference to the object.
589: my $request = shift; # Text to send.
590:
591:
592: # Split the encrypt: off the request and figure out it's length.
593: # the cipher works in blocks of 8 bytes.
594:
595: my $cmd = $request;
596: $cmd =~ s/^encrypt\://; # strip off encrypt:
597: chomp($cmd); # strip off trailing \n
598: my $length=length($cmd); # Get the string length.
599: $cmd .= " "; # Pad with blanks so we can fill out a block.
600:
601: # encrypt the request in 8 byte chunks to create the encrypted
602: # output request.
603:
604: my $Encoded = '';
605: for(my $index = 0; $index <= $length; $index += 8) {
606: $Encoded .=
607: unpack("H16",
608: $self->{Cipher}->encrypt(substr($cmd,
609: $index, 8)));
610: }
611:
612: # Build up the answer as enc:length:$encrequest.
613:
614: $request = "enc:$length:$Encoded\n";
615: return $request;
616:
617:
618: }
619:
620: =pod
621:
622: =head2 Decrypt
623:
624: Decrypt a response from the server. The response is in the form:
625:
626: enc:<length>:<encrypted data>
627:
628: =cut
629:
630: sub Decrypt {
631: my $self = shift; # Recover reference to object
632: my $encrypted = shift; # This is the encrypted data.
633:
634: # Bust up the response into length, and encryptedstring:
635:
636: my ($enc, $length, $EncryptedString) = split(/:/,$encrypted);
637: chomp($EncryptedString);
638:
639: # Decode the data in 8 byte blocks. The string is encoded
640: # as hex digits so there are two characters per byte:
641:
642: $decrpyted = "";
643: for(my $index = 0; $index < length($EncryptedString);
644: $index += 16) {
645: $decrypted .= $self->{Cipher}->decrypt(
646: pack("H16",
647: substr($EncryptedString,
648: $index,
649: 16)));
650: }
651: # the answer may have trailing pads to fill out a block.
652: # $length tells us the actual length of the decrypted string:
653:
654: $decrypted = substr($decrypted, 0, $length);
655:
656: return $decrypted;
657:
658: }
659:
660: =pod
661:
662: =head2 GetHostIterator
663:
664: Returns a hash iterator to the host information. Each get from
665: this iterator returns a reference to an array that contains
666: information read from the hosts configuration file. Array elements
667: are used as follows:
668:
669: [0] - LonCapa host name.
670: [1] - LonCapa domain name.
671: [2] - Loncapa role (e.g. library or access).
672: [3] - DNS name server hostname.
673: [4] - IP address (result of e.g. nslooup [3]).
674: [5] - Maximum connection count.
675: [6] - Idle timeout for reducing connection count.
676: [7] - Minimum connection count.
677:
678: =cut
679:
680: sub GetHostIterator {
681:
682: return HashIterator->new(\%hostshash);
683: }
684:
685: 1;
686:
687: =pod
688:
689: =head1 Theory
690:
691: The lond object is a state machine. It lives through the following states:
692:
693: =item Connected:
694:
695: a TCP connection has been formed, but the passkey has not yet been
696: negotiated.
697:
698: =item Initialized:
699:
700: "init" sent.
701:
702: =item ChallengeReceived:
703:
704: lond sent its challenge to us.
705:
706: =item ChallengeReplied:
707:
708: We replied to lond's challenge waiting for lond's ok.
709:
710: =item RequestingKey:
711:
712: We are requesting an encryption key.
713:
714: =item ReceivingKey:
715:
716: We are receiving an encryption key.
717:
718: =item Idle:
719:
720: Connection was negotiated but no requests are active.
721:
722: =item SendingRequest:
723:
724: A request is being sent to the peer.
725:
726: =item ReceivingReply:
727:
728: Waiting for an entire reply from the peer.
729:
730: =item Disconnected:
731:
732: For whatever reason, the connection was dropped.
733:
734: When we need to be writing data, we have a writable event. When we
735: need to be reading data, a readable event established. Events
736: dispatch through the class functions Readable and Writable, and the
737: watcher contains a reference to the associated object to allow object
738: context to be reached.
739:
740: =head2 Member data.
741:
742: =item Host
743:
744: Host socket is connected to.
745:
746: =item Port
747:
748: The port the remote lond is listening on.
749:
750: =item Socket
751:
752: Socket open on the connection.
753:
754: =item State
755:
756: The current state.
757:
758: =item TransactionRequest
759:
760: The request being transmitted.
761:
762: =item TransactionReply
763:
764: The reply being received from the transaction.
765:
766: =item InformReadable
767:
768: True if we want to be called when socket is readable.
769:
770: =item InformWritable
771:
772: True if we want to be informed if the socket is writable.
773:
774: =item Timeoutable
775:
776: True if the current operation is allowed to timeout.
777:
778: =item TimeoutValue
779:
780: Number of seconds in the timeout.
781:
782: =item TimeoutRemaining
783:
784: Number of seconds left in the timeout.
785:
786: =item CipherKey
787:
788: The key that was negotiated with the peer.
789:
790: =item Cipher
791:
792: The cipher obtained via the key.
793:
794:
795: =head2 The following are callback like members:
796:
797: =item Tick:
798:
799: Called in response to a timer tick. Used to managed timeouts etc.
800:
801: =item Readable:
802:
803: Called when the socket becomes readable.
804:
805: =item Writable:
806:
807: Called when the socket becomes writable.
808:
809: =item TimedOut:
810:
811: Called when a timed operation timed out.
812:
813:
814: =head2 The following are operational member functions.
815:
816: =item InitiateTransaction:
817:
818: Called to initiate a new transaction
819:
820: =item SetStateTransitionCallback:
821:
822: Called to establish a function that is called whenever the object goes
823: through a state transition. This is used by The client to manage the
824: work flow for the object.
825:
826: =item SetTimeoutCallback:
827:
828: Set a function to be called when a transaction times out. The
829: function will be called with the object as its sole parameter.
830:
831: =item Encrypt:
832:
833: Encrypts a block of text according to the cipher negotiated with the
834: peer (assumes the text is a command).
835:
836: =item Decrypt:
837:
838: Decrypts a block of text according to the cipher negotiated with the
839: peer (assumes the block was a reply.
840:
841: =head2 The following are selector member functions:
842:
843: =item GetState:
844:
845: Returns the current state
846:
847: =item GetSocket:
848:
849: Gets the socekt open on the connection to lond.
850:
851: =item WantReadable:
852:
853: true if the current state requires a readable event.
854:
855: =item WantWritable:
856:
857: true if the current state requires a writable event.
858:
859: =item WantTimeout:
860:
861: true if the current state requires timeout support.
862:
863: =item GetHostIterator:
864:
865: Returns an iterator into the host file hash.
866:
867: =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