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