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