'.
'The extension on this file, "'.$1.
@@ -117,11 +128,20 @@ sub phaseone {
}
sub phasetwo {
- my ($r,$fn,$uname,$udom)=@_;
- if ($fn=~/^\/priv\/$uname\//) {
- my $tfn=$fn;
- $tfn=~s/^\/(\~|priv)\/(\w+)//;
+ my ($r,$tfn,$uname,$udom)=@_;
+ my $fn='/priv/'.$uname.'/'.$tfn;
+ $fn=~s/\/+/\//g;
+ &Debug($r, "Filename is ".$tfn);
+ if ($tfn) {
+ &Debug($r, "Filename for tfn = ".$tfn);
my $target='/home/'.$uname.'/public_html'.$tfn;
+ &Debug($r, "target -> ".$target);
+# target is the full filesystem path of the destination file.
+ my $base = &File::Basename::basename($fn);
+ my $path = &File::Basename::dirname($fn);
+ $base = &HTML::Entities::encode($base);
+ my $url = $path."/".$base;
+ &Debug($r, "URL is now ".$url);
my $datatoken=$ENV{'form.datatoken'};
if (($fn) && ($datatoken)) {
if ((-e $target) && ($ENV{'form.override'} ne 'Yes')) {
@@ -129,7 +149,7 @@ sub phasetwo {
'');
} else {
@@ -137,45 +157,69 @@ sub phasetwo {
'/tmp/'.$datatoken.'.tmp';
# Check for bad extension and disallow upload
if ($fn=~/\.(\w+)$/ &&
- (&Apache::lonnet::fileembstyle($1) eq 'hdn')) {
+ (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
$r->print(
'File '.$fn.' could not be copied.
'.
''.
'The extension on this file is reserved internally by LON-CAPA.'.
'');
+ $r->print('Back to Directory');
} elsif ($fn=~/\.(\w+)$/ &&
- !defined(&Apache::lonnet::fileembstyle($1))) {
+ !defined(&Apache::loncommon::fileembstyle($1))) {
$r->print(
'File '.$fn.' could not be copied.
'.
''.
'The extension on this file is not recognized by LON-CAPA.'.
'');
+ $r->print('
Back to Directory');
+ } elsif (-d $target) {
+ $r->print(
+ 'File '.$fn.' could not be copied.
'.
+ ''.
+ 'The target is an existing directory.'.
+ '');
+ $r->print('
Back to Directory');
} elsif (copy($source,$target)) {
+ chmod(0660, $target); # Set permissions to rw-rw---.
$r->print('File copied.');
- $r->print('
View file');
+ $r->print('
Back to Directory');
} else {
$r->print('Failed to copy: '.$!);
+ $r->print('
Back to Directory');
}
}
} else {
$r->print(
- 'Please pick a filename
');
- &phaseone($r,$fn,$uname,$udom);
+ 'Please use browser "Back" button and pick a filename
');
}
} else {
$r->print(
- 'Please pick a filename
');
- &phaseone($r,$fn,$uname,$udom);
+ 'Please use browser "Back" button and pick a filename
');
}
}
+# ---------------------------------------------------------------- Main Handler
sub handler {
my $r=shift;
my $uname;
my $udom;
+#
+# phase two: re-attach user
+#
+ if ($ENV{'form.uploaduname'}) {
+ $ENV{'form.filename'}='/priv/'.$ENV{'form.uploaduname'}.'/'.
+ $ENV{'form.filename'};
+ }
+#
($uname,$udom)=
&Apache::loncacc::constructaccess(
@@ -189,10 +233,12 @@ sub handler {
}
my $fn;
-
if ($ENV{'form.filename'}) {
$fn=$ENV{'form.filename'};
- $fn=~s/^http\:\/\/[^\/]+\/(\~|priv\/)(\w+)//;
+ $fn=~s/^http\:\/\/[^\/]+\///;
+ $fn=~s/^\///;
+ $fn=~s/(\~|priv\/)(\w+)//;
+ $fn=~s/\/+/\//g;
} else {
$r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
' unspecified filename for upload', $r->filename);
@@ -207,11 +253,7 @@ sub handler {
$r->print('
LON-CAPA Construction Space');
- $r->print(
- '
');
-
-
- $r->print('Upload file to Construction Space
');
+ $r->print(&Apache::loncommon::bodytag('Upload file to Construction Space'));
if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) {
$r->print('Co-Author: '.$uname.' at '.$udom.
@@ -231,3 +273,76 @@ sub handler {
1;
__END__
+
+=head1 NAME
+
+Apache::lonupload - upload files into construction space
+
+=head1 SYNOPSIS
+
+Invoked by /etc/httpd/conf/srm.conf:
+
+
+ PerlAccessHandler Apache::lonacc
+ SetHandler perl-script
+ PerlHandler Apache::lonupload
+ ErrorDocument 403 /adm/login
+ ErrorDocument 404 /adm/notfound.html
+ ErrorDocument 406 /adm/unauthorized.html
+ ErrorDocument 500 /adm/errorhandler
+
+
+=head1 INTRODUCTION
+
+This module uploads a file sitting on a client computer into
+library server construction space.
+
+This is part of the LearningOnline Network with CAPA project
+described at http://www.lon-capa.org.
+
+=head1 HANDLER SUBROUTINE
+
+This routine is called by Apache and mod_perl.
+
+=over 4
+
+=item *
+
+Initialize variables
+
+=item *
+
+Start page output
+
+=item *
+
+output relevant interface phase (phaseone or phasetwo)
+
+=item *
+
+(phase one is to specify upload file; phase two is to handle conditions
+subsequent to specification--like overwriting an existing file)
+
+=back
+
+=head1 OTHER SUBROUTINES
+
+=over 4
+
+=item *
+
+phaseone() : Interface for specifying file to upload.
+
+=item *
+
+phasetwo() : Interface for handling post-conditions about uploading (such
+as overwriting an existing file).
+
+=item *
+
+upfile_store() : Store contents of uploaded file into temporary space. Invoked
+by phaseone subroutine.
+
+=back
+
+=cut