--- loncom/publisher/lonupload.pm 2001/06/23 18:26:40 1.5
+++ loncom/publisher/lonupload.pm 2008/07/18 03:27:48 1.38
@@ -1,168 +1,464 @@
+
# The LearningOnline Network with CAPA
# Handler to upload files into construction space
#
-# (Handler to retrieve an old version of a file
+# $Id: lonupload.pm,v 1.38 2008/07/18 03:27:48 raeburn Exp $
+#
+# Copyright Michigan State University Board of Trustees
+#
+# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
-# (Publication Handler
-#
-# (TeX Content Handler
+# LON-CAPA is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
#
-# 05/29/00,05/30,10/11 Gerd Kortemeyer)
+# LON-CAPA is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
#
-# 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer
-# 03/23 Guy Albertelli
-# 03/24,03/29 Gerd Kortemeyer)
+# You should have received a copy of the GNU General Public License
+# along with LON-CAPA; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
-# 03/31,04/03 Gerd Kortemeyer)
+# /home/httpd/html/adm/gpl.txt
#
-# 04/05,04/09,05/25,06/23 Gerd Kortemeyer
+# http://www.lon-capa.org/
+#
+###
package Apache::lonupload;
use strict;
use Apache::File;
use File::Copy;
+use File::Basename;
use Apache::Constants qw(:common :http :methods);
use Apache::loncacc;
+use Apache::loncommon();
+use Apache::lonnet;
+use HTML::Entities();
+use Apache::lonlocal;
+use Apache::lonnet;
+use LONCAPA();
+
+my $DEBUG=0;
+
+sub Debug {
+ # Put out the indicated message but only if DEBUG is true.
+ if ($DEBUG) {
+ 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;
- chop($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)=@_;
- if ($ENV{'form.upfile.filename'}) {
- $fn=~s/\/[^\/]+$//;
- $fn=~s/([^\/])$/$1\//;
- $fn.=$ENV{'form.upfile.filename'};
- $fn=~s/^\///;
- $fn=~s/(\/)+/\//g;
- if (($fn) && ($fn!~/\/$/)) {
- $r->print(
- '');
- } else {
- $r->print('Illegal filename.');
- }
- } else {
- $r->print('No upload file specified.');
- }
+ my ($r,$fn,$uname,$udom,$mode)=@_;
+ my $action = '/adm/upload';
+ if ($mode eq 'testbank') {
+ $action = '/adm/testbank';
+ } elsif ($mode eq 'imsimport') {
+ $action = '/adm/imsimport';
+ }
+ $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.').'');
+ }
}
sub phasetwo {
- my ($r,$fn,$uname,$udom)=@_;
- if ($fn=~/^\/priv\/$uname\//) {
- my $tfn=$fn;
- $tfn=~s/^\/(\~|priv)\/(\w+)//;
- my $target='/home/'.$uname.'/public_html'.$tfn;
- my $datatoken=$ENV{'form.datatoken'};
- if (($fn) && ($datatoken)) {
- if ((-e $target) && ($ENV{'form.override'} ne 'Yes')) {
- $r->print(
- '');
- } else {
- my $source=$r->dir_config('lonDaemons').
- '/tmp/'.$datatoken.'.tmp';
- if (copy($source,$target)) {
- $r->print('File copied.');
- $r->print('
View file');
- } else {
- $r->print('Failed to copy: '.$!);
- }
- }
+ my ($r,$tfn,$uname,$udom,$mode)=@_;
+ my $output;
+ my $action = '/adm/upload';
+ my $returnflag = '';
+ if ($mode eq 'testbank') {
+ $action = '/adm/testbank';
+ } 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;
+ &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 ($env{'form.cancel'}) {
+ my $source=$r->dir_config('lonDaemons').'/tmp/'.$datatoken.'.tmp';
+ my $dirpath=$path.'/';
+ $dirpath=~s/\/+/\//g;
+ $output .= &mt('Upload cancelled.').' '.
+ &mt('Back to Directory').'';
+ } elsif ((-e $target) && (!$env{'form.override'})) {
+ $output .= '
';
+ } else {
+ my $source=$r->dir_config('lonDaemons').'/tmp/'.$datatoken.'.tmp';
+ my $dirpath=$path.'/';
+ $dirpath=~s/\/+/\//g;
+ # Check for bad extension and disallow upload
+ my $result;
+ ($result,$returnflag) = &check_extension($fn,$mode,$source,$target,$action,$dirpath,$url);
+ $output .= $result;
+ }
+ } else {
+ $output .= ''.
+ &mt('Please use browser "Back" button and pick a filename').
+ ' ';
+ }
} else {
- $r->print(
- 'Please pick a filename
'.&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
sub handler {
- my $r=shift;
+ my $r=shift;
- my $uname;
- my $udom;
+ my $uname;
+ my $udom;
+ my $javascript = '';
+#
+# phase two: re-attach user
+#
+ if ($env{'form.uploaduname'}) {
+ $env{'form.filename'}='/priv/'.$env{'form.uploaduname'}.'/'.
+ $env{'form.filename'};
+ }
- ($uname,$udom)=
- &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'}.
- ' - not authorized',
- $r->filename);
- return HTTP_NOT_ACCEPTABLE;
- }
-
- my $fn;
-
- if ($ENV{'form.filename'}) {
- $fn=$ENV{'form.filename'};
- $fn=~s/^http\:\/\/[^\/]+\/(\~|priv\/)(\w+)//;
- } else {
- $r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
- ' unspecified filename for upload', $r->filename);
- return HTTP_NOT_FOUND;
- }
+ unless ($env{'form.phase'} eq 'two') {
+ $javascript = qq|
+function verifyForm() {
+ var mode = document.fileupload.filetype.options[document.fileupload.filetype.selectedIndex].value
+ if (mode == "testbank") {
+ document.fileupload.action = "/adm/testbank";
+ }
+ if (mode == "imsimport") {
+ document.fileupload.action = "/adm/imsimport";
+ }
+ if (mode == "standard") {
+ document.fileupload.action = "/adm/upload";
+ }
+ document.fileupload.submit();
+}
+ |;
+ }
+ ($uname,$udom)=
+ &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'}.
+ ' - not authorized',
+ $r->filename);
+ return HTTP_NOT_ACCEPTABLE;
+ }
+
+ my $fn;
+ if ($env{'form.filename'}) {
+ $fn=$env{'form.filename'};
+ $fn=~s/^http\:\/\/[^\/]+\///;
+ $fn=~s/^\///;
+ $fn=~s{(~|priv/)($LONCAPA::username_re)}{};
+ $fn=~s/\/+/\//g;
+ } else {
+ $r->log_reason($env{'user.name'}.' at '.$env{'user.domain'}.
+ ' unspecified filename for upload', $r->filename);
+ return HTTP_NOT_FOUND;
+ }
# ----------------------------------------------------------- Start page output
- $r->content_type('text/html');
- $r->send_http_header;
+ &Apache::loncommon::content_type($r,'text/html');
+ $r->send_http_header;
- $r->print('LON-CAPA Construction Space');
+ $javascript = "\n";
- $r->print(
- '');
-
-
- $r->print('
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('
Co-Author: '.$uname.' at '.$udom.
- '
');
- }
-
+ if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
+ $r->print('
'.&mt('Co-Author').': '.$uname.
+ &mt(' at ').$udom.'
');
+ }
- if ($ENV{'form.phase'} eq 'two') {
- &phasetwo($r,$fn,$uname,$udom);
- } else {
- &phaseone($r,$fn,$uname,$udom);
- }
+ if ($env{'form.phase'} eq 'three') {
+ my $output = &phasethree($r,$fn,$uname,$udom,'author');
+ $r->print($output);
+ } elsif ($env{'form.phase'} eq 'two') {
+ my ($output,$returnflag) = &phasetwo($r,$fn,$uname,$udom);
+ $r->print($output);
+ } else {
+ &phaseone($r,$fn,$uname,$udom);
+ }
- $r->print('');
- return OK;
+ $r->print(&Apache::loncommon::end_page());
+ return OK;
}
+
+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 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 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 *
+
+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
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.
');
-
-
- $r->print('