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