--- loncom/lond 2004/07/27 10:25:07 1.212 +++ loncom/lond 2004/07/27 11:10:47 1.214 @@ -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.214 2004/07/27 11:10:47 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.214 $'; #' stupid emacs my $remoteVERSION; -my $currenthostid; +my $currenthostid="default"; my $currentdomainid; my $client; @@ -1032,6 +1032,37 @@ 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; +} +®ister_handler("ping", \&ping_handler, 0, 1, 1); # Ping unencoded, client or manager. + + #--------------------------------------------------------------- # # Getting, decoding and dispatching requests: @@ -1079,16 +1110,72 @@ sub process_request { } Debug("process_request: $userinput\n"); -# ------------------------------------------------------------- Normal commands -# ------------------------------------------------------------------------ ping - if ($userinput =~ /^ping/) { # client only - if(isClient) { - print $client "$currenthostid\n"; + # + # 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; } -# ------------------------------------------------------------------------ pong - }elsif ($userinput =~ /^pong/) { # client only + + } + +# ------------------------------------------------------------- Normal commands + if ($userinput =~ /^pong/) { # client only if(isClient) { my $reply=&reply("ping",$clientname); print $client "$currenthostid:$reply\n"; @@ -3069,17 +3156,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); }