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