[BACK]Return to lond CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.178.2.2 and 1.178.2.3

version 1.178.2.2, 2004/02/23 10:25:52 version 1.178.2.3, 2004/02/24 11:22:41
Line 2423  sub GetIdHandler { Line 2423  sub GetIdHandler {
   
   return 1;    return 1;
 }  }
   
 RegisterHandler("idget", \&GetIdHandler, 0, 1, 0);  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  #   Process a Request.  Takes a request from the client validates
Line 2502  sub ProcessRequest { Line 2797  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  # ------------------------------------------------------------- unknown command
   
    } else {     } else {
Removed from v.1.178.2.2  
changed lines
  Added in v.1.178.2.3

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>