Annotation of loncom/LondConnection.pm, revision 1.1
1.1 ! foxr 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