--- loncom/lond	2004/08/24 06:43:21	1.236
+++ loncom/lond	2004/08/24 21:25:08	1.241
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.236 2004/08/24 06:43:21 albertel Exp $
+# $Id: lond,v 1.241 2004/08/24 21:25:08 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -57,7 +57,7 @@ my $DEBUG = 0;		       # Non zero to ena
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.236 $'; #' stupid emacs
+my $VERSION='$Revision: 1.241 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -1284,6 +1284,71 @@ sub push_file_handler {
 
 
 
+
+#
+#   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 ls_handler {
+    my ($cmd, $ulsdir, $client) = @_;
+
+    my $userinput = "$cmd:$ulsdir";
+
+    my $obs;
+    my $rights;
+    my $ulsout='';
+    my $ulsfn;
+    if (-e $ulsdir) {
+	if(-d $ulsdir) {
+	    if (opendir(LSDIR,$ulsdir)) {
+		while ($ulsfn=readdir(LSDIR)) {
+		    undef $obs, $rights; 
+		    my @ulsstats=stat($ulsdir.'/'.$ulsfn);
+		    #We do some obsolete checking here
+		    if(-e $ulsdir.'/'.$ulsfn.".meta") { 
+			open(FILE, $ulsdir.'/'.$ulsfn.".meta");
+			my @obsolete=<FILE>;
+			foreach my $obsolete (@obsolete) {
+			    if($obsolete =~ m|(<obsolete>)(on)|) { $obs = 1; } 
+			    if($obsolete =~ m|(<copyright>)(default)|) { $rights = 1; }
+			}
+		    }
+		    $ulsout.=$ulsfn.'&'.join('&',@ulsstats);
+		    if($obs eq '1') { $ulsout.="&1"; }
+		    else { $ulsout.="&0"; }
+		    if($rights eq '1') { $ulsout.="&1:"; }
+		    else { $ulsout.="&0:"; }
+		}
+		closedir(LSDIR);
+	    }
+	} else {
+	    my @ulsstats=stat($ulsdir);
+	    $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';
+	}
+    } else {
+	$ulsout='no_such_dir';
+    }
+    if ($ulsout eq '') { $ulsout='empty'; }
+    print $client "$ulsout\n";
+    
+    return 1;
+
+}
+&register_handler("ls", \&ls_handler, 0, 1, 0);
+
+
 #   Process a reinit request.  Reinit requests that either
 #   lonc or lond be reinitialized so that an updated 
 #   host.tab or domain.tab can be processed.
