Annotation of loncom/publisher/lonupload.pm, revision 1.24

1.12      foxr        1: 
1.1       www         2: # The LearningOnline Network with CAPA
                      3: # Handler to upload files into construction space
                      4: #
1.24    ! albertel    5: # $Id: lonupload.pm,v 1.23 2003/11/08 11:11:01 albertel Exp $
1.8       matthew     6: #
                      7: # Copyright Michigan State University Board of Trustees
                      8: #
                      9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                     10: #
                     11: # LON-CAPA is free software; you can redistribute it and/or modify
                     12: # it under the terms of the GNU General Public License as published by
                     13: # the Free Software Foundation; either version 2 of the License, or
                     14: # (at your option) any later version.
                     15: #
                     16: # LON-CAPA is distributed in the hope that it will be useful,
                     17: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     19: # GNU General Public License for more details.
                     20: #
                     21: # You should have received a copy of the GNU General Public License
                     22: # along with LON-CAPA; if not, write to the Free Software
                     23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     24: #
                     25: # /home/httpd/html/adm/gpl.txt
                     26: #
                     27: # http://www.lon-capa.org/
                     28: #
1.10      harris41   29: ###
1.1       www        30: 
                     31: package Apache::lonupload;
                     32: 
                     33: use strict;
                     34: use Apache::File;
                     35: use File::Copy;
