1: # This module defines and implements a class that represents
2: # a connection to a lond daemon.
3: #
4: # $Id: LondConnection.pm,v 1.2 2003/04/18 05:52:43 albertel Exp $
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/
27: #
28: package LondConnection;
29:
30: use IO::Socket;
31: use IO::Socket::INET;
32: use IO::Handle;
33: use IO::File;
34: use Fcntl;
35: use POSIX;
36: use Crypt::IDEA;
37: use LONCAPA::Configuration;
38: use LONCAPA::HashIterator;
39:
40: my $DebugLevel=4;
41:
42: # Read the configuration file for apache to get the perl
43: # variable set.
44:
45: my $perlvarref = LONCAPA::Configuration::read_conf('loncapa.conf');
46: my %perlvar = %{$perlvarref};
47: my $hoststab =
48: LONCAPA::Configuration::read_hosts(
49: "$perlvar{'lonTabDir'}/hosts.tab") ||
50: die "Can't read host table!!";
51: my %hostshash = %{$hoststab};
52:
53: close(CONFIG);
54:
55: sub Debug {
56: my $level = shift;
57: my $message = shift;
58: if ($level < $DebugLevel) {
59: print($message."\n");
60: }
61: }
62: =pod
63: Dump the internal state of the object: For debugging purposes.
64: =cut
65:
66: sub Dump {
67: my $self = shift;
68: print "Dumping LondConnectionObject:\n";
69: while(($key, $value) = each %$self) {
70: print "$key -> $value\n";
71: }
72: print "-------------------------------\n";
73: }
74:
75: =pod
76: Local function to do a state transition. If the state transition callback
77: is defined it is called with two parameters: the self and the old state.
78: =cut
79: sub Transition {
80: my $self = shift;
81: my $newstate = shift;
82: my $oldstate = $self->{State};
83: $self->{State} = $newstate;
84: $self->{TimeoutRemaining} = $self->{TimeoutValue};
85: if($self->{TransitionCallback}) {
86: ($self->{TransitionCallback})->($self, $oldstate);
87: }
88: }
89:
90: =pod
91: Construct a new lond connection.
92: Parameters (besides the class name) include:
93: =item hostname - host the remote lond is on.
94: This host is a host in the hosts.tab file
95: =item port - port number the remote lond is listening on.
96: =cut
97: sub new {
98: my $class = shift; # class name.
99: my $Hostname = shift; # Name of host to connect to.
100: my $Port = shift; # Port to connect
101: &Debug(4,$class."::new( ".$Hostname.",".$Port.")\n");
102:
103: # The host must map to an entry in the hosts table:
104: # We connect to the dns host that corresponds to that
105: # system and use the hostname for the encryption key
106: # negotion. In the objec these become the Host and
107: # LoncapaHim fields of the object respectively.
108: #
109: if (!exists $hostshash{$Hostname}) {
110: return undef; # No such host!!!
111: }
112: my @ConfigLine = @{$hostshash{$Hostname}};
113: my $DnsName = $ConfigLine[3]; # 4'th item is dns of host.
114: Debug(5, "Connecting to ".$DnsName);
115: # Now create the object...
116: my $self = { Host => $DnsName,
117: LoncapaHim => $Hostname,
118: Port => $Port,
119: State => "Initialized",
120: TransactionRequest => "",
121: TransactionReply => "",
122: InformReadable => 0,
123: InformWritable => 0,
124: TimeoutCallback => undef,
125: TransitionCallback => undef,
126: Timeoutable => 0,
127: TimeoutValue => 60,
128: TimeoutRemaining => 0,
129: CipherKey => "",
130: Cipher => undef};
131: bless($self, $class);
132: unless ($self->{Socket} = IO::Socket::INET->new(PeerHost => $self->{Host},
133: PeerPort => $self->{Port},
134: Type => SOCK_STREAM,
135: Proto => "tcp")) {
136: return undef; # Inidicates the socket could not be made.
137: }
138: #
139: # We're connected. Set the state, and the events we'll accept:
140: #
141: $self->Transition("Connected");
142: $self->{InformWritable} = 1; # When socket is writable we send init
143: $self->{TransactionRequest} = "init\n";
144:
145: #
146: # Set socket to nonblocking I/O.
147: #
148: my $socket = $self->{Socket};
149: $flags = fcntl($socket->fileno, F_GETFL,0);
150: if($flags == -1) {
151: $socket->close;
152: return undef;
153: }
154: if(fcntl($socket, F_SETFL, $flags | O_NONBLOCK) == -1) {
155: $socket->close;
156: return undef;
157: }
158:
159: # return the object :
160:
161: return $self;
162: }
163: =pod
164: This member should be called when the Socket becomes readable.
165: Until the read completes, action is state independet. Data are accepted
166: into the TransactionReply until a newline character is received. At that
167: time actionis state dependent:
168: =item Connected: in this case we received challenge, the state changes
169: to ChallengeReceived, and we initiate a send with the challenge response.
170: =item ReceivingReply: In this case a reply has been received for a transaction,
171: the state goes to Idle and we disable write and read notification.
172: =item ChallengeReeived: we just got what should be an ok\n and the
173: connection can now handle transactions.
174:
175: =cut
176: sub Readable {
177: my $self = shift;
178: my $socket = $self->{Socket};
179: my $data = '';
180: my $rv = $socket->recv($data, POSIX::BUFSIZ, 0);
181: my $errno = $! + 0; # Force numeric context.
182:
183: unless (defined($rv) && length($data)) { # Read failed,
184: if(($errno == POSIX::EWOULDBLOCK) ||
185: ($errno == POSIX::EAGAIN) ||
186: ($errno == POSIX::EINTR) ||
187: ($errno == 0)) {
188: return 0;
189: }
190:
191: # Connection likely lost.
192: &Debug(4, "Connection lost");
193: $self->{TransactionRequest} = '';
194: $socket->close();
195: $self->Transition("Disconnected");
196: return -1;
197: }
198: # Append the data to the buffer. And figure out if the read is done:
199:
200: &Debug(9,"Received from host: ".$data);
201: $self->{TransactionReply} .= $data;
202: if($self->{TransactionReply} =~ /(.*\n)/) {
203: &Debug(8,"Readable End of line detected");
204: if ($self->{State} eq "Initialized") { # We received the challenge:
205: if($self->{TransactionReply} eq "refused") { # Remote doesn't have
206:
207: $self->Transition("Disconnected"); # in host tables.
208: $socket->close();
209: return -1;
210: }
211:
212: &Debug(8," Transition out of Initialized");
213: $self->{TransactionRequest} = $self->{TransactionReply};
214: $self->{InformWritable} = 1;
215: $self->{InformReadable} = 0;
216: $self->Transition("ChallengeReceived");
217: $self->{TimeoutRemaining} = $self->{TimeoutValue};
218: return 0;
219: } elsif ($self->{State} eq "ChallengeReplied") { # should be ok.
220: if($self->{TransactionReply} != "ok\n") {
221: $self->Transition("Disconnected");
222: $socket->close();
223: return -1;
224: }
225: $self->Transition("RequestingKey");
226: $self->{InformReadable} = 0;
227: $self->{InformWritable} = 1;
228: $self->{TransactionRequest} = "ekey\n";
229: return 0;
230: } elsif ($self->{State} eq "ReceivingKey") {
231: my $buildkey = $self->{TransactionReply};
232: my $key = $self->{LoncapaHim}.$perlvar{'lonHostID'};
233: $key=~tr/a-z/A-Z/;
234: $key=~tr/G-P/0-9/;
235: $key=~tr/Q-Z/0-9/;
236: $key=$key.$buildkey.$key.$buildkey.$key.$buildkey;
237: $key=substr($key,0,32);
238: my $cipherkey=pack("H32",$key);
239: $self->{Cipher} = new IDEA $cipherkey;
240: if($self->{Cipher} == undef) {
241: $self->Transition("Disconnected");
242: $socket->close();
243: return -1;
244: } else {
245: $self->Transition("Idle");
246: $self->{InformWritable} = 0;
247: $self->{InformReadable} = 0;
248: $self->{Timeoutable} = 0;
249: return 0;
250: }
251: } elsif ($self->{State} eq "ReceivingReply") {
252:
253: # If the data are encrypted, decrypt first.
254:
255: my $answer = $self->{TransactionReply};
256: if($answer =~ /^enc\:/) {
257: $answer = $self->Decrypt($answer);
258: $self->{TransactionReply} = $answer;
259: }
260:
261: # finish the transaction
262:
263: $self->{InformWritable} = 0;
264: $self->{InformReadable} = 0;
265: $self->{Timeoutable} = 0;
266: $self->Transition("Idle");
267: return 0;
268: } elsif ($self->{State} eq "Disconnected") { # No connection.
269: return -1;
270: } else { # Internal error: Invalid state.
271: $self->Transition("Disconnected");
272: $socket->close();
273: return -1;
274: }
275: }
276:
277: return 0;
278:
279: }
280:
281:
282: =pod
283: This member should be called when the Socket becomes writable.
284: The action is state independent. An attempt is made to drain the contents of
285: the TransactionRequest member. Once this is drained, we mark the object
286: as waiting for readability.
287:
288: Returns 0 if successful, or -1 if not.
289:
290: =cut
291: sub Writable {
292: my $self = shift; # Get reference to the object.
293: my $socket = $self->{Socket};
294: my $nwritten = $socket->send($self->{TransactionRequest}, 0);
295: my $errno = $! + 0;
296: unless (defined $nwritten) {
297: if($errno != POSIX::EINTR) {
298: $self->Transition("Disconnected");
299: return -1;
300: }
301:
302: }
303: if (($rv >= 0) ||
304: ($errno == POSIX::EWOULDBLOCK) ||
305: ($errno == POSIX::EAGAIN) ||
306: ($errno == POSIX::EINTR) ||
307: ($errno == 0)) {
308: substr($self->{TransactionRequest}, 0, $nwritten) = ""; # rmv written part
309: if(length $self->{TransactionRequest} == 0) {
310: $self->{InformWritable} = 0;
311: $self->{InformReadable} = 1;
312: $self->{TransactionReply} = '';
313: #
314: # Figure out the next state:
315: #
316: if($self->{State} eq "Connected") {
317: $self->Transition("Initialized");
318: } elsif($self->{State} eq "ChallengeReceived") {
319: $self->Transition("ChallengeReplied");
320: } elsif($self->{State} eq "RequestingKey") {
321: $self->Transition("ReceivingKey");
322: $self->{InformWritable} = 0;
323: $self->{InformReadable} = 1;
324: $self->{TransactionReply} = '';
325: } elsif ($self->{State} eq "SendingRequest") {
326: $self->Transition("ReceivingReply");
327: $self->{TimeoutRemaining} = $self->{TimeoutValue};
328: } elsif ($self->{State} eq "Disconnected") {
329: return -1;
330: }
331: return 0;
332: }
333: } else { # The write failed (e.g. partner disconnected).
334: $self->Transition("Disconnected");
335: $socket->close();
336: return -1;
337: }
338:
339: }
340: =pod
341: Tick is called every time unit by the event framework. It
342: 1. decrements the remaining timeout.
343: 2. If the timeout is zero, calls TimedOut indicating that the
344: current operation timed out.
345:
346: =cut
347:
348: sub Tick {
349: my $self = shift;
350: $self->{TimeoutRemaining}--;
351: if ($self->{TimeoutRemaining} < 0) {
352: $self->TimedOut();
353: }
354: }
355: =pod
356: TimedOut - called on a timeout. If the timeout callback is defined,
357: it is called with $self as its parameters.
358:
359: =cut
360: sub TimedOut {
361:
362: my $self = shift;
363: if($self->{TimeoutCallback}) {
364: my $callback = $self->{TimeoutCallback};
365: my @args = ( $self);
366: &$callback(@args);
367: }
368: }
369: =pod
370: Called to initiate a transaction. A transaction can only be initiated
371: when the object is idle... otherwise an error is returned.
372: A transaction consists of a request to the server that will have a reply.
373: This member sets the request data in the TransactionRequest member,
374: makes the state SendingRequest and sets the data to allow a timout,
375: and to request writability notification.
376: =cut
377: sub InitiateTransaction {
378: my $self = shift;
379: my $data = shift;
380:
381: if($self->{State} ne "Idle") {
382: return -1; # Error indicator.
383: }
384: # if the transaction is to be encrypted encrypt the data:
385:
386: if($data =~ /^encrypt\:/) {
387: $data = $self->Encrypt($data);
388: }
389:
390: # Setup the trasaction
391:
392: $self->{TransactionRequest} = $data;
393: $self->{TransactionReply} = "";
394: $self->{InformWritable} = 1;
395: $self->{InformReadable} = 0;
396: $self->{Timeoutable} = 1;
397: $self->{TimeoutRemaining} = $self->{TimeoutValue};
398: $self->Transition("SendingRequest");
399: }
400:
401:
402: =pod
403: Sets a callback for state transitions. Returns a reference to any
404: prior established callback, or undef if there was none:
405: =cut
406: sub SetStateTransitionCallback {
407: my $self = shift;
408: my $oldCallback = $self->{TransitionCallback};
409: $self->{TransitionCallback} = shift;
410: return $oldCallback;
411: }
412: =pod
413: Sets the timeout callback. Returns a reference to any prior established
414: callback or undef if there was none.
415: =cut
416: sub SetTimeoutCallback {
417: my $self = shift;
418: my $callback = shift;
419: my $oldCallback = $self->{TimeoutCallback};
420: $self->{TimeoutCallback} = $callback;
421: return $oldCallback;
422: }
423:
424: =pod
425: GetState - selector for the object state.
426: =cut
427: sub GetState {
428: my $self = shift;
429: return $self->{State};
430: }
431: =pod
432: GetSocket - selector for the object socket.
433: =cut
434: sub GetSocket {
435: my $self = shift;
436: return $self->{Socket};
437: }
438: =pod
439: Return the state of the flag that indicates the object wants to be
440: called when readable.
441: =cut
442: sub WantReadable {
443: my $self = shift;
444:
445: return $self->{InformReadable};
446: }
447: =pod
448: Return the state of the flag that indicates the object wants write
449: notification.
450: =cut
451: sub WantWritable {
452: my $self = shift;
453: return $self->{InformWritable};
454: }
455: =pod
456: return the state of the flag that indicates the object wants to be informed
457: of timeouts.
458: =cut
459: sub WantTimeout {
460: my $self = shift;
461: return $self->{Timeoutable};
462: }
463:
464: =pod
465: Returns the reply from the last transaction.
466: =cut
467: sub GetReply {
468: my $self = shift;
469: return $self->{TransactionReply};
470: }
471:
472: =pod
473: Returns the encrypted version of the command string.
474: The command input string is of the form:
475: encrypt:command
476: The output string can be directly sent to lond as it's of the form:
477: enc:length:<encodedrequest>
478: '
479: =cut
480: sub Encrypt {
481: my $self = shift; # Reference to the object.
482: my $request = shift; # Text to send.
483:
484:
485: # Split the encrypt: off the request and figure out it's length.
486: # the cipher works in blocks of 8 bytes.
487:
488: my $cmd = $request;
489: $cmd =~ s/^encrypt\://; # strip off encrypt:
490: chomp($cmd); # strip off trailing \n
491: my $length=length($cmd); # Get the string length.
492: $cmd .= " "; # Pad with blanks so we can fill out a block.
493:
494: # encrypt the request in 8 byte chunks to create the encrypted
495: # output request.
496:
497: my $Encoded = '';
498: for(my $index = 0; $index <= $length; $index += 8) {
499: $Encoded .=
500: unpack("H16",
501: $self->{Cipher}->encrypt(substr($cmd,
502: $index, 8)));
503: }
504:
505: # Build up the answer as enc:length:$encrequest.
506:
507: $request = "enc:$length:$Encoded\n";
508: return $request;
509:
510:
511: }
512: =pod
513: Decrypt
514: Decrypt a response from the server. The response is in the form:
515: enc:<length>:<encrypted data>
516: =cut
517: sub Decrypt {
518: my $self = shift; # Recover reference to object
519: my $encrypted = shift; # This is the encrypted data.
520:
521: # Bust up the response into length, and encryptedstring:
522:
523: my ($enc, $length, $EncryptedString) = split(/:/,$encrypted);
524: chomp($EncryptedString);
525:
526: # Decode the data in 8 byte blocks. The string is encoded
527: # as hex digits so there are two characters per byte:
528:
529: $decrpyted = "";
530: for(my $index = 0; $index < length($EncryptedString);
531: $index += 16) {
532: $decrypted .= $self->{Cipher}->decrypt(
533: pack("H16",
534: substr($EncryptedString,
535: $index,
536: 16)));
537: }
538: # the answer may have trailing pads to fill out a block.
539: # $length tells us the actual length of the decrypted string:
540:
541: $decrypted = substr($decrypted, 0, $length);
542:
543: return $decrypted;
544:
545: }
546:
547: =pod
548: =head GetHostIterator
549:
550: Returns a hash iterator to the host information. Each get from
551: this iterator returns a reference to an array that contains
552: information read from the hosts configuration file. Array elements
553: are used as follows:
554:
555: [0] - LonCapa host name.
556: [1] - LonCapa domain name.
557: [2] - Loncapa role (e.g. library or access).
558: [3] - DNS name server hostname.
559: [4] - IP address (result of e.g. nslooup [3]).
560: [5] - Maximum connection count.
561: [6] - Idle timeout for reducing connection count.
562: [7] - Minimum connection count.
563:
564:
565: =cut
566: sub GetHostIterator {
567:
568: return HashIterator->new(\%hostshash);
569: }
570:
571: 1;
572:
573: =pod
574: =head1 Theory
575: The lond object is a state machine. It lives through the following states:
576:
577: =item Connected: a TCP connection has been formed, but the passkey has not yet
578: been negotiated.
579: =item Initialized: "init" sent.
580: =item ChallengeReceived: lond sent its challenge to us.
581: =item ChallengeReplied: We replied to lond's challenge waiting for lond's ok.
582: =item RequestingKey: We are requesting an encryption key.
583: =item ReceivingKey: We are receiving an encryption key.
584: =item Idle: Connection was negotiated but no requests are active.
585: =item SendingRequest: A request is being sent to the peer.
586: =item ReceivingReply: Waiting for an entire reply from the peer.
587: =item Disconnected: For whatever reason, the connection was dropped.
588:
589: When we need to be writing data, we have a writable
590: event. When we need to be reading data, a readable event established.
591: Events dispatch through the class functions Readable and Writable, and the
592: watcher contains a reference to the associated object to allow object context
593: to be reached.
594:
595: =head2 Member data.
596: Host - Host socket is connected to.
597: Port - The port the remote lond is listening on.
598: Socket - Socket open on the connection.
599: State - The current state.
600: TransactionRequest - The request being transmitted.
601: TransactionReply - The reply being received from the transaction.
602: InformReadable - True if we want to be called when socket is readable.
603: InformWritable - True if we want to be informed if the socket is writable.
604: Timeoutable - True if the current operation is allowed to timeout.
605: TimeoutValue - Number of seconds in the timeout.
606: TimeoutRemaining - Number of seconds left in the timeout.
607: CipherKey - The key that was negotiated with the peer.
608: Cipher - The cipher obtained via the key.
609:
610:
611:
612: =head2 The following are callback like members:
613: =item Tick: Called in response to a timer tick. Used to managed timeouts etc.
614: =item Readable: Called when the socket becomes readable.
615: =item Writable: Called when the socket becomes writable.
616: =item TimedOut: Called when a timed operation timed out.
617:
618: =head2 The following are operational member functions.
619: =item InitiateTransaction: Called to initiate a new transaction
620: =item SetStateTransitionCallback: Called to establish a function that is called
621: whenever the object goes through a state transition. This is used by
622: The client to manage the work flow for the object.
623: =item SetTimeoutCallback -Set a function to be called when a transaction times
624: out. The function will be called with the object as its sole parameter.
625: =item Encrypt - Encrypts a block of text according to the cipher negotiated
626: with the peer (assumes the text is a command).
627: =item Decrypt - Decrypts a block of text according to the cipher negotiated
628: with the peer (assumes the block was a reply.
629:
630: =head2 The following are selector member functions:
631:
632: =item GetState: Returns the current state
633: =item GetSocket: Gets the socekt open on the connection to lond.
634: =item WantReadable: true if the current state requires a readable event.
635: =item WantWritable: true if the current state requires a writable event.
636: =item WantTimeout: true if the current state requires timeout support.
637: =item GetHostIterator: Returns an iterator into the host file hash.
638: =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