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

Diff for /loncom/lond between versions 1.178.2.1 and 1.178.2.3

version 1.178.2.1, 2004/02/18 10:43:02 version 1.178.2.3, 2004/02/24 11:22:41
Line 48  use localauth; Line 48  use localauth;
 use File::Copy;  use File::Copy;
 use LONCAPA::ConfigFileEdit;  use LONCAPA::ConfigFileEdit;
   
 my $DEBUG = 0;       # Non zero to enable debug log entries.  my $DEBUG = 1;       # Non zero to enable debug log entries.
   
 my $status='';  my $status='';
 my $lastlog='';  my $lastlog='';
Line 626  sub AuthenticateHandler { Line 626  sub AuthenticateHandler {
    #  upass   - User's password.     #  upass   - User's password.
         
    my ($udom,$uname,$upass)=split(/:/,$tail);     my ($udom,$uname,$upass)=split(/:/,$tail);
      Debug(" Authenticate domain = $udom, user = $uname, password = $upass");
    chomp($upass);     chomp($upass);
    $upass=unescape($upass);     $upass=unescape($upass);
    my $proname=propath($udom,$uname);     my $proname=propath($udom,$uname);
Line 634  sub AuthenticateHandler { Line 635  sub AuthenticateHandler {
    #   The user's 'personal' loncapa passworrd file describes how to authenticate:     #   The user's 'personal' loncapa passworrd file describes how to authenticate:
         
    if (-e $passfilename) {     if (-e $passfilename) {
        Debug("Located password file: $passfilename");
   
       my $pf = IO::File->new($passfilename);        my $pf = IO::File->new($passfilename);
       my $realpasswd=<$pf>;        my $realpasswd=<$pf>;
       chomp($realpasswd);        chomp($realpasswd);
Line 642  sub AuthenticateHandler { Line 645  sub AuthenticateHandler {
       #        #
       #   Authenticate against password stored in the internal file.        #   Authenticate against password stored in the internal file.
       #        #
        Debug("Authenticating via $howpwd");
       if ($howpwd eq 'internal') {        if ($howpwd eq 'internal') {
          &Debug("Internal auth");           &Debug("Internal auth");
          $pwdcorrect= (crypt($upass,$contentpwd) eq $contentpwd);           $pwdcorrect= (crypt($upass,$contentpwd) eq $contentpwd);
Line 2419  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 2453  sub ProcessRequest { Line 2752  sub ProcessRequest {
    # Split off the request keyword from the rest of the stuff.     # Split off the request keyword from the rest of the stuff.
         
    my ($command, $tail) = split(/:/, $userinput, 2);     my ($command, $tail) = split(/:/, $userinput, 2);
      
      Debug("Command received: $command, encoded = $wasenc");
   
         
 # ------------------------------------------------------------- Normal commands  # ------------------------------------------------------------- Normal commands
   
Line 2466  sub ProcessRequest { Line 2767  sub ProcessRequest {
       my $Handler      = $$DispatchInfo[0];        my $Handler      = $$DispatchInfo[0];
       my $NeedEncode   = $$DispatchInfo[1];        my $NeedEncode   = $$DispatchInfo[1];
       my $ClientTypes  = $$DispatchInfo[2];        my $ClientTypes  = $$DispatchInfo[2];
         Debug("Matched dispatch hash: mustencode: $NeedEncode ClientType $ClientTypes");
               
       #  Validate the request:        #  Validate the request:
               
       my $ok = 1;        my $ok = 1;
       if($NeedEncode && (!$wasenc)) {        my $requesterprivs = 0;
          Reply($client, "refused\n", $userinput);        if(isClient()) {
          $ok = 0;   $requesterprivs |= $CLIENT_OK;
       }        }
       if(isClient && (($ClientTypes & $CLIENT_OK) == 0)) {        if(isManager()) {
          Reply($client, "refused\n", $userinput);   $requesterprivs |= $MANAGER_OK;
          $ok = 0;  
       }        }
       if(isManager && (($ClientTypes & $MANAGER_OK) == 0)) {        if($NeedEncode && (!$wasenc)) {
          Reply($client, "refused\n", $userinput);   Debug("Must encode but wasn't: $NeedEncode $wasenc");
          $ok = 0;           $ok = 0;
       }        }
         if(($ClientTypes & $requesterprivs) == 0) {
    Debug("Client not privileged to do this operation");
    $ok = 0;
         }
   
       if($ok) {        if($ok) {
    Debug("Dispatching to handler $command $tail");
          $KeepGoing = &$Handler($command, $tail, $client);           $KeepGoing = &$Handler($command, $tail, $client);
         } else {
    Debug("Refusing to dispatch because ok is false");
    Failure($client, "refused", $userinput);
       }        }
   
   
   
   
   
 # ---------------------------------------------------------------------- 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.1  
changed lines
  Added in v.1.178.2.3

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