--- loncom/lond	2004/02/23 10:25:52	1.178.2.2
+++ loncom/lond	2004/02/24 11:22:41	1.178.2.3
@@ -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 $DEBUG = 1;		       # Non zero to ena
 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 @@ sub GetIdHandler {
 
   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 @@ sub ProcessRequest {
       }
 
 
-
-
-
-# ---------------------------------------------------------------------- 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 {