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