--- loncom/publisher/lonupload.pm 2004/03/31 05:24:00 1.26
+++ loncom/publisher/lonupload.pm 2008/11/20 16:32:34 1.41
@@ -2,7 +2,7 @@
# The LearningOnline Network with CAPA
# Handler to upload files into construction space
#
-# $Id: lonupload.pm,v 1.26 2004/03/31 05:24:00 albertel Exp $
+# $Id: lonupload.pm,v 1.41 2008/11/20 16:32:34 bisitz Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -28,6 +28,92 @@
#
###
+=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 or phasethree)
+
+=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 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;
@@ -37,47 +123,40 @@ use File::Basename;
use Apache::Constants qw(:common :http :methods);
use Apache::loncacc;
use Apache::loncommon();
-use Apache::Log();
use Apache::lonnet;
use HTML::Entities();
use Apache::lonlocal;
+use Apache::lonnet;
+use LONCAPA();
my $DEBUG=0;
sub Debug {
-
- # Marshall the parameters.
-
- my $r = shift;
- my $log = $r->log;
- my $message = shift;
-
- # Put out the indicated message butonly if DEBUG is false.
-
+ # Put out the indicated message but only if DEBUG is true.
if ($DEBUG) {
- $log->debug($message);
+ my ($r,$message) = @_;
+ $r->log_reason($message);
}
}
sub upfile_store {
my $r=shift;
- my $fname=$ENV{'form.upfile.filename'};
+ my $fname=$env{'form.upfile.filename'};
$fname=~s/\W//g;
- chomp($ENV{'form.upfile'});
+ chomp($env{'form.upfile'});
- my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.
+ my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
'_upload_'.$fname.'_'.time.'_'.$$;
{
my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons').
'/tmp/'.$datatoken.'.tmp');
- print $fh $ENV{'form.upfile'};
+ print $fh $env{'form.upfile'};
}
return $datatoken;
}
-
sub phaseone {
my ($r,$fn,$uname,$udom,$mode)=@_;
my $action = '/adm/upload';
@@ -86,12 +165,12 @@ sub phaseone {
} elsif ($mode eq 'imsimport') {
$action = '/adm/imsimport';
}
- $ENV{'form.upfile.filename'}=~s/\\/\//g;
- $ENV{'form.upfile.filename'}=~s/^.*\/([^\/]+)$/$1/;
- if ($ENV{'form.upfile.filename'}) {
+ $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.=$env{'form.upfile.filename'};
$fn=~s/^\///;
$fn=~s/(\/)+/\//g;
@@ -100,54 +179,51 @@ sub phaseone {
&Debug($r, "Filename for upload: $fn");
if (($fn) && ($fn!~/\/$/)) {
- $r->print('');
+ $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.').'');
+ $r->print('
'
+ .&mt('The extension on this file, [_1], is reserved internally by LON-CAPA.','"'.$1.'"')
+ .' '.&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.').
- '');
+ $r->print('
'
+ .&mt('The extension on this file, [_1], is not recognized by LON-CAPA.','"'.$1.'"')
+ .' '.&mt('Please change the extension.')
+ .'
');
}
} else {
- $r->print(''.&mt('Illegal filename.').'');
+ $r->print(''.&mt('Illegal filename.').'');
}
} else {
- $r->print(''.&mt('No upload file specified.').'');
+ $r->print(''.&mt('No upload file specified.').'');
}
}
sub phasetwo {
my ($r,$tfn,$uname,$udom,$mode)=@_;
+ my $output;
my $action = '/adm/upload';
my $returnflag = '';
if ($mode eq 'testbank') {
@@ -168,73 +244,133 @@ sub phasetwo {
$base = &HTML::Entities::encode($base,'<>&"');
my $url = $path."/".$base;
&Debug($r, "URL is now ".$url);
- my $datatoken=$ENV{'form.datatoken'};
+ my $datatoken=$env{'form.datatoken'};
if (($fn) && ($datatoken)) {
- if ((-e $target) && ($ENV{'form.override'} ne 'Yes')) {
- $r->print('');
- } else {
+ ''.
+ ''.
+ '';
+ } else {
my $source=$r->dir_config('lonDaemons').'/tmp/'.$datatoken.'.tmp';
+ my $dirpath=$path.'/';
+ $dirpath=~s/\/+/\//g;
# Check for bad extension and disallow upload
- if ($fn=~/\.(\w+)$/ &&
- (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
- $r->print(&mt('File').' '.$fn.' '.
- &mt('could not be copied.').' '.
- ''.
- &mt('The extension on this file is reserved internally by LON-CAPA.').
- '');
- $r->print(' '.
- &mt('Back to Directory').'');
- } elsif ($fn=~/\.(\w+)$/ &&
- !defined(&Apache::loncommon::fileembstyle($1))) {
- $r->print(&mt('File').' '.$fn.' '.
- &mt('could not be copied.').' '.
- ''.
- &mt('The extension on this file is not recognized by LON-CAPA.').
- '');
- $r->print(' '.
- &mt('Back to Directory').'');
- } elsif (-d $target) {
- $r->print('File '.$fn.' could not be copied. '.
- ''.
- &mt('The target is an existing directory.').
- ' ');
- $r->print(''.
- &mt('Back to Directory').'');
- } elsif (copy($source,$target)) {
- chmod(0660, $target); # Set permissions to rw-rw---.
- if ($mode eq 'testbank' || $mode eq 'imsimport') {
- $r->print(&mt("Your file - $fn - was uploaded successfully")."
");
- $returnflag = 'ok';
- } else {
- $r->print(&mt('File copied.'));
- $r->print(' '.
- &mt('View file').'');
- $r->print(' '.
- &mt('Back to Directory').' ');
- }
- } else {
- $r->print('Failed to copy: '.$!);
- $r->print(' '.
- &mt('Back to Directory').'');
- }
+ my $result;
+ ($result,$returnflag) = &check_extension($fn,$mode,$source,$target,$action,$dirpath,$url);
+ $output .= $result;
}
} else {
- $r->print(''.
+ $output .= ''.
&mt('Please use browser "Back" button and pick a filename').
- ' ');
+ ' ';
}
} else {
- $r->print(''.
- &mt('Please use browser "Back" button and pick a filename').
- ' >');
+ $output .= ''.
+ &mt('Please use browser "Back" button and pick a filename').
+ ' ';
}
- return $returnflag;
+ return ($output,$returnflag);
+}
+
+sub check_extension {
+ my ($fn,$mode,$source,$target,$action,$dirpath,$url) = @_;
+ my ($result,$returnflag);
+ # Check for bad extension and disallow upload
+ if ($fn=~/\.(\w+)$/ &&
+ (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
+ $result .= &mt('File [_1] could not be copied.',
+ '
'.$fn.' ').
+ ''.
+ &mt('The extension on this file is reserved internally by LON-CAPA.').
+ '
';
+ } elsif ($fn=~/\.(\w+)$/ &&
+ !defined(&Apache::loncommon::fileembstyle($1))) {
+ $result .= &mt('File [_1] could not be copied.',
+ ''.$fn.' ').
+ '
'.
+ &mt('The extension on this file is not recognized by LON-CAPA.').
+ '
';
+ } elsif (-d $target) {
+ $result .= &mt('File [_1] could not be copied.',
+ ''.$fn.'').
+ '
'.
+ &mt('The target is an existing directory.').
+ '
';
+ } elsif (copy($source,$target)) {
+ chmod(0660, $target); # Set permissions to rw-rw---.
+ if ($mode eq 'testbank' || $mode eq 'imsimport') {
+ $returnflag = 'ok';
+ $result .= &mt('Your file - [_1] - was uploaded successfully',$fn).'
';
+ } else {
+ $result .= &mt('File copied.').' ';
+ }
+ # Check for embedded objects.
+ my (%allfiles,%codebase);
+ my ($text,$header,$css,$js);
+ if (($mode ne 'imsimport') && ($target =~ /\.(htm|html|shtml)$/i)) {
+ my (%allfiles,%codebase);
+ &Apache::lonnet::extract_embedded_items($target,\%allfiles,\%codebase);
+ if (keys(%allfiles) > 0) {
+ my $state = <
+
+
+
+
+STATE
+ $result .= "
".&mt("Reference Warning")."
".
+ "
".&mt("Completed upload of the file. This file contained references to other files.")."
".
+ "
".&mt("Please select the locations from which the referenced files are to be uploaded.")."
'.&mt('Or [_1]continue[_2] the testbank import without these files','','').'
';
+ }
+ }
+ }
+ if (($mode ne 'imsimport') && ($mode ne 'testbank')) {
+ $result .= ' '.
+ &mt('View file').'';
+ }
+ } else {
+ $result .= &mt('Failed to copy: [_1].',$!);
+ }
+ if ($mode ne 'imsimport' && $mode ne 'testbank') {
+ $result .= ' '.
+ &mt('Back to Directory').' ';
+ }
+ return ($result,$returnflag);
+}
+
+sub phasethree {
+ my ($r,$fn,$uname,$udom,$mode) = @_;
+ my $result;
+ my $dir_root = '/home/'.$uname.'/public_html';
+ my $url_root = '/priv/'.$uname;
+ my $base = &File::Basename::basename($fn);
+ my $path = &File::Basename::dirname($fn);
+ $result = &Apache::loncommon::upload_embedded($mode,$path,$uname,$udom,
+ $dir_root,$url_root);
+ if ($mode ne 'imsimport' && $mode ne 'testbank') {
+ $result = ' '.
+ &mt('View main file').''.
+ ' '.
+ &mt('Back to Directory').' ';
+ }
+ return $result;
}
# ---------------------------------------------------------------- Main Handler
@@ -248,69 +384,49 @@ sub handler {
#
# phase two: re-attach user
#
- if ($ENV{'form.uploaduname'}) {
- $ENV{'form.filename'}='/priv/'.$ENV{'form.uploaduname'}.'/'.
- $ENV{'form.filename'};
+ if ($env{'form.uploaduname'}) {
+ $env{'form.filename'}='/priv/'.$env{'form.uploaduname'}.'/'.
+ $env{'form.filename'};
}
- unless ($ENV{'form.phase'} eq 'two') {
+ unless ($env{'form.phase'} eq 'two') {
$javascript = qq|
function verifyForm() {
- var mode = document.forms[0].filetype.options[document.forms[0].filetype.selectedIndex].value
+ var mode = document.fileupload.filetype.options[document.fileupload.filetype.selectedIndex].value
if (mode == "testbank") {
- document.forms[0].action = "/adm/testbank";
+ document.fileupload.action = "/adm/testbank";
}
if (mode == "imsimport") {
- document.forms[0].action = "/adm/imsimport";
+ document.fileupload.action = "/adm/imsimport";
}
if (mode == "standard") {
- document.forms[0].action = "/adm/upload";
+ document.fileupload.action = "/adm/upload";
}
- document.forms[0].submit();
-}
-
-function testbankWin() {
- newWindow = window.open("","testbankinfo","HEIGHT=400,WIDTH=750,scrollbars=yes")
- newWindow.document.open()
- newWindow.document.write("'Importing a Testbank file into LON-CAPA\\n")
- newWindow.document.write("\\n")
- newWindow.document.write("\\n")
- newWindow.document.write("
\\n")
- newWindow.document.write("
\\n")
- newWindow.document.write("
Importing Testbank questions into LON-CAPA
")
- newWindow.document.write(" Four requirements must be met to ensure that you will succeed in building LON-CAPA problem files using your plain text file containing testbank questions.")
- newWindow.document.write("
The questions and answers you upload must be in plain text format. Any header lines should occur before the text containing the questions and answers.
")
- newWindow.document.write("
All questions must occur before any of the answers. Each question should be numbered sequentially using a number followed immediately by a space, a period, or enclosed in parentheses, i.e., 1 , 1., (1), 1), or (1 .
")
- newWindow.document.write("
One or more correct answers should be provided for all questions (although blank answers may be provided for essay questions). Answers should be numbered sequentially, using the same scheme as used for the questions, and must occur after all the questions.")
- newWindow.document.write("
Multiple choice and multiple answer correct questions should consist of (i) the question number followed by (ii) a question stem beginning on the same line and (iii) two or more foils, with each foil beginning on a new line and prefixed by a unique letter, or Roman numeral, listed in alphabetic or numeric order, beginning at a (alphabetic) or i (Roman numeral), followed by a period, or enclosed in parentheses, i.e., a., (a), i., or (i) .
")
- newWindow.document.write("
If fill-in-the-blank or multiple answer questions have more than one correct answer, each answer should appear in a comma-, tab-, space-, or new line-delimited list.
")
- newWindow.document.write("
\\n")
- newWindow.document.write("
")
- newWindow.document.close()
- newWindow.focus()
+ document.fileupload.submit();
}
-|;
+ |;
}
($uname,$udom)=
- &Apache::loncacc::constructaccess($ENV{'form.filename'},
+ &Apache::loncacc::constructaccess($env{'form.filename'},
$r->dir_config('lonDefDomain'));
+
unless (($uname) && ($udom)) {
$r->log_reason($uname.' at '.$udom.
- ' trying to publish file '.$ENV{'form.filename'}.
+ ' trying to publish file '.$env{'form.filename'}.
' - not authorized',
$r->filename);
return HTTP_NOT_ACCEPTABLE;
}
my $fn;
- if ($ENV{'form.filename'}) {
- $fn=$ENV{'form.filename'};
+ if ($env{'form.filename'}) {
+ $fn=$env{'form.filename'};
$fn=~s/^http\:\/\/[^\/]+\///;
$fn=~s/^\///;
- $fn=~s/(\~|priv\/)(\w+)//;
+ $fn=~s{(~|priv/)($LONCAPA::username_re)}{};
$fn=~s/\/+/\//g;
} else {
- $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
+ $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
' unspecified filename for upload', $r->filename);
return HTTP_NOT_FOUND;
}
@@ -321,97 +437,32 @@ function testbankWin() {
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
- $r->print("LON-CAPA Construction Space\n");
+ $javascript = "\n";
- $r->print(&Apache::loncommon::bodytag('Upload file to Construction Space'));
+ $r->print(&Apache::loncommon::start_page('Upload file to Construction Space',
+ $javascript));
- if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) {
- $r->print('
'.&mt('Co-Author').': '.$uname.
- &mt(' at ').$udom.'
');
+ if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
+ $r->print('
'.&mt('Co-Author').': '.$uname.
+ &mt(' at ').$udom.'
![[Author Header]](/adm/lonInterFace/author.jpg)
\\n")
- newWindow.document.write("