[LON-CAPA-cvs] cvs: loncom(Refactoring) / lond
foxr
lon-capa-cvs@mail.lon-capa.org
Tue, 24 Feb 2004 11:22:41 -0000
This is a MIME encoded message
--foxr1077621761
Content-Type: text/plain
foxr Tue Feb 24 06:22:41 2004 EDT
Modified files: (Branch: Refactoring)
/loncom lond
Log:
Completed first level break up of lond into 1 handler per request type.
The daemon seems, on the whole to work however:
- There is a lot more testing that must be done.
- There's a lot more potential refactoring to be done.
- There's a need to explore what happens to lonc in the presence
of lond's disconnecting/exiting.
--foxr1077621761
Content-Type: text/plain
Content-Disposition: attachment; filename="foxr-20040224062241.txt"
Index: loncom/lond
diff -u loncom/lond:1.178.2.2 loncom/lond:1.178.2.3
--- loncom/lond:1.178.2.2 Mon Feb 23 05:25:52 2004
+++ loncom/lond Tue Feb 24 06:22:41 2004
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.178.2.2 2004/02/23 10:25:52 foxr Exp $
+# $Id: lond,v 1.178.2.3 2004/02/24 11:22:41 foxr Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -53,7 +53,7 @@
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.178.2.2 $'; #' stupid emacs
+my $VERSION='$Revision: 1.178.2.3 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid;
my $currentdomainid;
@@ -2423,7 +2423,302 @@
return 1;
}
+
RegisterHandler("idget", \&GetIdHandler, 0, 1, 0);
+#
+# Process the tmpput command I'm not sure what this does.. Seems to
+# create a file in the lonDaemons/tmp directory of the form $id.tmp
+# where Id is the client's ip concatenated with a sequence number.
+# The file will contain some value that is passed in. Is this e.g.
+# a login token?
+#
+# Parameters:
+# $cmd - The command that got us dispatched.
+# $tail - The remainder of the request following $cmd:
+# In this case this will be the contents of the file.
+# $client - Socket connected to the client.
+# Returns:
+# 1 indicating processing can continue.
+# Side effects:
+# A file is created in the local filesystem.
+# A reply is sent to the client.
+sub TmpPutHandler {
+ my $cmd = shift;
+ my $what = shift;
+ my $client = shift;
+
+ my $userinput = "$cmd:$what"; # Reconstruct for logging.
+
+
+ my $store;
+ $tmpsnum++;
+ my $id=$$.'_'.$clientip.'_'.$tmpsnum;
+ $id=~s/\W/\_/g;
+ $what=~s/\n//g;
+ my $execdir=$perlvar{'lonDaemons'};
+ if ($store=IO::File->new(">$execdir/tmp/$id.tmp")) {
+ print $store $what;
+ close $store;
+ Reply($client, "$id\n", $userinput);
+ }
+ else {
+ Failure( $client, "error: ".($!+0)."IO::File->new Failed ".
+ "while attempting tmpput\n", $userinput);
+ }
+ return 1;
+
+}
+RegisterHandler("tmpput", \&TmpPutHandler, 0, 1, 0);
+
+# Processes the tmpget command. This command returns the contents
+# of a temporary resource file(?) created via tmpput.
+#
+# Paramters:
+# $cmd - Command that got us dispatched.
+# $id - Tail of the command, contain the id of the resource
+# we want to fetch.
+# $client - socket open on the client.
+# Return:
+# 1 - Inidcating processing can continue.
+# Side effects:
+# A reply is sent to the client.
+
+#
+sub TmpGetHandler {
+ my $cmd = shift;
+ my $id = shift;
+ my $client = shift;
+ my $userinput = "$cmd:$id";
+
+ chomp($id);
+ $id=~s/\W/\_/g;
+ my $store;
+ my $execdir=$perlvar{'lonDaemons'};
+ if ($store=IO::File->new("$execdir/tmp/$id.tmp")) {
+ my $reply=<$store>;
+ Reply( $client, "$reply\n", $userinput);
+ close $store;
+ }
+ else {
+ Failure( $client, "error: ".($!+0)."IO::File->new Failed ".
+ "while attempting tmpget\n", $userinput);
+ }
+
+ return 1;
+}
+RegisterHandler("tmpget", \&TmpGetHandler, 0, 1, 0);
+#
+# Process the tmpdel command. This command deletes a temp resource
+# created by the tmpput command.
+#
+# Parameters:
+# $cmd - Command that got us here.
+# $id - Id of the temporary resource created.
+# $client - socket open on the client process.
+#
+# Returns:
+# 1 - Indicating processing should continue.
+# Side Effects:
+# A file is deleted
+# A reply is sent to the client.
+sub TmpDelHandler {
+ my $cmd = shift;
+ my $id = shift;
+ my $client = shift;
+
+ my $userinput= "$cmd:$id";
+
+ chomp($id);
+ $id=~s/\W/\_/g;
+ my $execdir=$perlvar{'lonDaemons'};
+ if (unlink("$execdir/tmp/$id.tmp")) {
+ Reply($client, "ok\n", $userinput);
+ } else {
+ Failure( $client, "error: ".($!+0)."Unlink tmp Failed ".
+ "while attempting tmpdel\n", $userinput);
+ }
+
+ return 1;
+
+}
+RegisterHandler("tmpdel", \&TmpDelHandler, 0, 1, 0);
+#
+# ls - list the contents of a directory. For each file in the
+# selected directory the filename followed by the full output of
+# the stat function is returned. The returned info for each
+# file are separated by ':'. The stat fields are separated by &'s.
+# Parameters:
+# $cmd - The command that dispatched us (ls).
+# $ulsdir - The directory path to list... I'm not sure what this
+# is relative as things like ls:. return e.g.
+# no_such_dir.
+# $client - Socket open on the client.
+# Returns:
+# 1 - indicating that the daemon should not disconnect.
+# Side Effects:
+# The reply is written to $client.
+#
+sub LsHandler {
+ my $cmd = shift;
+ my $ulsdir = shift;
+ my $client = shift;
+
+ my $userinput = "$cmd:$ulsdir";
+
+ my $ulsout='';
+ my $ulsfn;
+ if (-e $ulsdir) {
+ if(-d $ulsdir) {
+ if (opendir(LSDIR,$ulsdir)) {
+ while ($ulsfn=readdir(LSDIR)) {
+ my @ulsstats=stat($ulsdir.'/'.$ulsfn);
+ $ulsout.=$ulsfn.'&'.
+ join('&',@ulsstats).':';
+ }
+ closedir(LSDIR);
+ }
+ } else {
+ my @ulsstats=stat($ulsdir);
+ $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';
+ }
+ } else {
+ $ulsout='no_such_dir';
+ }
+ if ($ulsout eq '') { $ulsout='empty'; }
+ Reply($client, "$ulsout\n", $userinput);
+
+
+ return 1;
+}
+RegisterHandler("ls", \&LsHandler, 0, 1, 0);
+
+
+#
+# Processes the setannounce command. This command
+# creates a file named announce.txt in the top directory of
+# the documentn root and sets its contents. The announce.txt file is
+# printed in its entirety at the LonCAPA login page. Note:
+# once the announcement.txt fileis created it cannot be deleted.
+# However, setting the contents of the file to empty removes the
+# announcement from the login page of loncapa so who cares.
+#
+# Parameters:
+# $cmd - The command that got us dispatched.
+# $announcement - The text of the announcement.
+# $client - Socket open on the client process.
+# Retunrns:
+# 1 - Indicating request processing should continue
+# Side Effects:
+# The file {DocRoot}/announcement.txt is created.
+# A reply is sent to $client.
+#
+sub SetAnnounceHandler {
+ my $cmd = shift;
+ my $announcement = shift;
+ my $client = shift;
+
+ my $userinput = "$cmd:$announcement";
+
+ chomp($announcement);
+ $announcement=&unescape($announcement);
+ if (my $store=IO::File->new('>'.$perlvar{'lonDocRoot'}.
+ '/announcement.txt')) {
+ print $store $announcement;
+ close $store;
+ Reply($client, "ok\n", $userinput);
+ } else {
+ Failure($client, "error: ".($!+0)."\n", $userinput);
+ }
+
+ return 1;
+}
+RegisterHandler("setannounce", \&SetAnnounceHandler, 0, 1, 0);
+
+#
+# Return the version of the daemon. This can be used to determine
+# the compatibility of cross version installations or, alternatively to
+# simply know who's out of date and who isn't. Note that the version
+# is returned concatenated with the tail.
+# Parameters:
+# $cmd - the request that dispatched to us.
+# $tail - Tail of the request (client's version?).
+# $client - Socket open on the client.
+#Returns:
+# 1 - continue processing requests.
+# Side Effects:
+# Replies with version to $client.
+sub GetVersionHandler {
+ my $client = shift;
+ my $tail = shift;
+ my $client = shift;
+ my $userinput = $client;
+
+ Reply($client, &version($userinput)."\n", $userinput);
+
+
+ return 1;
+}
+RegisterHandler("version", \&GetVersionHandler, 0, 1, 0);
+
+# Set the current host and domain. This is used to support
+# multihomed systems. Each IP of the system, or even separate daemons
+# on the same IP can be treated as handling a separate lonCAPA virtual
+# machine. This command selects the virtual lonCAPA. The client always
+# knows the right one since it is lonc and it is selecting the domain/system
+# from the hosts.tab file.
+# Parameters:
+# $cmd - Command that dispatched us.
+# $tail - Tail of the command (domain/host requested).
+# $socket - Socket open on the client.
+#
+# Returns:
+# 1 - Indicates the program should continue to process requests.
+# Side-effects:
+# The default domain/system context is modified for this daemon.
+# a reply is sent to the client.
+#
+sub SelectHostHandler {
+ my $cmd = shift;
+ my $tail = shift;
+ my $socket = shift;
+
+ my $userinput ="$cmd:$tail";
+
+ Reply($client, &sethost($userinput)."\n", $userinput);
+
+
+ return 1;
+}
+RegisterHandler("sethost", \&SelectHostHandler, 0, 1, 0);
+
+# Process a request to exit:
+# - "bye" is sent to the client.
+# - The client socket is shutdown and closed.
+# - We indicate to the caller that we should exit.
+# Formal Parameters:
+# $cmd - The command that got us here.
+# $tail - Tail of the command (empty).
+# $client - Socket open on the tail.
+# Returns:
+# 0 - Indicating the program should exit!!
+#
+sub ExitHandler {
+ my $cmd = shift;
+ my $tail = shift;
+ my $client = shift;
+
+ my $userinput = "$cmd:$tail";
+
+ &logthis("Client $clientip ($clientname) hanging up: $userinput");
+ Reply($client, "bye\n", $userinput);
+ $client->shutdown(2); # shutdown the socket forcibly.
+ $client->close();
+
+ return 0;
+}
+RegisterHandler("exit", \&ExitHandler, 0, 1,1);
+RegisterHandler("init", \&ExitHandler, 0, 1,1); # RE-init is like exit.
+RegisterHandler("quit", \&ExitHandler, 0, 1,1); # I like this too!
#------------------------------------------------------------------------------------
#
# Process a Request. Takes a request from the client validates
@@ -2502,140 +2797,6 @@
}
-
-
-
-# ---------------------------------------------------------------------- tmpput
- } elsif ($userinput =~ /^tmpput/) {
- if(isClient) {
- my ($cmd,$what)=split(/:/,$userinput);
- my $store;
- $tmpsnum++;
- my $id=$$.'_'.$clientip.'_'.$tmpsnum;
- $id=~s/\W/\_/g;
- $what=~s/\n//g;
- my $execdir=$perlvar{'lonDaemons'};
- if ($store=IO::File->new(">$execdir/tmp/$id.tmp")) {
- print $store $what;
- close $store;
- Reply($client, "$id\n", $userinput);
- }
- else {
- Failure( $client, "error: ".($!+0)."IO::File->new Failed ".
- "while attempting tmpput\n", $userinput);
- }
- } else {
- Failure($client, "refused\n", $userinput);
-
- }
-
-# ---------------------------------------------------------------------- tmpget
- } elsif ($userinput =~ /^tmpget/) {
- if(isClient) {
- my ($cmd,$id)=split(/:/,$userinput);
- chomp($id);
- $id=~s/\W/\_/g;
- my $store;
- my $execdir=$perlvar{'lonDaemons'};
- if ($store=IO::File->new("$execdir/tmp/$id.tmp")) {
- my $reply=<$store>;
- Reply( $client, "$reply\n", $userinput);
- close $store;
- }
- else {
- Failure( $client, "error: ".($!+0)."IO::File->new Failed ".
- "while attempting tmpget\n", $userinput);
- }
- } else {
- Failure($client, "refused\n", $userinput);
-
- }
-# ---------------------------------------------------------------------- tmpdel
- } elsif ($userinput =~ /^tmpdel/) {
- if(isClient) {
- my ($cmd,$id)=split(/:/,$userinput);
- chomp($id);
- $id=~s/\W/\_/g;
- my $execdir=$perlvar{'lonDaemons'};
- if (unlink("$execdir/tmp/$id.tmp")) {
- Reply($client, "ok\n", $userinput);
- } else {
- Failure( $client, "error: ".($!+0)."Unlink tmp Failed ".
- "while attempting tmpdel\n", $userinput);
- }
- } else {
- Failure($client, "refused\n", $userinput);
- }
-# -------------------------------------------------------------------------- ls
- } elsif ($userinput =~ /^ls/) {
- if(isClient) {
- my ($cmd,$ulsdir)=split(/:/,$userinput);
- my $ulsout='';
- my $ulsfn;
- if (-e $ulsdir) {
- if(-d $ulsdir) {
- if (opendir(LSDIR,$ulsdir)) {
- while ($ulsfn=readdir(LSDIR)) {
- my @ulsstats=stat($ulsdir.'/'.$ulsfn);
- $ulsout.=$ulsfn.'&'.
- join('&',@ulsstats).':';
- }
- closedir(LSDIR);
- }
- } else {
- my @ulsstats=stat($ulsdir);
- $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';
- }
- } else {
- $ulsout='no_such_dir';
- }
- if ($ulsout eq '') { $ulsout='empty'; }
- Reply($client, "$ulsout\n", $userinput);
- } else {
- Failure($client, "refused\n", $userinput);
-
- }
-# ----------------------------------------------------------------- setannounce
- } elsif ($userinput =~ /^setannounce/) {
- if (isClient) {
- my ($cmd,$announcement)=split(/:/,$userinput);
- chomp($announcement);
- $announcement=&unescape($announcement);
- if (my $store=IO::File->new('>'.$perlvar{'lonDocRoot'}.
- '/announcement.txt')) {
- print $store $announcement;
- close $store;
- Reply($client, "ok\n", $userinput);
- } else {
- Failure($client, "error: ".($!+0)."\n", $userinput);
- }
- } else {
- Failure($client, "refused\n", $userinput);
-
- }
-# ------------------------------------------------------------------ Hanging up
- } elsif (($userinput =~ /^exit/) ||
- ($userinput =~ /^init/)) { # no restrictions.
- &logthis("Client $clientip ($clientname) hanging up: $userinput");
- Reply($client, "bye\n", $userinput);
- $client->shutdown(2); # shutdown the socket forcibly.
- $client->close();
- $KeepGoing = 0; # Flag to exit the program.
-
-# ---------------------------------- set current host/domain
- } elsif ($userinput =~ /^sethost:/) {
- if (isClient) {
- Reply($client, &sethost($userinput)."\n", $userinput);
- } else {
- Failure($client, "refused\n", $userinput);
- }
-#---------------------------------- request file (?) version.
- } elsif ($userinput =~/^version:/) {
- if (isClient) {
- Reply($client, &version($userinput)."\n", $userinput);
- } else {
- Reply( $client, "refused\n", $userinput);
- }
# ------------------------------------------------------------- unknown command
} else {
--foxr1077621761--