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