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