--- loncom/publisher/lonupload.pm 2007/05/02 01:34:23 1.35
+++ loncom/publisher/lonupload.pm 2011/11/14 00:20:31 1.59
@@ -1,8 +1,7 @@
-
# The LearningOnline Network with CAPA
# Handler to upload files into construction space
#
-# $Id: lonupload.pm,v 1.35 2007/05/02 01:34:23 albertel Exp $
+# $Id: lonupload.pm,v 1.59 2011/11/14 00:20:31 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -28,6 +27,97 @@
#
###
+=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, phasetwo, phasethree or phasefour)
+
+=item *
+
+(phase one is to specify upload file; phase two is to handle conditions
+subsequent to specification--like overwriting an existing file; phase three
+is to handle processing of secondary uploads - of embedded objects in an
+html file).
+
+=back
+
+=head1 OTHER SUBROUTINES
+
+=over
+
+=item phaseone()
+
+Interface for specifying file to upload.
+
+=item phasetwo()
+
+Interface for handling post-conditions about uploading (such
+as overwriting an existing file).
+
+=item phasethree()
+
+Interface for handling secondary uploads of embedded objects
+in an html file.
+
+=item phasefour()
+
+Interface for handling optional renaming of links to embedded
+objects.
+
+=item upfile_store()
+
+Store contents of uploaded file into temporary space. Invoked
+by phaseone subroutine.
+
+=item check_extension()
+
+Checks if filename extension is permitted and checks type
+ of file - if html file, calls parser to check for embedded objects.
+ Invoked by phasetwo subroutine.
+
+=back
+
+=cut
+
package Apache::lonupload;
use strict;
@@ -71,71 +161,87 @@ sub upfile_store {
return $datatoken;
}
-
sub phaseone {
- my ($r,$fn,$uname,$udom,$mode)=@_;
+ my ($r,$fn,$mode)=@_;
my $action = '/adm/upload';
if ($mode eq 'testbank') {
$action = '/adm/testbank';
} elsif ($mode eq 'imsimport') {
$action = '/adm/imsimport';
}
+
+ # Check for file to be uploaded
$env{'form.upfile.filename'}=~s/\\/\//g;
$env{'form.upfile.filename'}=~s/^.*\/([^\/]+)$/$1/;
- if ($env{'form.upfile.filename'}) {
- $fn=~s/\/[^\/]+$//;
- $fn=~s/([^\/])$/$1\//;
- $fn.=$env{'form.upfile.filename'};
- $fn=~s/^\///;
- $fn=~s/(\/)+/\//g;
-
-# Fn is the full path to the destination filename.
-#
-
- &Debug($r, "Filename for upload: $fn");
- if (($fn) && ($fn!~/\/$/)) {
- $r->print('
');
- # Check for bad extension and warn user
- if ($fn=~/\.(\w+)$/ &&
- (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
- $r->print(''.&mt('The extension on this file,').
- ' "'.$1.'"'.&mt(', is reserved internally by LON-CAPA.').
- ' '.&mt('Please change the extension.').'');
- } elsif($fn=~/\.(\w+)$/ &&
- !defined(&Apache::loncommon::fileembstyle($1))) {
- $r->print(''.&mt('The extension on this file,').
- ' "'.$1.'"'.&mt(', is not recognized by LON-CAPA.').
- ' '.&mt('Please change the extension.').
- '');
- }
- } else {
- $r->print(''.&mt('Illegal filename.').'');
- }
- } else {
- $r->print(''.&mt('No upload file specified.').'');
+ if (!$env{'form.upfile.filename'}) {
+ $r->print('
'.&mt('No upload file specified.').'
');
+ return;
+ }
+
+ # Append the name of the uploaded file
+ $fn.=$env{'form.upfile.filename'};
+ $fn=~s/(\/)+/\//g;
+
+ # Check for illegal filename
+ &Debug($r, "Filename for upload: $fn");
+ if (!(($fn) && ($fn!~/\/$/))) {
+ $r->print('
'.&mt('Illegal filename.').'
');
+ return;
+ }
+# Split part that I can change from the part that I cannot change
+ my ($fn1,$fn2)=($fn=~/^(\/priv\/[^\/]+\/[^\/]+\/)(.*)$/);
+ # Display additional options for upload
+ # and upload button
+ $r->print(
+ ''
+ );
+
+ # Check for bad extension and warn user
+ if ($fn=~/\.(\w+)$/ &&
+ (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
+ $r->print('
'
+ .&mt('The extension on this file, [_1], is reserved internally by LON-CAPA.',
+ ''.$1.'')
+ .' '.&mt('Please change the extension.')
+ .'
'
+ .&mt('The extension on this file, [_1], is not recognized by LON-CAPA.',
+ ''.$1.'')
+ .' '.&mt('Please change the extension.')
+ .'
');
}
}
sub phasetwo {
- my ($r,$tfn,$uname,$udom,$mode)=@_;
+ my ($r,$fn,$mode)=@_;
+
+ my $output;
my $action = '/adm/upload';
my $returnflag = '';
if ($mode eq 'testbank') {
@@ -143,12 +249,9 @@ sub phasetwo {
} elsif ($mode eq 'imsimport') {
$action = '/adm/imsimport';
}
- 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;
+ if ($fn) {
+ my $target= $r->dir_config('lonDocRoot').'/'.$fn;
&Debug($r, "target -> ".$target);
# target is the full filesystem path of the destination file.
my $base = &File::Basename::basename($fn);
@@ -158,107 +261,239 @@ sub phasetwo {
&Debug($r, "URL is now ".$url);
my $datatoken=$env{'form.datatoken'};
if (($fn) && ($datatoken)) {
- if ((-e $target) && ($env{'form.override'} ne 'Yes')) {
- $r->print('');
- } else {
+ if ($env{'form.cancel'}) {
+ my $source=$r->dir_config('lonDaemons').'/tmp/'.$datatoken.'.tmp';
+ my $dirpath=$path.'/';
+ $dirpath=~s/\/+/\//g;
+ $output .= '
'
+ );
+ }
+ if ($env{'form.phase'} eq 'four') {
+ my $output = &phasefour($r,$fn,$uname,$udom,'author');
+ $r->print($output);
+ } elsif ($env{'form.phase'} eq 'three') {
+ my ($output,$rtnflag) = &phasethree($r,$fn,$uname,$udom,'author');
+ $r->print($output);
+ } elsif ($env{'form.phase'} eq 'two') {
+ my ($output,$returnflag) = &phasetwo($r,$fn);
+ $r->print($output);
} else {
- &phaseone($r,$fn,$uname,$udom);
+ &phaseone($r,$fn);
}
$r->print(&Apache::loncommon::end_page());
@@ -328,75 +554,4 @@ function verifyForm() {
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
500 Internal Server Error
Internal Server Error
The server encountered an internal error or
misconfiguration and was unable to complete
your request.
Please contact the server administrator at
root@localhost to inform them of the time this error occurred,
and the actions you performed just before this error.
More information about this error may be available
in the server error log.