# The LearningOnline Network with CAPA
# Handler to upload files into construction space
#
# $Id: lonupload.pm,v 1.66 2013/12/04 17:29:44 bisitz Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# 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.
#
# 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.
#
# 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
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
###
=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;
use Apache::File;
use File::Copy;
use File::Basename;
use Apache::Constants qw(:common :http :methods);
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'};
$fname=~s/\W//g;
chomp($env{'form.upfile'});
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'};
}
return $datatoken;
}
sub phaseone {
my ($r,$fn,$mode,$uname,$udom)=@_;
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'}) {
$r->print('
'.&mt('No upload file specified.').'
'.
&earlyout($fn,$uname,$udom));
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;
}
# Check if quota exceeded
my $filesize = length($env{'form.upfile'});
if (!$filesize) {
$r->print('
'.
&mt('Unable to upload [_1]. (size = [_2] bytes)',
''.$env{'form.upfile.filename'}.'',
$filesize).' '.
&mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').' '.
'
'.
&earlyout($fn,$uname,$udom));
return;
}
$filesize = int($filesize/1000); #expressed in kb
my $output = &Apache::loncommon::excess_filesize_warning($uname,$udom,'author',
$env{'form.upfile.filename'},$filesize,'upload');
if ($output) {
$r->print($output.&earlyout($fn,$uname,$udom));
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,$fn,$mode)=@_;
my $output;
my $action = '/adm/upload';
my $returnflag = '';
if ($mode eq 'testbank') {
$action = '/adm/testbank';
} elsif ($mode eq 'imsimport') {
$action = '/adm/imsimport';
}
$fn=~s/\/+/\//g;
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);
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 .= '