loncom/publisher/lonupload.pm - view

File: [LON-CAPA] / loncom / publisher / lonupload.pm
Revision 1.11: download - view: text, annotated - select for diffs
Mon Aug 5 02:22:56 2002 UTC (22 years, 4 months ago) by foxr
Branches: MAIN
CVS tags: HEAD

Fix bug 59: Uploaded file permissions not correct.

# The LearningOnline Network with CAPA # Handler to upload files into construction space # # $Id: lonupload.pm,v 1.11 2002/08/05 02:22:56 foxr 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/ # # (Handler to retrieve an old version of a file # # (Publication Handler # # (TeX Content Handler # # YEAR=2000 # 05/29/00,05/30,10/11 Gerd Kortemeyer) # # 11/28,11/29,11/30,12/01,12/02,12/04,12/23 Gerd Kortemeyer # YEAR=2001 # 03/23 Guy Albertelli # 03/24,03/29 Gerd Kortemeyer) # # 03/31,04/03 Gerd Kortemeyer) # # 04/05,04/09,05/25,06/23,06/24,08/22 Gerd Kortemeyer # 11/29 Matthew Hall # 12/16 Scott Harrison # ### package Apache::lonupload; use strict; use Apache::File; use File::Copy; use Apache::Constants qw(:common :http :methods); use Apache::loncacc; use Apache::loncommon(); sub upfile_store { my $r=shift; my $fname=$ENV{'form.upfile.filename'}; $fname=~s/\W//g; chop($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)=@_; $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; if (($fn) && ($fn!~/\/$/)) { $r->print( '<form action=/adm/upload method=post>'. '<input type=hidden name=phase value=two>'. '<input type=hidden name=datatoken value="'.&upfile_store.'">'. 'Store uploaded file as '. '<input type=text size=50 name=filename value="/priv/'. $uname.'/'.$fn.'"><br>'. '<input type=submit value="Store"></form>'); # Check for bad extension and warn user if ($fn=~/\.(\w+)$/ && (&Apache::loncommon::fileembstyle($1) eq 'hdn')) { $r->print( '<font color=red>'. 'The extension on this file, "'.$1. '", is reserved internally by LON-CAPA. <br \>'. 'Please change the extension.'. '</font>'); } elsif($fn=~/\.(\w+)$/ && !defined(&Apache::loncommon::fileembstyle($1))) { $r->print( '<font color=red>'. 'The extension on this file, "'.$1. '", is not recognized by LON-CAPA. <br \>'. 'Please change the extension.'. '</font>'); } } else { $r->print('<font color=red>Illegal filename.</font>'); } } else { $r->print('<font color=red>No upload file specified.</font>'); } } 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( '<form action=/adm/upload method=post>'. 'File <tt>'.$fn.'</tt> exists. Overwrite? '. '<input type=hidden name=phase value=two>'. '<input type=hidden name=filename value="'.$fn.'">'. '<input type=hidden name=datatoken value="'.$datatoken.'">'. '<input type=submit name=override value="Yes"></form>'); } else { my $source=$r->dir_config('lonDaemons'). '/tmp/'.$datatoken.'.tmp'; # Check for bad extension and disallow upload if ($fn=~/\.(\w+)$/ && (&Apache::loncommon::fileembstyle($1) eq 'hdn')) { $r->print( 'File <tt>'.$fn.'</tt> could not be copied.<br />'. '<font color=red>'. 'The extension on this file is reserved internally by LON-CAPA.'. '</font>'); } elsif ($fn=~/\.(\w+)$/ && !defined(&Apache::loncommon::fileembstyle($1))) { $r->print( 'File <tt>'.$fn.'</tt> could not be copied.<br />'. '<font color=red>'. 'The extension on this file is not recognized by LON-CAPA.'. '</font>'); } elsif (copy($source,$target)) { chmod(0660, $target); # Set permissions to rw-rw---. $r->print('File copied.'); $r->print('<p><font size=+2><a href="'.$fn. '">View file</a></font>'); } else { $r->print('Failed to copy: '.$!); } } } else { $r->print( '<font size=+1 color=red>Please pick a filename</font><p>'); &phaseone($r,$fn,$uname,$udom); } } else { $r->print( '<font size=+1 color=red>Please pick a filename</font><p>'); &phaseone($r,$fn,$uname,$udom); } } # ---------------------------------------------------------------- Main Handler sub handler { my $r=shift; my $uname; my $udom; ($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; } # ----------------------------------------------------------- Start page output $r->content_type('text/html'); $r->send_http_header; $r->print('<html><head><title>LON-CAPA Construction Space</title></head>'); $r->print( '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>'); $r->print('<h1>Upload file to Construction Space</h1>'); if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) { $r->print('<h3><font color=red>Co-Author: '.$uname.' at '.$udom. '</font></h3>'); } if ($ENV{'form.phase'} eq 'two') { &phasetwo($r,$fn,$uname,$udom); } else { &phaseone($r,$fn,$uname,$udom); } $r->print('</body></html>'); 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