--- loncom/lond	2004/07/27 10:25:07	1.212
+++ loncom/lond	2004/07/29 10:50:54	1.218
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.212 2004/07/27 10:25:07 foxr Exp $
+# $Id: lond,v 1.218 2004/07/29 10:50:54 foxr Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -56,9 +56,9 @@ my $DEBUG = 0;		       # Non zero to ena
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.212 $'; #' stupid emacs
+my $VERSION='$Revision: 1.218 $'; #' stupid emacs
 my $remoteVERSION;
-my $currenthostid;
+my $currenthostid="default";
 my $currentdomainid;
 
 my $client;
@@ -1032,6 +1032,336 @@ 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);
+    } 
+}
+&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:
@@ -1079,129 +1409,75 @@ sub process_request {
     }
     Debug("process_request: $userinput\n");
     
-# ------------------------------------------------------------- Normal commands
-# ------------------------------------------------------------------------ ping
-    if ($userinput =~ /^ping/) {	# client only
-	if(isClient) {
-	    print $client "$currenthostid\n";
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	}
-# ------------------------------------------------------------------------ pong
-    }elsif ($userinput =~ /^pong/) { # client only
-	if(isClient) {
-	    my $reply=&reply("ping",$clientname);
-	    print $client "$currenthostid:$reply\n"; 
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	}
-# ------------------------------------------------------------------------ ekey
-    } elsif ($userinput =~ /^ekey/) { # ok for both clients & mgrs
-	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;
-	print $client "$buildkey\n"; 
-# ------------------------------------------------------------------------ load
-    } elsif ($userinput =~ /^load/) { # client only
-	if (isClient) {
-	    my $loadavg;
-	    {
-		my $loadfile=IO::File->new('/proc/loadavg');
-		$loadavg=<$loadfile>;
-	    }
-	    $loadavg =~ s/\s.*//g;
-	    my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'};
-	    print $client "$loadpercent\n";
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# -------------------------------------------------------------------- userload
-    } elsif ($userinput =~ /^userload/) { # client only
-	if(isClient) {
-	    my $userloadpercent=&userload();
-	    print $client "$userloadpercent\n";
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-#
-#        Transactions requiring encryption:
-#
-# ----------------------------------------------------------------- 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);
-            }
+    #  
+    #   The 'correct way' to add a command to lond is now to
+    #   write a sub to execute it and Add it to the command dispatch
+    #   hash via a call to register_handler..  The comments to that
+    #   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 {
-	    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
-    } elsif ($userinput =~ /^auth/) { # Encoded and client only.
+    if ($userinput =~ /^auth/) { # Encoded and client only.
 	if (($wasenc==1) && isClient) {
 	    my ($cmd,$udom,$uname,$upass)=split(/:/,$userinput);
 	    chomp($upass);
@@ -3069,17 +3345,11 @@ sub Debug {
 #     request - Original request from client.
 #
 sub Reply {
-    alarm(120);
-    my $fd      = shift;
-    my $reply   = shift;
-    my $request = shift;
-
     my ($fd, $reply, $request) = @_;
     print $fd $reply;
     Debug("Request was $request  Reply was $reply");
 
     $Transactions++;
-    alarm(0);
 
 
 }