[LON-CAPA-cvs] cvs: loncom / lond /interface portfolio.pm /lonnet/perl lonnet.pm
albertel
lon-capa-cvs@mail.lon-capa.org
Tue, 24 Aug 2004 07:26:04 -0000
albertel Tue Aug 24 03:26:04 2004 EDT
Modified files:
/loncom/lonnet/perl lonnet.pm
/loncom lond
/loncom/interface portfolio.pm
Log:
- rename is working
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.530 loncom/lonnet/perl/lonnet.pm:1.531
--- loncom/lonnet/perl/lonnet.pm:1.530 Tue Aug 24 02:43:21 2004
+++ loncom/lonnet/perl/lonnet.pm Tue Aug 24 03:26:04 2004
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.530 2004/08/24 06:43:21 albertel Exp $
+# $Id: lonnet.pm,v 1.531 2004/08/24 07:26:04 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1267,10 +1267,8 @@
# input: name of form element, coursedoc=1 means this is for the course
# output: url of file in userspace
-sub userfileupload {
- my ($formname,$coursedoc,$subdir)=@_;
- if (!defined($subdir)) { $subdir='unknown'; }
- my $fname=$ENV{'form.'.$formname.'.filename'};
+sub clean_filename {
+ my ($fname)=@_;
# Replace Windows backslashes by forward slashes
$fname=~s/\\/\//g;
# Get rid of everything but the actual filename
@@ -1279,6 +1277,14 @@
$fname=~s/\s+/\_/g;
# Replace all other weird characters by nothing
$fname=~s/[^\w\.\-]//g;
+ return $fname;
+}
+
+sub userfileupload {
+ my ($formname,$coursedoc,$subdir)=@_;
+ if (!defined($subdir)) { $subdir='unknown'; }
+ my $fname=$ENV{'form.'.$formname.'.filename'};
+ $fname=&clean_filename($fname);
# See if there is anything left
unless ($fname) { return 'error: no uploaded file'; }
chop($ENV{'form.'.$formname});
@@ -1378,6 +1384,13 @@
return &reply("mkdiruserfile:".&escape("$docudom/$docuname/$dir"),$home);
}
+sub renameuserfile {
+ my ($docuname,$docudom,$old,$new)=@_;
+ my $home=&homeserver($docuname,$docudom);
+ return &reply("renameuserfile:$docudom:$docuname:".&escape("$old").':'.
+ &escape("$new"),$home);
+}
+
# ------------------------------------------------------------------------- Log
sub log {
Index: loncom/lond
diff -u loncom/lond:1.236 loncom/lond:1.237
--- loncom/lond:1.236 Tue Aug 24 02:43:21 2004
+++ loncom/lond Tue Aug 24 03:26:04 2004
@@ -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.237 2004/08/24 07:26:04 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -57,7 +57,7 @@
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.236 $'; #' stupid emacs
+my $VERSION='$Revision: 1.237 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -1902,6 +1902,49 @@
}
®ister_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;
+}
+®ister_handler("renameuserfile", \&rename_user_file_handler, 0,1,0);
+
#
# Authenticate access to a user file by checking the user's
Index: loncom/interface/portfolio.pm
diff -u loncom/interface/portfolio.pm:1.26 loncom/interface/portfolio.pm:1.27
--- loncom/interface/portfolio.pm:1.26 Tue Aug 24 02:51:11 2004
+++ loncom/interface/portfolio.pm Tue Aug 24 03:26:04 2004
@@ -269,7 +269,10 @@
}
sub display_file {
- return $ENV{'form.currentpath'}.$ENV{'form.selectfile'};
+ my ($path,$filename)=@_;
+ if (!defined($path)) { $path=$ENV{'form.currentpath'}; }
+ if (!defined($filename)) { $filename=$ENV{'form.selectfile'}; }
+ return '<tt>'.$path.$filename.'</tt>';
}
sub done {
@@ -300,14 +303,32 @@
sub rename {
my ($r)=@_;
&open_form($r);
- $r->print('<p>'.&mt('Rename').' '.&display_file().'?</p>');
+ $r->print('<p>'.&mt('Rename').' '.&display_file().' to
+ <input name="filenewname" type="input" size="50" />?</p>');
&close_form($r);
}
sub rename_confirmed {
my ($r)=@_;
- &Apache::lonnet::renameuserfile($ENV{'form.currentpath'}.$ENV{'form.selectfile'}, 'rename', $ENV{'form.currentpath'}.$ENV{'form.filenewname'} );
-}
+ my $filenewname=&Apache::lonnet::clean_filename($ENV{'form.filenewname'});
+ if ($filenewname eq '') {
+ $r->print('<font color="red">'.
+ &mt("Error: no valid filename was provided to rename to.").
+ '</font><br />');
+ $r->print(&done());
+ return;
+ }
+ my $result=
+ &Apache::lonnet::renameuserfile($ENV{'user.name'},$ENV{'user.domain'},
+ 'portfolio'.$ENV{'form.currentpath'}.$ENV{'form.selectfile'},
+ 'portfolio'.$ENV{'form.currentpath'}.$ENV{'form.filenewname'});
+ if ($result ne 'ok') {
+ $r->print('<font color="red"> An errror occured ('.$result.
+ ') while trying to rename '.&display_file().' to '.
+ &display_file(undef,$filenewname).'</font><br />');
+ }
+ $r->print(&done());
+}
sub upload {
my ($r)=@_;
@@ -338,12 +359,6 @@
sub handler {
# this handles file management
my $r = shift;
- my @dir_list; # will hold directory listing as array
- my $udir; # returned from home server
- my $currentFile; # directory or file contained in $pathToRoot.$current_path
- my $action; # delete, rename, makedirectory, removedirectory,
- my $filenewname; # for rename action (guess what we do with it!)
- my $isFile;
&Apache::loncommon::no_cache($r);
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
@@ -357,20 +372,15 @@
['selectfile','currentpath',
'currentfile']);
- # if we're uploading a file, we need to do it early so it will
- # show in the directory list
-
if ($ENV{'form.uploaddoc.filename'}) {
&upload($r);
+ } elsif ($ENV{'form.action'} eq 'delete' && $ENV{'form.confirmed'}) {
+ &delete_confirmed($r);
} elsif ($ENV{'form.action'} eq 'delete') {
- if ($ENV{'form.confirmed'}) {
- &delete_confirmed($r);
- } else {
- &delete($r);
- }
+ &delete($r);
+ } elsif ($ENV{'form.action'} eq 'rename' && $ENV{'form.confirmed'}) {
+ &rename_confirmed($r);
} elsif ($ENV{'form.action'} eq 'rename') {
- # similarly, we need to delete or rename files before getting
- # directory list
&rename($r);
} elsif ($ENV{'form.createdir'}) {
&createdir($r);
@@ -383,8 +393,9 @@
my $portfolio_root = &Apache::loncommon::propath($ENV{'user.domain'},
$ENV{'user.name'}).
'/userfiles/portfolio';
- @dir_list=&Apache::lonnet::dirlist($current_path,$ENV{'user.domain'},
- $ENV{'user.name'},$portfolio_root);
+ my @dir_list=&Apache::lonnet::dirlist($current_path,
+ $ENV{'user.domain'},
+ $ENV{'user.name'},$portfolio_root);
# need to know if directory is empty so it can be removed if desired
my $is_empty=(@dir_list == 2);