@@ -1843,7 +1908,11 @@ sub remove_user_file_handler {
 	if (-e $udir) {
 	    my $file=$udir.'/userfiles/'.$ufile;
 	    if (-e $file) {
-		unlink($file);
+	        if (-f $file){
+		    unlink($file);
+		} elsif(-d $file) {
+		    rmdir($file);
+		}
 		if (-e $file) {
 		    &Failure($client, "failed\n", "$cmd:$tail");
 		} else {
@@ -1902,6 +1971,49 @@ sub mkdir_user_file_handler {
 }
 &register_handler("mkdiruserfile", \&mkdir_user_file_handler, 0,1,0);
 
+#
+#   rename a file in a user's home directory userfiles subdirectory.
+# Parameters:
+#    cmd   - the Lond request keyword that got us here.
+#    tail  - the part of the command past the keyword.
+#    client- File descriptor connected with the client.
+#
+# Returns:
+#    1    - Continue processing.
+
+sub rename_user_file_handler {
+    my ($cmd, $tail, $client) = @_;
+
+    my ($udom,$uname,$old,$new) = split(/:/, $tail);
+    $old=&unescape($old);
+    $new=&unescape($new);
+    if ($new =~m|/\.\./| || $old =~m|/\.\./|) {
+	# any files paths with /../ in them refuse to deal with
+	&Failure($client, "refused\n", "$cmd:$tail");
+    } else {
+	my $udir = &propath($udom,$uname);
+	if (-e $udir) {
+	    my $oldfile=$udir.'/userfiles/'.$old;
+	    my $newfile=$udir.'/userfiles/'.$new;
+	    if (-e $newfile) {
+		&Failure($client, "exists\n", "$cmd:$tail");
+	    } elsif (! -e $oldfile) {
+		&Failure($client, "not_found\n", "$cmd:$tail");
+	    } else {
+		if (!rename($oldfile,$newfile)) {
+		    &Failure($client, "failed\n", "$cmd:$tail");
+		} else {
+		    &Reply($client, "ok\n", "$cmd:$tail");
+		}
+	    }
+	} else {
+	    &Failure($client, "not_home\n", "$cmd:$tail");
+	}
+    }
+    return 1;
+}
+&register_handler("renameuserfile", \&rename_user_file_handler, 0,1,0);
+
 
 #
 #  Authenticate access to a user file by checking the user's 
@@ -3017,6 +3129,215 @@ sub dump_course_id_handler {
     return 1;
 }
 &register_handler("courseiddump", \&dump_course_id_handler, 0, 1, 0);
+
+#
+#  Puts an id to a domains id database. 
+#
+#  Parameters:
+#   $cmd     - The command that triggered us.
+#   $tail    - Remainder of the request other than the command. This is a 
+#              colon separated list containing:
+#              $domain  - The domain for which we are writing the id.
+#              $pairs  - The id info to write... this is and & separated list
+#                        of keyword=value.
+#   $client  - Socket open on the client.
+#  Returns:
+#    1   - Continue processing.
+#  Side effects:
+#     reply is written to $client.
+#
+sub put_id_handler {
+    my ($cmd,$tail,$client) = @_;
+
+
+    my $userinput = "$cmd:$tail";
+
+    my ($udom,$what)=split(/:/,$tail);
+    chomp($what);
+    my @pairs=split(/\&/,$what);
+    my $hashref = &tie_domain_hash($udom, "ids", &GDBM_WRCREAT(),
+				   "P", $what);
+    if ($hashref) {
+	foreach my $pair (@pairs) {
+	    my ($key,$value)=split(/=/,$pair);
+	    $hashref->{$key}=$value;
+	}
+	if (untie(%$hashref)) {
+	    &Reply($client, "ok\n", $userinput);
+	} else {
+	    &Failure($client, "error: ".($!+0)." untie(GDBM) Failed ".
+		     "while attempting idput\n", $userinput);
+	}
+    } else {
+	&Failure( $client, "error: ".($!+0)." tie(GDBM) Failed ".
+		  "while attempting idput\n", $userinput);
+    }
+
+    return 1;
+}
+
+&register_handler("idput", \&put_id_handler, 0, 1, 0);
+#
+#  Retrieves a set of id values from the id database.
+#  Returns an & separated list of results, one for each requested id to the
+#  client.
+#
+# Parameters:
+#   $cmd       - Command keyword that caused us to be dispatched.
+#   $tail      - Tail of the command.  Consists of a colon separated:
+#               domain - the domain whose id table we dump
+#               ids      Consists of an & separated list of
+#                        id keywords whose values will be fetched.
+#                        nonexisting keywords will have an empty value.
+#   $client    - Socket open on the client.
+#
+# Returns:
+#    1 - indicating processing should continue.
+# Side effects:
+#   An & separated list of results is written to $client.
+#
+sub get_id_handler {
+    my ($cmd, $tail, $client) = @_;
+
+    
+    my $userinput = "$client:$tail";
+    
+    my ($udom,$what)=split(/:/,$tail);
+    chomp($what);
+    my @queries=split(/\&/,$what);
+    my $qresult='';
+    my $hashref = &tie_domain_hash($udom, "ids", &GDBM_READER());
+    if ($hashref) {
+	for (my $i=0;$i<=$#queries;$i++) {
+	    $qresult.="$hashref->{$queries[$i]}&";
+	}
+	if (untie(%$hashref)) {
+	    $qresult=~s/\&$//;
+	    &Reply($client, "$qresult\n", $userinput);
+	} else {
+	    &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
+		      "while attempting idget\n",$userinput);
+	}
+    } else {
+	&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
+		 "while attempting idget\n",$userinput);
+    }
+    
+    return 1;
+}
+
+register_handler("idget", \&get_id_handler, 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 tmp_put_handler {
+    my ($cmd, $what, $client) = @_;
+
+    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;
+  
+}
+&register_handler("tmpput", \&tmp_put_handler, 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 tmp_get_handler {
+    my ($cmd, $id, $client) = @_;
+
+    my $userinput = "$cmd:$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;
+}
+&register_handler("tmpget", \&tmp_get_handler, 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 tmp_del_handler {
+    my ($cmd, $id, $client) = @_;
+    
+    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;
+
+}
+&register_handler("tmpdel", \&tmp_del_handler, 0, 1, 0);
+#
 #
 #
 #
@@ -3134,185 +3455,9 @@ sub process_request {
 #------------------- Commands not yet in spearate handlers. --------------
 
 
-# ----------------------------------------------------------------------- idput
-    if ($userinput =~ /^idput/) {
-	if(isClient) {
-	    my ($cmd,$udom,$what)=split(/:/,$userinput);
-	    chomp($what);
-	    $udom=~s/\W//g;
-	    my $proname="$perlvar{'lonUsersDir'}/$udom/ids";
-	    my $now=time;
-	    my @pairs=split(/\&/,$what);
-	    my %hash;
-	    if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) {
-		{
-		    my $hfh;
-		    if ($hfh=IO::File->new(">>$proname.hist")) {
-			print $hfh "P:$now:$what\n";
-		    }
-		}
-		foreach my $pair (@pairs) {
-		    my ($key,$value)=split(/=/,$pair);
-		    $hash{$key}=$value;
-		}
-		if (untie(%hash)) {
-		    print $client "ok\n";
-		} else {
-		    print $client "error: ".($!+0)
-			." untie(GDBM) Failed ".
-			"while attempting idput\n";
-		}
-	    } else {
-		print $client "error: ".($!+0)
-		    ." tie(GDBM) Failed ".
-		    "while attempting idput\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# ----------------------------------------------------------------------- idget
-    } elsif ($userinput =~ /^idget/) {
-	if(isClient) {
-	    my ($cmd,$udom,$what)=split(/:/,$userinput);
-	    chomp($what);
-	    $udom=~s/\W//g;
-	    my $proname="$perlvar{'lonUsersDir'}/$udom/ids";
-	    my @queries=split(/\&/,$what);
-	    my $qresult='';
-	    my %hash;
-	    if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) {
-		for (my $i=0;$i<=$#queries;$i++) {
-		    $qresult.="$hash{$queries[$i]}&";
-		}
-		if (untie(%hash)) {
-		    $qresult=~s/\&$//;
-		    print $client "$qresult\n";
-		} else {
-		    print $client "error: ".($!+0)
-			." untie(GDBM) Failed ".
-			"while attempting idget\n";
-		}
-	    } else {
-		print $client "error: ".($!+0)
-		    ." tie(GDBM) Failed ".
-		    "while attempting idget\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $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;
-		print $client "$id\n";
-	    }
-	    else {
-		print $client "error: ".($!+0)
-		    ."IO::File->new Failed ".
-		    "while attempting tmpput\n";
-	    }
-	} else {
-	    Reply($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>;
-			    print $client "$reply\n";
-		close $store;
-	    }
-	    else {
-		print $client "error: ".($!+0)
-		    ."IO::File->new Failed ".
-		    "while attempting tmpget\n";
-	    }
-	} else {
-	    Reply($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")) {
-		print $client "ok\n";
-	    } else {
-		print $client "error: ".($!+0)
-		    ."Unlink tmp Failed ".
-		    "while attempting tmpdel\n";
-	    }
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
-# -------------------------------------------------------------------------- ls
-    } elsif ($userinput =~ /^ls/) {
-	if(isClient) {
-	    my $obs;
-	    my $rights;
-	    my ($cmd,$ulsdir)=split(/:/,$userinput);
-	    my $ulsout='';
-	    my $ulsfn;
-	    if (-e $ulsdir) {
-		if(-d $ulsdir) {
-		    if (opendir(LSDIR,$ulsdir)) {
-			while ($ulsfn=readdir(LSDIR)) {
-			    undef $obs, $rights; 
-			    my @ulsstats=stat($ulsdir.'/'.$ulsfn);
-			    #We do some obsolete checking here
-			    if(-e $ulsdir.'/'.$ulsfn.".meta") { 
-				open(FILE, $ulsdir.'/'.$ulsfn.".meta");
-				my @obsolete=<FILE>;
-				foreach my $obsolete (@obsolete) {
-				    if($obsolete =~ m|(<obsolete>)(on)|) { $obs = 1; } 
-				    if($obsolete =~ m|(<copyright>)(default)|) { $rights = 1; }
-				}
-			    }
-			    $ulsout.=$ulsfn.'&'.join('&',@ulsstats);
-			    if($obs eq '1') { $ulsout.="&1"; }
-			    else { $ulsout.="&0"; }
-			    if($rights eq '1') { $ulsout.="&1:"; }
-			    else { $ulsout.="&0:"; }
-			}
-			closedir(LSDIR);
-		    }
-		} else {
-		    my @ulsstats=stat($ulsdir);
-		    $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':';
-		}
-	    } else {
-		$ulsout='no_such_dir';
-	    }
-	    if ($ulsout eq '') { $ulsout='empty'; }
-	    print $client "$ulsout\n";
-	} else {
-	    Reply($client, "refused\n", $userinput);
-	    
-	}
+
 # ----------------------------------------------------------------- setannounce
-    } elsif ($userinput =~ /^setannounce/) {
+    if ($userinput =~ /^setannounce/) {
 	if (isClient) {
 	    my ($cmd,$announcement)=split(/:/,$userinput);
 	    chomp($announcement);