File:
[LON-CAPA] /
loncom /
publisher /
lonupload.pm
Revision
1.35:
download - view:
text,
annotated -
select for diffs
Wed May 2 01:34:23 2007 UTC (17 years ago) by
albertel
Branches:
MAIN
CVS tags:
version_2_6_0,
version_2_5_X,
version_2_5_99_1,
version_2_5_99_0,
version_2_5_2,
version_2_5_1,
version_2_5_0,
version_2_4_X,
version_2_4_99_0,
version_2_4_2,
version_2_4_1,
version_2_4_0,
version_2_3_99_0,
HEAD
- switch Store to Save
# 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 $
#
# 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('<form action="'.$action.'" method="post" name="fileupload">'.
'<input type="hidden" name="phase" value="two" />'.
'<input type="hidden" name="datatoken" value="'.
&upfile_store.'" />'.
'<input type="hidden" name="uploaduname" value="'.$uname.
'" />'.&mt('Save uploaded file as ').
"<span class='LC_filename'>/priv/$uname/</span>".
'<input type="text" size="50" name="filename" value="'.$fn.
'" /><br />'.
'<br />'.&mt('Choose file type:').'
<select name="filetype">
<option value="standard" selected>'.&mt('Regular file').'
<option value="testbank">'.&mt('Testbank file').'
<option value="imsimport">'.&mt('IMS package').'
</select>'.&Apache::loncommon::help_open_topic("Uploading_File_Options").'
<br />
<br />
');
$r->print('<input type="button" value="'.&mt('Save').'" onClick="javascript:verifyForm()"/></form>');
# Check for bad extension and warn user
if ($fn=~/\.(\w+)$/ &&
(&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
$r->print('<span class="LC_error">'.&mt('The extension on this file,').
' "'.$1.'"'.&mt(', is reserved internally by LON-CAPA.').
' <br />'.&mt('Please change the extension.').'</span>');
} elsif($fn=~/\.(\w+)$/ &&
!defined(&Apache::loncommon::fileembstyle($1))) {
$r->print('<span class="LC_error">'.&mt('The extension on this file,').
' "'.$1.'"'.&mt(', is not recognized by LON-CAPA.').
' <br />'.&mt('Please change the extension.').
'</span>');
}
} else {
$r->print('<span class="LC_error">'.&mt('Illegal filename.').'</span>');
}
} else {
$r->print('<span class="LC_error">'.&mt('No upload file specified.').'</span>');
}
}
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('<form action="'.$action.'" method="post">'.
&mt('File').' <span class="LC_filename">'.$fn.'</span> '.
&mt('exists. Overwrite?').' '.
'<input type="hidden" name="phase" value="two" />'.
'<input type="hidden" name="filename" value="'."$url".'" />'.
'<input type="hidden" name="datatoken" value="'.$datatoken.'" />'.
'<input type="submit" name="override" value="'.&mt('Yes').'" /></form>');
} 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').' <span class="LC_filename">'.$fn.'</span> '.
&mt('could not be copied.').'<br />'.
'<span class="LC_error">'.
&mt('The extension on this file is reserved internally by LON-CAPA.').
'</span>');
$r->print('<br /><font size=+2><a href="'.$dirpath.'">'.
&mt('Back to Directory').'</a></font>');
} elsif ($fn=~/\.(\w+)$/ &&
!defined(&Apache::loncommon::fileembstyle($1))) {
$r->print(&mt('File').' <span class="LC_filename">'.$fn.'</span> '.
&mt('could not be copied.').'<br />'.
'<span class="LC_error">'.
&mt('The extension on this file is not recognized by LON-CAPA.').
'</span>');
$r->print('<br /><font size="+2"><a href="'.$dirpath.'">'.
&mt('Back to Directory').'</a></font>');
} elsif (-d $target) {
$r->print('File <span class="LC_filename">'.$fn.'</span> could not be copied.<br />'.
'<span class="LC_error">'.
&mt('The target is an existing directory.').
'</span><br />');
$r->print('<font size="+2"><a href="'.$dirpath.'">'.
&mt('Back to Directory').'</a></font>');
} 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")."<br /><br />");
$returnflag = 'ok';
} else {
$r->print(&mt('File copied.'));
$r->print('<br /><font size="+2"><a href="'.$url.'">'.
&mt('View file').'</a></font>');
$r->print('<br /><font size="+2"><a href="'.$dirpath.'">'.
&mt('Back to Directory').'</a></font><br />');
}
} else {
$r->print('Failed to copy: '.$!);
$r->print('<br /><font size="+2"><a href="'.$path.'">'.
&mt('Back to Directory').'</a></font>');
}
}
} else {
$r->print('<span class="LC_error">'.
&mt('Please use browser "Back" button and pick a filename').
'</span><br />');
}
} else {
$r->print('<span class="LC_error">'.
&mt('Please use browser "Back" button and pick a filename').
'</span><br />>');
}
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 = "<script type=\"text/javascript\">\n//<!--\n".
$javascript."\n// --></script>\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('<h3><font color=red>'.&mt('Co-Author').': '.$uname.
&mt(' at ').$udom.'</font></h3>');
}
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:
<Location /adm/upload>
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
</Location>
=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
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonupload.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / publisher