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