# The LearningOnline Network with CAPA
# Handler to upload files into construction space
#
# $Id: lonupload.pm,v 1.34 2006/12/06 22:22:39 albertel 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/
#
###
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'};
$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,$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,$tfn,$uname,$udom,$mode)=@_;
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 ((-e $target) && ($env{'form.override'} ne 'Yes')) {
$r->print('');
} 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').'');
}
}
} else {
$r->print(''.
&mt('Please use browser "Back" button and pick a filename').
'
');
}
} else {
$r->print(''.
&mt('Please use browser "Back" button and pick a filename').
'
>');
}
return $returnflag;
}
# ---------------------------------------------------------------- Main Handler
sub handler {
my $r=shift;
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'};
}
unless ($env{'form.phase'} eq 'two') {
my %body_layout = ('rightmargin' => "0",
'leftmargin' => "0",
'marginwidth' => "0",
'topmargin' => "0",
'marginheight' => "0");
my $start_page =
&Apache::loncommon::start_page('Importing a Testbank file into LON-CAPA',
undef,
{'only_body' => 1,
'add_entries' => \%body_layout,
'js_ready' => 1,});
my $end_page =
&Apache::loncommon::end_page({'js_ready' => 1,});
$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
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
$javascript = "\n";
$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 ($env{'form.phase'} eq 'two') {
&phasetwo($r,$fn,$uname,$udom);
} else {
&phaseone($r,$fn,$uname,$udom);
}
$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)
=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