[LON-CAPA-cvs] cvs: loncom / lond /interface portfolio.pm /lonnet/perl lonnet.pm

[albertel]

albertel		Tue Aug 24 02:43:21 2004 EDT

  Modified files:              
    /loncom	lond 
    /loncom/lonnet/perl	lonnet.pm 
    /loncom/interface	portfolio.pm 
  Log:
  - can create directories now
  
  
Index: loncom/lond
diff -u loncom/lond:1.235 loncom/lond:1.236
--- loncom/lond:1.235	Tue Aug 24 01:13:40 2004
+++ loncom/lond	Tue Aug 24 02:43:21 2004
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.235 2004/08/24 05:13:40 albertel Exp $
+# $Id: lond,v 1.236 2004/08/24 06:43:21 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -57,7 +57,7 @@
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.235 $'; #' stupid emacs
+my $VERSION='$Revision: 1.236 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid="default";
 my $currentdomainid;
@@ -1860,6 +1860,48 @@
 }
 &register_handler("removeuserfile", \&remove_user_file_handler, 0,1,0);
 
+#
+#   make a directory 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 mkdir_user_file_handler {
+    my ($cmd, $tail, $client) = @_;
+
+    my ($dir) = split(/:/, $tail); # Get rid of any tailing :'s lonc may have sent.
+    $dir=&unescape($dir);
+    my ($udom,$uname,$ufile) = ($dir =~ m|^([^/]+)/([^/]+)/(.+)$|);
+    if ($ufile =~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 $newdir=$udir.'/userfiles/'.$ufile;
+	    if (!-e $newdir) {
+		mkdir($newdir);
+		if (!-e $newdir) {
+		    &Failure($client, "failed\n", "$cmd:$tail");
+		} else {
+		    &Reply($client, "ok\n", "$cmd:$tail");
+		}
+	    } else {
+		&Failure($client, "not_found\n", "$cmd:$tail");
+	    }
+	} else {
+	    &Failure($client, "not_home\n", "$cmd:$tail");
+	}
+    }
+    return 1;
+}
+&register_handler("mkdiruserfile", \&mkdir_user_file_handler, 0,1,0);
+
 
 #
 #  Authenticate access to a user file by checking the user's 
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.529 loncom/lonnet/perl/lonnet.pm:1.530
--- loncom/lonnet/perl/lonnet.pm:1.529	Mon Aug 23 15:34:01 2004
+++ loncom/lonnet/perl/lonnet.pm	Tue Aug 24 02:43:21 2004
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.529 2004/08/23 19:34:01 albertel Exp $
+# $Id: lonnet.pm,v 1.530 2004/08/24 06:43:21 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1372,6 +1372,12 @@
     return &reply("removeuserfile:$docudom/$docuname/$fname",$home);
 }
 
+sub mkdiruserfile {
+    my ($docuname,$docudom,$dir)=@_;
+    my $home=&homeserver($docuname,$docudom);
+    return &reply("mkdiruserfile:".&escape("$docudom/$docuname/$dir"),$home);
+}
+
 # ------------------------------------------------------------------------- Log
 
 sub log {
Index: loncom/interface/portfolio.pm
diff -u loncom/interface/portfolio.pm:1.24 loncom/interface/portfolio.pm:1.25
--- loncom/interface/portfolio.pm:1.24	Tue Aug 24 02:16:55 2004
+++ loncom/interface/portfolio.pm	Tue Aug 24 02:43:21 2004
@@ -268,7 +268,7 @@
 }
 
 sub done {
-    return ('<h3><a href="/adm/portfolio?currentpath="'.
+    return ('<h3><a href="/adm/portfolio?currentpath='.
 	    $ENV{'form.currentpath'}.'">'.&mt('Done').'</a></h3>');
 }
 
@@ -287,7 +287,7 @@
 					       $ENV{'form.selectfile'});
     if ($result ne 'ok') {
 	$r->print('<font color="red"> An errror occured ('.$result.
-		  ')while trying to delete '.&display_file().'</font><br />');
+		  ') while trying to delete '.&display_file().'</font><br />');
     }
     $r->print(&done());
 }
@@ -306,11 +306,26 @@
 
 sub upload {
     my ($r)=@_;
+    #FIXME if the file already exists we need to do a confirmation pass 
+    #before overwriting
     my $result=&Apache::lonnet::userfileupload('uploaddoc','',
 					 'portfolio'.$ENV{'form.currentpath'});
     if ($result !~ m|^/uploaded/|) {
 	$r->print('<font color="red"> An errror occured ('.$result.
-		  ')while trying to upload '.&display_file().'</font><br />');
+		  ') while trying to upload '.&display_file().'</font><br />');
+    }
+    $r->print(&done());
+}
+
+sub createdir {
+    my ($r)=@_;
+    #FIXME 1) bad dirnames
+    #      2) file exists in place of dir
+    my $result=&Apache::lonnet::mkdiruserfile($ENV{'user.name'},
+	     $ENV{'user.domain'},'portfolio'.$ENV{'form.currentpath'}.$ENV{'form.newdir'});
+    if ($result ne 'ok') {
+	$r->print('<font color="red"> An errror occured ('.$result.
+		  ') while trying to create a new directory '.&display_file().'</font><br />');
     }
     $r->print(&done());
 }
@@ -352,6 +367,8 @@
 	# similarly, we need to delete or rename files before getting
 	# directory list
 	&rename($r);
+    } elsif ($ENV{'form.createdir'}) {
+	&createdir($r);
     } else {
 	my $current_path='/';
 	if ($ENV{'form.currentpath'}) {