[BACK]Return to lond CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.212 and 1.214

version 1.212, 2004/07/27 10:25:07 version 1.214, 2004/07/27 11:10:47
Line 58  my $lastlog=''; Line 58  my $lastlog='';
   
 my $VERSION='$Revision$'; #' stupid emacs  my $VERSION='$Revision$'; #' stupid emacs
 my $remoteVERSION;  my $remoteVERSION;
 my $currenthostid;  my $currenthostid="default";
 my $currentdomainid;  my $currentdomainid;
   
 my $client;  my $client;
Line 1032  sub tie_user_hash { Line 1032  sub tie_user_hash {
     }      }
           
 }  }
   
   #--------------------- Request Handlers --------------------------------------------
   #
   #   By convention each request handler registers itself prior to the sub declaration:
   #
   
   #  Handles ping requests.
   #  Parameters:
   #      $cmd    - the actual keyword that invoked us.
   #      $tail   - the tail of the request that invoked us.
   #      $replyfd- File descriptor connected to the client
   #  Implicit Inputs:
   #      $currenthostid - Global variable that carries the name of the host we are
   #                       known as.
   #  Returns:
   #      1       - Ok to continue processing.
   #      0       - Program should exit.
   #  Side effects:
   #      Reply information is sent to the client.
   
   sub ping_handler {
       my ($cmd, $tail, $client) = @_;
       Debug("$cmd $tail $client .. $currenthostid:");
      
       Reply( $client,"$currenthostid\n","$cmd:$tail");
      
       return 1;
   }
   &register_handler("ping", \&ping_handler, 0, 1, 1);       # Ping unencoded, client or manager.
   
   
 #---------------------------------------------------------------  #---------------------------------------------------------------
 #  #
 #   Getting, decoding and dispatching requests:  #   Getting, decoding and dispatching requests:
Line 1079  sub process_request { Line 1110  sub process_request {
     }      }
     Debug("process_request: $userinput\n");      Debug("process_request: $userinput\n");
           
 # ------------------------------------------------------------- Normal commands      #  
 # ------------------------------------------------------------------------ ping      #   The 'correct way' to add a command to lond is now to
     if ($userinput =~ /^ping/) { # client only      #   write a sub to execute it and Add it to the command dispatch
  if(isClient) {      #   hash via a call to register_handler..  The comments to that
     print $client "$currenthostid\n";      #   sub should give you enough to go on to show how to do this
       #   along with the examples that are building up as this code
       #   is getting refactored.   Until all branches of the
       #   if/elseif monster below have been factored out into
       #   separate procesor subs, if the dispatch hash is missing
       #   the command keyword, we will fall through to the remainder
       #   of the if/else chain below in order to keep this thing in 
       #   working order throughout the transmogrification.
   
       my ($command, $tail) = split(/:/, $userinput, 2);
       chomp($command);
       chomp($tail);
       $tail =~ s/(\r)//; # This helps people debugging with e.g. telnet.
       $command =~ s/(\r)//; # And this too for parameterless commands.
       if(!$tail) {
    $tail =""; # defined but blank.
       }
   
       &Debug("Command received: $command, encoded = $wasenc");
   
       if(defined $Dispatcher{$command}) {
   
    my $dispatch_info = $Dispatcher{$command};
    my $handler       = $$dispatch_info[0];
    my $need_encode   = $$dispatch_info[1];
    my $client_types  = $$dispatch_info[2];
    Debug("Matched dispatch hash: mustencode: $need_encode "
         ."ClientType $client_types");
         
    #  Validate the request:
         
    my $ok = 1;
    my $requesterprivs = 0;
    if(&isClient()) {
       $requesterprivs |= $CLIENT_OK;
    }
    if(&isManager()) {
       $requesterprivs |= $MANAGER_OK;
    }
    if($need_encode && (!$wasenc)) {
       Debug("Must encode but wasn't: $need_encode $wasenc");
       $ok = 0;
    }
    if(($client_types & $requesterprivs) == 0) {
       Debug("Client not privileged to do this operation");
       $ok = 0;
    }
   
    if($ok) {
       Debug("Dispatching to handler $command $tail");
       my $keep_going = &$handler($command, $tail, $client);
       return $keep_going;
  } else {   } else {
     Reply($client, "refused\n", $userinput);      Debug("Refusing to dispatch because client did not match requirements");
       Failure($client, "refused\n", $userinput);
       return 1;
  }   }
 # ------------------------------------------------------------------------ pong  
     }elsif ($userinput =~ /^pong/) { # client only      }    
   
   # ------------------------------------------------------------- Normal commands
       if ($userinput =~ /^pong/) { # client only
  if(isClient) {   if(isClient) {
     my $reply=&reply("ping",$clientname);      my $reply=&reply("ping",$clientname);
     print $client "$currenthostid:$reply\n";       print $client "$currenthostid:$reply\n"; 
Line 3069  sub Debug { Line 3156  sub Debug {
 #     request - Original request from client.  #     request - Original request from client.
 #  #
 sub Reply {  sub Reply {
     alarm(120);  
     my $fd      = shift;  
     my $reply   = shift;  
     my $request = shift;  
   
     my ($fd, $reply, $request) = @_;      my ($fd, $reply, $request) = @_;
     print $fd $reply;      print $fd $reply;
     Debug("Request was $request  Reply was $reply");      Debug("Request was $request  Reply was $reply");
   
     $Transactions++;      $Transactions++;
     alarm(0);  
   
   
 }  }
Removed from v.1.212  
changed lines
  Added in v.1.214

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>