1.13      foxr       36: use File::Basename;
1.1       www        37: use Apache::Constants qw(:common :http :methods);
1.3       www        38: use Apache::loncacc;
1.10      harris41   39: use Apache::loncommon();
1.12      foxr       40: use Apache::Log();
1.13      foxr       41: use Apache::lonnet;
1.14      foxr       42: use HTML::Entities();
1.20      www        43: use Apache::lonlocal;
1.12      foxr       44: 
                     45: my $DEBUG=0;
                     46: 
                     47: sub Debug {
                     48:   
1.22      albertel   49:     # Marshall the parameters.
1.12      foxr       50:   
1.22      albertel   51:     my $r       = shift;
                     52:     my $log     = $r->log;
                     53:     my $message = shift;
1.12      foxr       54:   
1.22      albertel   55:     # Put out the indicated message butonly if DEBUG is false.
1.12      foxr       56:   
1.22      albertel   57:     if ($DEBUG) {
                     58: 	$log->debug($message);
                     59:     }
1.12      foxr       60: }
1.1       www        61: 
1.2       www        62: sub upfile_store {
                     63:     my $r=shift;
                     64: 	
                     65:     my $fname=$ENV{'form.upfile.filename'};
                     66:     $fname=~s/\W//g;
                     67:     
1.18      www        68:     chomp($ENV{'form.upfile'});
1.1       www        69:   
1.2       www        70:     my $datatoken=$ENV{'user.name'}.'_'.$ENV{'user.domain'}.
                     71: 		  '_upload_'.$fname.'_'.time.'_'.$$;
                     72:     {
                     73:        my $fh=Apache::File->new('>'.$r->dir_config('lonDaemons').
                     74:                                    '/tmp/'.$datatoken.'.tmp');
                     75:        print $fh $ENV{'form.upfile'};
1.1       www        76:     }
1.2       www        77:     return $datatoken;
                     78: }
                     79: 
                     80: 
                     81: sub phaseone {
1.22      albertel   82:     my ($r,$fn,$uname,$udom)=@_;
                     83:     $ENV{'form.upfile.filename'}=~s/\\/\//g;
                     84:     $ENV{'form.upfile.filename'}=~s/^.*\/([^\/]+)$/$1/;
                     85:     if ($ENV{'form.upfile.filename'}) {
                     86: 	$fn=~s/\/[^\/]+$//;
                     87: 	$fn=~s/([^\/])$/$1\//;
                     88: 	$fn.=$ENV{'form.upfile.filename'};
                     89: 	$fn=~s/^\///;
                     90: 	$fn=~s/(\/)+/\//g;
1.13      foxr       91: 
                     92: #    Fn is the full path to the destination filename.
                     93: #    
                     94: 
1.22      albertel   95: 	&Debug($r, "Filename for upload: $fn");
                     96: 	if (($fn) && ($fn!~/\/$/)) {
1.23      albertel   97: 	    $r->print('<form action="/adm/upload" method="post">'.
                     98: 		      '<input type="hidden" name="phase" value="two" />'.
                     99: 		      '<input type="hidden" name="datatoken" value="'.
                    100: 		      &upfile_store.'" />'.
                    101: 		      '<input type="hidden" name="uploaduname" value="'.$uname.
                    102: 		      '" />'.&mt('Store uploaded file as ').
                    103: 		      "<tt>/priv/$uname/</tt>".
                    104: 		      '<input type="text" size="50" name="filename" value="'.$fn.
                    105: 		      '" /><br />'.
                    106: 		      '<input type="submit" value="'.&mt('Store').'" /></form>');
1.22      albertel  107: 	    # Check for bad extension and warn user
                    108: 	    if ($fn=~/\.(\w+)$/ && 
                    109: 		(&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.23      albertel  110: 		$r->print('<font color="red">'.&mt('The extension on this file,').
1.22      albertel  111: 			  ' "'.$1.'"'.&mt(', is reserved internally by LON-CAPA.').
1.23      albertel  112: 			  ' <br />'.&mt('Please change the extension.').'</font>');
1.22      albertel  113: 	    } elsif($fn=~/\.(\w+)$/ && 
                    114: 		    !defined(&Apache::loncommon::fileembstyle($1))) {
1.23      albertel  115: 		$r->print('<font color="red">'.&mt('The extension on this file,').
1.22      albertel  116: 			  ' "'.$1.'"'.&mt(', is not recognized by LON-CAPA.').
1.23      albertel  117: 			  ' <br />'.&mt('Please change the extension.').
1.22      albertel  118: 			  '</font>');
                    119: 	    }
                    120: 	} else {
1.23      albertel  121: 	    $r->print('<font color="red">'.&mt('Illegal filename.').'</font>');
1.22      albertel  122: 	}
                    123:     } else {
1.23      albertel  124: 	$r->print('<font color="red">'.&mt('No upload file specified.').'</font>');
1.22      albertel  125:     }
1.1       www       126: }
                    127: 
                    128: sub phasetwo {
1.22      albertel  129:     my ($r,$tfn,$uname,$udom)=@_;
                    130:     my $fn='/priv/'.$uname.'/'.$tfn;
                    131:     $fn=~s/\/+/\//g;
                    132:     &Debug($r, "Filename is ".$tfn);
                    133:     if ($tfn) {
                    134: 	&Debug($r, "Filename for tfn = ".$tfn);
                    135: 	my $target='/home/'.$uname.'/public_html'.$tfn;
                    136: 	&Debug($r, "target -> ".$target);
1.13      foxr      137: #     target is the full filesystem path of the destination file.
1.22      albertel  138: 	my $base = &File::Basename::basename($fn);
                    139: 	my $path = &File::Basename::dirname($fn);
                    140: 	$base    = &HTML::Entities::encode($base);
                    141: 	my $url  = $path."/".$base; 
                    142: 	&Debug($r, "URL is now ".$url);
                    143: 	my $datatoken=$ENV{'form.datatoken'};
                    144: 	if (($fn) && ($datatoken)) {
                    145: 	    if ((-e $target) && ($ENV{'form.override'} ne 'Yes')) {
1.23      albertel  146: 		$r->print('<form action="/adm/upload" method="post">'.
1.22      albertel  147: 			  &mt('File').' <tt>'.$fn.'</tt> '.
                    148: 			  &mt('exists. Overwrite?').' '.
1.23      albertel  149: 			  '<input type="hidden" name="phase" value="two" />'.
                    150: 			  '<input type="hidden" name="filename" value="'."$url".'" />'.
                    151: 			  '<input type="hidden" name="datatoken" value="'.$datatoken.'" />'.
                    152: 			  '<input type="submit" name="override" value="'.&mt('Yes').'" /></form>');
1.22      albertel  153: 	    } else {
                    154: 		my $source=$r->dir_config('lonDaemons').'/tmp/'.$datatoken.'.tmp';
                    155: 		# Check for bad extension and disallow upload
                    156: 		if ($fn=~/\.(\w+)$/ && 
                    157: 		    (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
                    158: 		    $r->print(&mt('File').' <tt>'.$fn.'</tt> '.
                    159: 			      &mt('could not be copied.').'<br />'.
1.23      albertel  160: 			      '<font color="red">'.
1.22      albertel  161: 			      &mt('The extension on this file is reserved internally by LON-CAPA.').
                    162: 			      '</font>');
1.24    ! albertel  163: 		    $r->print('<br /><font size=+2><a href="'.$path.'">'.
1.22      albertel  164: 			      &mt('Back to Directory').'</a></font>');
                    165: 		} elsif ($fn=~/\.(\w+)$/ && 
                    166: 			 !defined(&Apache::loncommon::fileembstyle($1))) {
                    167: 		    $r->print(&mt('File').' <tt>'.$fn.'</tt> '.
                    168: 			      &mt('could not be copied.').'<br />'.
1.23      albertel  169: 			      '<font color="red">'.
1.22      albertel  170: 			      &mt('The extension on this file is not recognized by LON-CAPA.').
                    171: 			      '</font>');
1.23      albertel  172: 		    $r->print('<br /><font size="+2"><a href="'.$path.'">'.
1.22      albertel  173: 			      &mt('Back to Directory').'</a></font>');
                    174: 		} elsif (-d $target) {
                    175: 		    $r->print('File <tt>'.$fn.'</tt> could not be copied.<br />'.
1.23      albertel  176: 			      '<font color="red">'.
1.22      albertel  177: 			      &mt('The target is an existing directory.').
1.23      albertel  178: 			      '</font><br />');
                    179: 		    $r->print('<font size="+2"><a href="'.$path.'">'.
1.22      albertel  180: 			      &mt('Back to Directory').'</a></font>');
                    181: 		} elsif (copy($source,$target)) {
                    182: 		    chmod(0660, $target); # Set permissions to rw-rw---.
                    183: 		    $r->print(&mt('File copied.'));
1.23      albertel  184: 		    $r->print('<br /><font size="+2"><a href="'.$url.'">'.
1.22      albertel  185: 			      &mt('View file').'</a></font>');
1.24    ! albertel  186: 		    $r->print('<br /><font size="+2"><a href="'.$path.'">'.
1.23      albertel  187: 			      &mt('Back to Directory').'</a></font><br />');
1.22      albertel  188: 		} else {
                    189: 		    $r->print('Failed to copy: '.$!);
1.23      albertel  190: 		    $r->print('<br /><font size="+2"><a href="'.$path.'">'.
1.22      albertel  191: 			      &mt('Back to Directory').'</a></font>');
                    192: 		}
                    193: 	    }
                    194: 	} else {
1.23      albertel  195: 	    $r->print('<font size="+1" color="red">'.
1.22      albertel  196: 		      &mt('Please use browser "Back" button and pick a filename').
1.24    ! albertel  197: 		      '</font><br />');
1.22      albertel  198: 	}
1.1       www       199:     } else {
1.22      albertel  200: 	$r->print('<font size=+1 color=red>'.
                    201: 		  &mt('Please use browser "Back" button and pick a filename').
1.24    ! albertel  202: 		  '</font><br />>');
1.1       www       203:     }
                    204: }
                    205: 
1.10      harris41  206: # ---------------------------------------------------------------- Main Handler
1.1       www       207: sub handler {
                    208: 
1.22      albertel  209:     my $r=shift;
1.1       www       210: 
1.22      albertel  211:     my $uname;
                    212:     my $udom;
1.18      www       213: #
                    214: # phase two: re-attach user
                    215: #
1.22      albertel  216:     if ($ENV{'form.uploaduname'}) {
                    217: 	$ENV{'form.filename'}='/priv/'.$ENV{'form.uploaduname'}.'/'.
                    218: 	    $ENV{'form.filename'};
                    219:     }
                    220: #
                    221: 
                    222:     ($uname,$udom)=
                    223: 	&Apache::loncacc::constructaccess($ENV{'form.filename'},
                    224: 					  $r->dir_config('lonDefDomain'));
                    225:     unless (($uname) && ($udom)) {
                    226: 	$r->log_reason($uname.' at '.$udom.
                    227: 		       ' trying to publish file '.$ENV{'form.filename'}.
                    228: 		       ' - not authorized', 
                    229: 		       $r->filename); 
                    230: 	return HTTP_NOT_ACCEPTABLE;
                    231:     }
                    232:     
                    233:     my $fn;
                    234:     if ($ENV{'form.filename'}) {
                    235: 	$fn=$ENV{'form.filename'};
                    236: 	$fn=~s/^http\:\/\/[^\/]+\///;
                    237: 	$fn=~s/^\///;
                    238: 	$fn=~s/(\~|priv\/)(\w+)//;
                    239: 	$fn=~s/\/+/\//g;
                    240:     } else {
                    241: 	$r->log_reason($ENV{'user.name'}.' at '.$ENV{'user.domain'}.
                    242: 		       ' unspecified filename for upload', $r->filename); 
                    243: 	return HTTP_NOT_FOUND;
                    244:     }
1.1       www       245: 
                    246: # ----------------------------------------------------------- Start page output
                    247: 
                    248: 
1.22      albertel  249:     &Apache::loncommon::content_type($r,'text/html');
                    250:     $r->send_http_header;
1.1       www       251: 
1.22      albertel  252:     $r->print('<html><head><title>LON-CAPA Construction Space</title></head>');
1.1       www       253: 
1.22      albertel  254:     $r->print(&Apache::loncommon::bodytag('Upload file to Construction Space'));
1.3       www       255:   
1.22      albertel  256:     if (($uname ne $ENV{'user.name'}) || ($udom ne $ENV{'user.domain'})) {
                    257: 	$r->print('<h3><font color=red>'.&mt('Co-Author').': '.$uname.
                    258: 		  &mt(' at ').$udom.'</font></h3>');
                    259:     }
                    260: 
                    261:     if ($ENV{'form.phase'} eq 'two') {
                    262: 	&phasetwo($r,$fn,$uname,$udom);
                    263:     } else {
                    264: 	&phaseone($r,$fn,$uname,$udom);
                    265:     }
1.1       www       266: 
1.22      albertel  267:     $r->print('</body></html>');
                    268:     return OK;  
1.1       www       269: }
1.7       www       270: 
                    271: 1;
                    272: __END__
1.10      harris41  273: 
                    274: =head1 NAME
                    275: 
                    276: Apache::lonupload - upload files into construction space
                    277: 
                    278: =head1 SYNOPSIS
                    279: 
                    280: Invoked by /etc/httpd/conf/srm.conf:
                    281: 
                    282:  <Location /adm/upload>
                    283:  PerlAccessHandler       Apache::lonacc
                    284:  SetHandler perl-script
                    285:  PerlHandler Apache::lonupload
                    286:  ErrorDocument     403 /adm/login
                    287:  ErrorDocument     404 /adm/notfound.html
                    288:  ErrorDocument     406 /adm/unauthorized.html
                    289:  ErrorDocument	  500 /adm/errorhandler
                    290:  </Location>
                    291: 
                    292: =head1 INTRODUCTION
                    293: 
                    294: This module uploads a file sitting on a client computer into 
                    295: library server construction space.
                    296: 
                    297: This is part of the LearningOnline Network with CAPA project
                    298: described at http://www.lon-capa.org.
                    299: 
                    300: =head1 HANDLER SUBROUTINE
                    301: 
                    302: This routine is called by Apache and mod_perl.
                    303: 
                    304: =over 4
                    305: 
                    306: =item *
                    307: 
                    308: Initialize variables
                    309: 
                    310: =item *
                    311: 
                    312: Start page output
                    313: 
                    314: =item *
                    315: 
                    316: output relevant interface phase (phaseone or phasetwo)
                    317: 
                    318: =item *
                    319: 
                    320: (phase one is to specify upload file; phase two is to handle conditions
                    321: subsequent to specification--like overwriting an existing file)
                    322: 
                    323: =back
                    324: 
                    325: =head1 OTHER SUBROUTINES
                    326: 
                    327: =over 4
                    328: 
                    329: =item *
                    330: 
                    331: phaseone() : Interface for specifying file to upload.
                    332: 
                    333: =item *
                    334: 
                    335: phasetwo() : Interface for handling post-conditions about uploading (such
                    336: as overwriting an existing file).
                    337: 
                    338: =item *
                    339: 
                    340: upfile_store() : Store contents of uploaded file into temporary space.  Invoked
                    341: by phaseone subroutine.
                    342: 
                    343: =back
                    344: 
                    345: =cut

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>