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