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

Diff for /loncom/lond between versions 1.212 and 1.219

version 1.212, 2004/07/27 10:25:07 version 1.219, 2004/07/29 22:31:18
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.
   
   #++
   #
   # Handles pong requests.  Pong replies with our current host id, and
   #                         the results of a ping sent to us via our lonc.
   #
   # 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
   #                       connected to.
   #  Returns:
   #      1       - Ok to continue processing.
   #      0       - Program should exit.
   #  Side effects:
   #      Reply information is sent to the client.
   
   sub pong_handler {
       my ($cmd, $tail, $replyfd) = @_;
   
       my $reply=&reply("ping",$clientname);
       &Reply( $replyfd, "$currenthostid:$reply\n", "$cmd:$tail"); 
       return 1;
   }
   &register_handler("pong", \&pong_handler, 0, 1, 1);       # Pong unencoded, client or manager
   
   #++
   #      Called to establish an encrypted session key with the remote client.
   #      Note that with secure lond, in most cases this function is never
   #      invoked.  Instead, the secure session key is established either
   #      via a local file that's locked down tight and only lives for a short
   #      time, or via an ssl tunnel...and is generated from a bunch-o-random
   #      bits from /dev/urandom, rather than the predictable pattern used by
   #      by this sub.  This sub is only used in the old-style insecure
   #      key negotiation.
   # 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
   #                       known as.
   #      $clientname    - Global variable that carries the name of the hsot we're connected to.
   #  Returns:
   #      1       - Ok to continue processing.
   #      0       - Program should exit.
   #  Implicit Outputs:
   #      Reply information is sent to the client.
   #      $cipher is set with a reference to a new IDEA encryption object.
   #
   sub establish_key_handler {
       my ($cmd, $tail, $replyfd) = @_;
   
       my $buildkey=time.$$.int(rand 100000);
       $buildkey=~tr/1-6/A-F/;
       $buildkey=int(rand 100000).$buildkey.int(rand 100000);
       my $key=$currenthostid.$clientname;
       $key=~tr/a-z/A-Z/;
       $key=~tr/G-P/0-9/;
       $key=~tr/Q-Z/0-9/;
       $key=$key.$buildkey.$key.$buildkey.$key.$buildkey;
       $key=substr($key,0,32);
       my $cipherkey=pack("H32",$key);
       $cipher=new IDEA $cipherkey;
       &Reply($replyfd, "$buildkey\n", "$cmd:$tail"); 
      
       return 1;
   
   }
   &register_handler("ekey", \&establish_key_handler, 0, 1,1);
   
   
   #     Handler for the load command.  Returns the current system load average
   #     to the requestor.
   #
   # 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
   #                       known as.
   #      $clientname    - Global variable that carries the name of the hsot we're connected to.
   #  Returns:
   #      1       - Ok to continue processing.
   #      0       - Program should exit.
   #  Side effects:
   #      Reply information is sent to the client.
   sub load_handler {
       my ($cmd, $tail, $replyfd) = @_;
   
      # Get the load average from /proc/loadavg and calculate it as a percentage of
      # the allowed load limit as set by the perl global variable lonLoadLim
   
       my $loadavg;
       my $loadfile=IO::File->new('/proc/loadavg');
      
       $loadavg=<$loadfile>;
       $loadavg =~ s/\s.*//g;                      # Extract the first field only.
      
       my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'};
   
       &Reply( $replyfd, "$loadpercent\n", "$cmd:$tail");
      
       return 1;
   }
   register_handler("load", \&load_handler, 0, 1, 0);
   
   #
   #   Process the userload request.  This sub returns to the client the current
   #  user load average.  It can be invoked either by clients or managers.
   #
   # 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
   #                       known as.
   #      $clientname    - Global variable that carries the name of the hsot we're connected to.
   #  Returns:
   #      1       - Ok to continue processing.
   #      0       - Program should exit
   # Implicit inputs:
   #     whatever the userload() function requires.
   #  Implicit outputs:
   #     the reply is written to the client.
   #
   sub user_load_handler {
       my ($cmd, $tail, $replyfd) = @_;
   
       my $userloadpercent=&userload();
       &Reply($replyfd, "$userloadpercent\n", "$cmd:$tail");
       
       return 1;
   }
   register_handler("userload", \&user_load_handler, 0, 1, 0);
   
   #   Process a request for the authorization type of a user:
   #   (userauth).
   #
   # Parameters:
   #      $cmd    - the actual keyword that invoked us.
   #      $tail   - the tail of the request that invoked us.
   #      $replyfd- File descriptor connected to the client
   #  Returns:
   #      1       - Ok to continue processing.
   #      0       - Program should exit
   # Implicit outputs:
   #    The user authorization type is written to the client.
   #
   sub user_authorization_type {
       my ($cmd, $tail, $replyfd) = @_;
      
       my $userinput = "$cmd:$tail";
      
       #  Pull the domain and username out of the command tail.
       # and call GetAuthType to determine the authentication type.
      
       my ($udom,$uname)=split(/:/,$tail);
       my $result = &GetAuthType($udom, $uname);
       if($result eq "nouser") {
    &Failure( $replyfd, "unknown_user\n", $userinput);
       } else {
    #
    # We only want to pass the second field from GetAuthType
    # for ^krb.. otherwise we'll be handing out the encrypted
    # password for internals e.g.
    #
    my ($type,$otherinfo) = split(/:/,$result);
    if($type =~ /^krb/) {
       $type = $result;
    }
    &Reply( $replyfd, "$type\n", $userinput);
       }
     
       return 1;
   }
   &register_handler("currentauth", \&user_authorization_type, 1, 1, 0);
   
   #   Process a request by a manager to push a hosts or domain table 
   #   to us.  We pick apart the command and pass it on to the subs
   #   that already exist to do this.
   #
   # Parameters:
   #      $cmd    - the actual keyword that invoked us.
   #      $tail   - the tail of the request that invoked us.
   #      $client - File descriptor connected to the client
   #  Returns:
   #      1       - Ok to continue processing.
   #      0       - Program should exit
   # Implicit Output:
   #    a reply is written to the client.
   
   sub push_file_handler {
       my ($cmd, $tail, $client) = @_;
   
       my $userinput = "$cmd:$tail";
   
       # At this time we only know that the IP of our partner is a valid manager
       # the code below is a hook to do further authentication (e.g. to resolve
       # spoofing).
   
       my $cert = &GetCertificate($userinput);
       if(&ValidManager($cert)) { 
   
    # Now presumably we have the bona fides of both the peer host and the
    # process making the request.
         
    my $reply = &PushFile($userinput);
    &Reply($client, "$reply\n", $userinput);
   
       } else {
    &Failure( $client, "refused\n", $userinput);
       } 
       return 1;
   }
   &register_handler("pushfile", \&push_file_handler, 1, 0, 1);
   
   
   
   #   Process a reinit request.  Reinit requests that either
   #   lonc or lond be reinitialized so that an updated 
   #   host.tab or domain.tab can be processed.
   #
   # Parameters:
   #      $cmd    - the actual keyword that invoked us.
   #      $tail   - the tail of the request that invoked us.
   #      $client - File descriptor connected to the client
   #  Returns:
   #      1       - Ok to continue processing.
   #      0       - Program should exit
   #  Implicit output:
   #     a reply is sent to the client.
   #
   sub reinit_process_handler {
       my ($cmd, $tail, $client) = @_;
      
       my $userinput = "$cmd:$tail";
      
       my $cert = &GetCertificate($userinput);
       if(&ValidManager($cert)) {
    chomp($userinput);
    my $reply = &ReinitProcess($userinput);
    &Reply( $client,  "$reply\n", $userinput);
       } else {
    &Failure( $client, "refused\n", $userinput);
       }
       return 1;
   }
   
   &register_handler("reinit", \&reinit_process_handler, 1, 0, 1);
   
   #  Process the editing script for a table edit operation.
   #  the editing operation must be encrypted and requested by
   #  a manager host.
   #
   # Parameters:
   #      $cmd    - the actual keyword that invoked us.
   #      $tail   - the tail of the request that invoked us.
   #      $client - File descriptor connected to the client
   #  Returns:
   #      1       - Ok to continue processing.
   #      0       - Program should exit
   #  Implicit output:
   #     a reply is sent to the client.
   #
   sub edit_table_handler {
       my ($command, $tail, $client) = @_;
      
       my $userinput = "$command:$tail";
   
       my $cert = &GetCertificate($userinput);
       if(&ValidManager($cert)) {
    my($filetype, $script) = split(/:/, $tail);
    if (($filetype eq "hosts") || 
       ($filetype eq "domain")) {
       if($script ne "") {
    &Reply($client,              # BUGBUG - EditFile
         &EditFile($userinput), #   could fail.
         $userinput);
       } else {
    &Failure($client,"refused\n",$userinput);
       }
    } else {
       &Failure($client,"refused\n",$userinput);
    }
       } else {
    &Failure($client,"refused\n",$userinput);
       }
       return 1;
   }
   register_handler("edit", \&edit_table_handler, 1, 0, 1);
   
   
   
   
 #---------------------------------------------------------------  #---------------------------------------------------------------
 #  #
 #   Getting, decoding and dispatching requests:  #   Getting, decoding and dispatching requests:
Line 1079  sub process_request { Line 1410  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
  } else {      #   along with the examples that are building up as this code
     Reply($client, "refused\n", $userinput);      #   is getting refactored.   Until all branches of the
  }      #   if/elseif monster below have been factored out into
 # ------------------------------------------------------------------------ pong      #   separate procesor subs, if the dispatch hash is missing
     }elsif ($userinput =~ /^pong/) { # client only      #   the command keyword, we will fall through to the remainder
  if(isClient) {      #   of the if/else chain below in order to keep this thing in 
     my $reply=&reply("ping",$clientname);      #   working order throughout the transmogrification.
     print $client "$currenthostid:$reply\n";   
  } else {      my ($command, $tail) = split(/:/, $userinput, 2);
     Reply($client, "refused\n", $userinput);      chomp($command);
  }      chomp($tail);
 # ------------------------------------------------------------------------ ekey      $tail =~ s/(\r)//; # This helps people debugging with e.g. telnet.
     } elsif ($userinput =~ /^ekey/) { # ok for both clients & mgrs      $command =~ s/(\r)//; # And this too for parameterless commands.
  my $buildkey=time.$$.int(rand 100000);      if(!$tail) {
  $buildkey=~tr/1-6/A-F/;   $tail =""; # defined but blank.
  $buildkey=int(rand 100000).$buildkey.int(rand 100000);      }
  my $key=$currenthostid.$clientname;  
  $key=~tr/a-z/A-Z/;      &Debug("Command received: $command, encoded = $wasenc");
  $key=~tr/G-P/0-9/;  
  $key=~tr/Q-Z/0-9/;      if(defined $Dispatcher{$command}) {
  $key=$key.$buildkey.$key.$buildkey.$key.$buildkey;  
  $key=substr($key,0,32);   my $dispatch_info = $Dispatcher{$command};
  my $cipherkey=pack("H32",$key);   my $handler       = $$dispatch_info[0];
  $cipher=new IDEA $cipherkey;   my $need_encode   = $$dispatch_info[1];
  print $client "$buildkey\n";    my $client_types  = $$dispatch_info[2];
 # ------------------------------------------------------------------------ load   Debug("Matched dispatch hash: mustencode: $need_encode "
     } elsif ($userinput =~ /^load/) { # client only        ."ClientType $client_types");
  if (isClient) {        
     my $loadavg;   #  Validate the request:
     {        
  my $loadfile=IO::File->new('/proc/loadavg');   my $ok = 1;
  $loadavg=<$loadfile>;   my $requesterprivs = 0;
     }   if(&isClient()) {
     $loadavg =~ s/\s.*//g;      $requesterprivs |= $CLIENT_OK;
     my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'};   }
     print $client "$loadpercent\n";   if(&isManager()) {
  } else {      $requesterprivs |= $MANAGER_OK;
     Reply($client, "refused\n", $userinput);   }
        if($need_encode && (!$wasenc)) {
  }      Debug("Must encode but wasn't: $need_encode $wasenc");
 # -------------------------------------------------------------------- userload      $ok = 0;
     } elsif ($userinput =~ /^userload/) { # client only   }
  if(isClient) {   if(($client_types & $requesterprivs) == 0) {
     my $userloadpercent=&userload();      Debug("Client not privileged to do this operation");
     print $client "$userloadpercent\n";      $ok = 0;
  } else {   }
     Reply($client, "refused\n", $userinput);  
        if($ok) {
  }      Debug("Dispatching to handler $command $tail");
 #      my $keep_going = &$handler($command, $tail, $client);
 #        Transactions requiring encryption:      return $keep_going;
 #  
 # ----------------------------------------------------------------- currentauth  
     } elsif ($userinput =~ /^currentauth/) {  
  if (($wasenc==1)  && isClient) { # Encoded & client only.  
     my ($cmd,$udom,$uname)=split(/:/,$userinput);  
     my $result = GetAuthType($udom, $uname);  
     if($result eq "nouser") {  
  print $client "unknown_user\n";  
     }  
     else {  
  print $client "$result\n";  
     }  
  } else {  
     Reply($client, "refused\n", $userinput);  
       
  }  
 #--------------------------------------------------------------------- pushfile  
     } elsif($userinput =~ /^pushfile/) { # encoded & manager.  
  if(($wasenc == 1) && isManager) {  
     my $cert = GetCertificate($userinput);  
     if(ValidManager($cert)) {  
  my $reply = PushFile($userinput);  
  print $client "$reply\n";  
     } else {  
  print $client "refused\n";  
     }   
  } else {  
     Reply($client, "refused\n", $userinput);  
       
  }  
 #--------------------------------------------------------------------- reinit  
     } elsif($userinput =~ /^reinit/) { # Encoded and manager  
  if (($wasenc == 1) && isManager) {  
     my $cert = GetCertificate($userinput);  
     if(ValidManager($cert)) {  
  chomp($userinput);  
  my $reply = ReinitProcess($userinput);  
  print $client  "$reply\n";  
     } else {  
  print $client "refused\n";  
     }  
  } else {  
     Reply($client, "refused\n", $userinput);  
  }  
 #------------------------------------------------------------------------- edit  
     } elsif ($userinput =~ /^edit/) {    # encoded and manager:  
  if(($wasenc ==1) && (isManager)) {  
     my $cert = GetCertificate($userinput);  
     if(ValidManager($cert)) {  
  my($command, $filetype, $script) = split(/:/, $userinput);  
  if (($filetype eq "hosts") || ($filetype eq "domain")) {  
     if($script ne "") {  
  Reply($client, EditFile($userinput));  
     } else {  
  Reply($client,"refused\n",$userinput);  
     }  
  } else {  
     Reply($client,"refused\n",$userinput);  
  }  
             } else {  
  Reply($client,"refused\n",$userinput);  
             }  
  } else {   } else {
     Reply($client,"refused\n",$userinput);      Debug("Refusing to dispatch because client did not match requirements");
       Failure($client, "refused\n", $userinput);
       return 1;
  }   }
   
       }    
   
   #------------------- Commands not yet in spearate handlers. --------------
   
   
 # ------------------------------------------------------------------------ auth  # ------------------------------------------------------------------------ auth
     } elsif ($userinput =~ /^auth/) { # Encoded and client only.      if ($userinput =~ /^auth/) { # Encoded and client only.
  if (($wasenc==1) && isClient) {   if (($wasenc==1) && isClient) {
     my ($cmd,$udom,$uname,$upass)=split(/:/,$userinput);      my ($cmd,$udom,$uname,$upass)=split(/:/,$userinput);
     chomp($upass);      chomp($upass);
Line 3069  sub Debug { Line 3346  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.219

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