--- loncom/lond 2004/07/27 10:50:37 1.213 +++ loncom/lond 2004/07/28 21:33:22 1.217 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.213 2004/07/27 10:50:37 foxr Exp $ +# $Id: lond,v 1.217 2004/07/28 21:33:22 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.213 $'; #' stupid emacs +my $VERSION='$Revision: 1.217 $'; #' stupid emacs my $remoteVERSION; -my $currenthostid; +my $currenthostid="default"; my $currentdomainid; my $client; @@ -1032,6 +1032,179 @@ 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. + +#++ +# +# 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; +} +®ister_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; + +} +®ister_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); + + #--------------------------------------------------------------- # # Getting, decoding and dispatching requests: @@ -1096,6 +1269,10 @@ sub process_request { 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"); @@ -1139,65 +1316,10 @@ sub process_request { } -# ------------------------------------------------------------- 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: -# +#------------------- Commands not yet in spearate handlers. -------------- + # ----------------------------------------------------------------- currentauth - } elsif ($userinput =~ /^currentauth/) { + if ($userinput =~ /^currentauth/) { if (($wasenc==1) && isClient) { # Encoded & client only. my ($cmd,$udom,$uname)=split(/:/,$userinput); my $result = GetAuthType($udom, $uname); @@ -3129,17 +3251,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); }